255 files changed, 73260 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/Artistic b/gnu/usr.bin/perl/Artistic
new file mode 100644
index 000000000000..fbf798977589
--- /dev/null
+++ b/gnu/usr.bin/perl/Artistic
@@ -0,0 +1,117 @@
+
+
+
+
+			 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.
+
+	"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) accompany any non-standard executables with their corresponding
+    Standard Version executables, giving the non-standard executables
+    non-standard names, and clearly documenting 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.
+
+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.
+
+7. C subroutines 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. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+9. 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/Copying b/gnu/usr.bin/perl/Copying
new file mode 100644
index 000000000000..3c68f02bb420
--- /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/Makefile b/gnu/usr.bin/perl/Makefile
new file mode 100644
index 000000000000..3ef6485b9745
--- /dev/null
+++ b/gnu/usr.bin/perl/Makefile
@@ -0,0 +1,10 @@
+#
+# Bmake file for perl 4.036
+#
+# Note: I'm not sure what to do with c2ph located in misc...
+#
+
+SUBDIR= perl tperl sperl lib x2p  
+
+.include <bsd.subdir.mk>
+
diff --git a/gnu/usr.bin/perl/Makefile.inc b/gnu/usr.bin/perl/Makefile.inc
new file mode 100644
index 000000000000..c2f9b445c186
--- /dev/null
+++ b/gnu/usr.bin/perl/Makefile.inc
@@ -0,0 +1,5 @@
+
+
+BINDIR?= /usr/local/bin
+MANDIR?= /usr/local/man/man
+
diff --git a/gnu/usr.bin/perl/README b/gnu/usr.bin/perl/README
new file mode 100644
index 000000000000..c52c7f498675
--- /dev/null
+++ b/gnu/usr.bin/perl/README
@@ -0,0 +1,195 @@
+
+			Perl Kit, Version 4.0
+
+		Copyright (c) 1989,1990,1991, 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 uperl.o 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's also a Nutshell Handbook published
+by O'Reilly & Assoc.  Their U.S. number is 1-800-338-6887 (dev-nuts) and
+their international number is 1-707-829-0515.  E-mail to nuts@ora.com.
+
+Perl will probably not run on machines with a small address space.
+
+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)  Run Configure.  This will figure out various things about your system.
+    Some things Configure will figure out for itself, other things it will
+    ask you about.  It will then proceed to make config.h, config.sh, and
+    Makefile.  If you're a hotshot, run Configure -d to take all the
+    defaults and then edit config.sh to patch up any flaws.
+
+    You might possibly have to trim # comments from the front of Configure
+    if your sh doesn't handle them, but all other # comments will be taken
+    care of.
+
+    (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.)
+
+2)  Glance through config.h to make sure system dependencies are correct.
+    Most of them should have been taken care of by running the Configure script.
+
+    If you have any additional changes to make to the C definitions, they
+    can be done in cflags.SH.  For instance, to turn off the optimizer
+    on eval.c, find the line in the switch structure for eval.c and
+    put the command $optimize='-g' before the ;;.  You will probably
+    want to change the entry for teval.c too.  To change the C flags
+    for all the files, edit config.sh and change either $ccflags or $optimize.
+
+3)  make depend
+
+    This will look for all the includes and modify Makefile accordingly.
+    Configure will offer to do this for you.
+
+4)  make
+
+    This will attempt to make perl in the current directory.
+
+    If you can't compile successfully, try adding a -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.
+
+    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
+    cflags.SH.  It's okay to insert rules for specific files into
+    Makefile.SH, since a default rule only takes effect in the
+    absence of a specific rule.
+
+    Most of the following hints are now done automatically by Configure.
+
+    The 3b2 needs to turn off -O.
+    Compilers with limited switch tables may have to define -DSMALLSWITCHES
+    Domain/OS 10.3 (at least) native C 6.7 may need -opt 2 for eval.c
+    AIX/RT may need a -a switch and -DCRIPPLED_CC.
+    AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c.
+    AIX RS/6000 needs -D_NO_PROTO.
+    SUNOS 4.0.[12] needs -DFPUTS_BOTCH.
+    SUNOS 3.[45] should use the system malloc.
+    SGI machines may need -Ddouble="long float" and -O1.
+    Vax-based systems may need to hand assemble teval.s with a -J switch.
+    Ultrix on MIPS machines may need -DLANGUAGE_C.
+    Ultrix 4.0 on MIPS machines may need -Olimit 2900 or so.
+    Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted.
+    MIPS machines need /bin before /bsd43/bin in PATH.
+    MIPS machines may need to undef d_volatile.
+    MIPS machines may need to turn off -O on cmd.c, perl.c and tperl.c.
+    Some MIPS machines may need to undefine CASTNEGFLOAT.
+    Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86.
+    SCO Xenix may need -m25000 for yacc.  See also README.xenix.
+    Genix needs 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.
+    A/UX may appears to work with -O -B/usr/lib/big/ optimizer flags.
+    A/UX needs -lposix to find rewinddir.
+    A/UX may need -ZP -DPOSIX, and -g if big cc is used.
+    FPS machines may need -J and -DBADSWITCH.
+    UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT.
+    dynix may need to undefine CASTNEGFLOAT (d_castneg='undef' in config.sh).
+    Dnix (not dynix) may need to remove -O.
+    IRIX 3.3 may need to undefine VFORK.
+    HP/UX may need to pull cerror.o and syscall.o out of libc.a and link
+	them in explicitly.
+    If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both.
+    Machines with half-implemented dbm routines will need to #undef ODBM & NDBM.
+    If you have GDBM available and want it instead of NDBM, say -DHAS_GDBM.
+    C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER.
+	(Try this if you get random glitches.)
+    If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC.
+    Turn on support for 64-bit integers (long longs) with -DQUAD.
+
+5)  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 README in the t subdirectory.  Note that you can't run it
+    in background if this disables opening of /dev/tty.  If "make test"
+    bombs out, just cd to the t directory and run 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
+
+6)  make install
+
+    This will put perl into a public directory (such as /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 do this.  If
+    you are not root, you must own the directories in question and you should
+    ignore any messages about chown not working.
+
+7)  Read the manual entry before running perl.
+
+8)  IMPORTANT!  Help save the world!  Communicate any problems and suggested
+    patches to me, lwall@netlabs.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.
+
+    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.  It's also
+    helpful if you send the output of "uname -a".
+
+    Watch for perl patches in comp.lang.perl.  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/VERSION b/gnu/usr.bin/perl/VERSION
new file mode 100644
index 000000000000..2b80880948e9
--- /dev/null
+++ b/gnu/usr.bin/perl/VERSION
@@ -0,0 +1 @@
+Perl 4.0 patchlevel 36
diff --git a/gnu/usr.bin/perl/Wishlist b/gnu/usr.bin/perl/Wishlist
new file mode 100644
index 000000000000..3290834d21e6
--- /dev/null
+++ b/gnu/usr.bin/perl/Wishlist
@@ -0,0 +1,9 @@
+built-in cpp
+perl to C translator
+multi-threading
+make more easily embeddable
+built-in globbing
+compile to threaded code
+rewrite regexp parser for better integrated optimization
+add structured types and objects
+allow for lexical scoping
diff --git a/gnu/usr.bin/perl/eg/ADB b/gnu/usr.bin/perl/eg/ADB
new file mode 100644
index 000000000000..09b93c302aae
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/ADB
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/ADB,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..87cfc334f145
--- /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 000000000000..9835e1b6ddc2
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/changes
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/changes,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+($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 000000000000..5900c90d0956
--- /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 000000000000..bbb0d062cbd1
--- /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 000000000000..94c648bd7626
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/dus
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/dus,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..47e443820d88
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findcp
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/findcp,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..a60f10f76c32
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findtar
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/findtar,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..3e44a9cf182b
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gcp,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..8985742fa473
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp.man
@@ -0,0 +1,77 @@
+.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gcp.man,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+.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 000000000000..d296a84c913a
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/ged
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/ged,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..96ec771c4a7d
--- /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 000000000000..3322a02ff74f
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh
@@ -0,0 +1,117 @@
+#! /usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gsh,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..00eafb66d8c2
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh.man
@@ -0,0 +1,80 @@
+.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/g/gsh.man,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+.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 000000000000..873539b10c6d
--- /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 000000000000..1b45ee0325c0
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/muck.man
@@ -0,0 +1,21 @@
+.\" $Header: /home/cvs/386BSD/ports/lang/perl/eg/muck.man,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+.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 000000000000..b3185896ef98
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/myrup
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/myrup,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..a376142cdd75
--- /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;
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/nih,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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/perlsh b/gnu/usr.bin/perl/eg/perlsh
new file mode 100644
index 000000000000..2b2cccd0641e
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/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/eg/relink b/gnu/usr.bin/perl/eg/relink
new file mode 100644
index 000000000000..69956c9a6738
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/relink
@@ -0,0 +1,91 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/relink,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+#
+# $Log: relink,v $
+# Revision 1.1.1.1  1993/08/23  21:29:43  nate
+# PERL!
+#
+# Revision 4.0  91/03/20  01:11:40  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.2  90/08/09  03:17:44  lwall
+# patch19: added man page for relink and rename
+# 
+
+($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 000000000000..b568406f8603
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rename
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/rename,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+#
+# $Log: rename,v $
+# Revision 1.1.1.1  1993/08/23  21:29:43  nate
+# PERL!
+#
+# Revision 4.0  91/03/20  01:11:53  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.2  90/08/09  03:17:57  lwall
+# patch19: added man page for relink and rename
+# 
+
+($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 000000000000..0c8fa2c86aaf
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rmfrom
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -n
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/rmfrom,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..688738710a53
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_df
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_df,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..6621120d3e44
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_last
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_last,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..a28cda858a17
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_messages
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_messages,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..f9c53c7d2385
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_passwd
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_passwd,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..b0480d544c30
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_ps
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_ps,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..a95a6092b467
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_sudo
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_sudo,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..a730e0aaee16
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_suid
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -P
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scan_suid,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..f773e87e8f8a
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scanner
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/scan/scanner,v 1.1.1.1 1993/08/23 21:29:44 nate Exp $
+
+# 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 000000000000..49a140a4c2cf
--- /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 000000000000..e8d1b11b3630
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/shmkill
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/shmkill,v 1.1.1.1 1993/08/23 21:29:43 nate Exp $
+
+# 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 000000000000..54094f1d85b9
--- /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 000000000000..317e027ea75c
--- /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 000000000000..d72a2dd77c91
--- /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 000000000000..d40e46b9450a
--- /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 000000000000..7e6f983c7ce8
--- /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/van/empty b/gnu/usr.bin/perl/eg/van/empty
new file mode 100644
index 000000000000..ee656e68563f
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/empty
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/empty,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..50459821546b
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/unvanish
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/unvanish,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+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 000000000000..79b78854d54c
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanexp
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/vanexp,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+# 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 000000000000..b79776a4ebdc
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanish
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/eg/van/vanish,v 1.1.1.1 1993/08/23 21:29:45 nate Exp $
+
+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 000000000000..ac15246c9fa1
--- /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/emacs/perl-mode.el b/gnu/usr.bin/perl/emacs/perl-mode.el
new file mode 100644
index 000000000000..cb6195dec3bc
--- /dev/null
+++ b/gnu/usr.bin/perl/emacs/perl-mode.el
@@ -0,0 +1,631 @@
+;; Perl code editing commands for GNU Emacs
+;;   Copyright (C) 1990  William F. Mann
+;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
+;; Free Software Foundation, under terms of its General Public License.
+
+;; This file may be made part of GNU Emacs at the option of the FSF, or
+;; of the perl distribution at the option of Larry Wall.
+
+;; This code is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; this code, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
+;; to your .emacs file and change the first line of your perl script to:
+;; #!/usr/bin/perl --	 # -*-Perl-*-
+;; With argments to perl:
+;; #!/usr/bin/perl -P-	 # -*-Perl-*-
+;; To handle files included with do 'filename.pl';, add something like
+;; (setq auto-mode-alist (append (list (cons "\\.pl$" 'perl-mode))
+;;                               auto-mode-alist))
+;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
+
+;; This code is based on the 18.53 version c-mode.el, with extensive
+;; rewriting.  Most of the features of c-mode survived intact.
+
+;; I added a new feature which adds functionality to TAB; it is controlled
+;; by the variable perl-tab-to-comment.  With it enabled, TAB does the
+;; first thing it can from the following list:  change the indentation;
+;; move past leading white space; delete an empty comment; reindent a
+;; comment; move to end of line; create an empty comment; tell you that
+;; the line ends in a quoted string, or has a # which should be a \#.
+
+;; If your machine is slow, you may want to remove some of the bindings
+;; to electric-perl-terminator.  I changed the indenting defaults to be
+;; what Larry Wall uses in perl/lib, but left in all the options.
+
+;; I also tuned a few things:  comments and labels starting in column
+;; zero are left there by indent-perl-exp; perl-beginning-of-function
+;; goes back to the first open brace/paren in column zero, the open brace
+;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
+;; (meta-^q) indents from the current line through the close of the next
+;; brace/paren, so you don't need to start exactly at a brace or paren.
+
+;; It may be good style to put a set of redundant braces around your
+;; main program.  This will let you reindent it with meta-^q.
+
+;; Known problems (these are all caused by limitations in the elisp
+;; parsing routine (parse-partial-sexp), which was not designed for such
+;; a rich language; writing a more suitable parser would be a big job):
+;; 1)  Regular expression delimitors do not act as quotes, so special
+;;       characters such as `'"#:;[](){} may need to be backslashed
+;;       in regular expressions and in both parts of s/// and tr///.
+;; 2)  The globbing syntax <pattern> is not recognized, so special
+;;       characters in the pattern string must be backslashed.
+;; 3)  The q, qq, and << quoting operators are not recognized; see below.
+;; 4)  \ (backslash) always quotes the next character, so '\' is
+;;       treated as the start of a string.  Use "\\" as a work-around.
+;; 5)  To make variables such a $' and $#array work, perl-mode treats
+;;       $ just like backslash, so '$' is the same as problem 5.
+;; 6)  Unfortunately, treating $ like \ makes ${var} be treated as an
+;;       unmatched }.  See below.
+;; 7)  When ' (quote) is used as a package name separator, perl-mode
+;;       doesn't understand, and thinks it is seeing a quoted string.
+
+;; Here are some ugly tricks to bypass some of these problems:  the perl
+;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
+;; but will trick perl-mode into starting a quoted string, which
+;; can be ended with another /`/.  Assuming you have no embedded
+;; back-ticks, this can used to help solve problem 3:
+;;
+;;     /`/; $ugly = q?"'$?; /`/;
+;;
+;; To solve problem 6, add a /{/; before each use of ${var}:
+;;     /{/; while (<${glob_me}>) ...
+;;
+;; Problem 7 is even worse, but this 'fix' does work :-(
+;;     $DB'stop#'
+;;         [$DB'line#'
+;;          ] =~ s/;9$//;
+
+
+(defvar perl-mode-abbrev-table nil
+  "Abbrev table in use in perl-mode buffers.")
+(define-abbrev-table 'perl-mode-abbrev-table ())
+
+(defvar perl-mode-map ()
+  "Keymap used in Perl mode.")
+(if perl-mode-map
+    ()
+  (setq perl-mode-map (make-sparse-keymap))
+  (define-key perl-mode-map "{" 'electric-perl-terminator)
+  (define-key perl-mode-map "}" 'electric-perl-terminator)
+  (define-key perl-mode-map ";" 'electric-perl-terminator)
+  (define-key perl-mode-map ":" 'electric-perl-terminator)
+  (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
+  (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
+  (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
+  (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
+  (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key perl-mode-map "\t" 'perl-indent-command))
+
+(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 perl-mode-syntax-table nil
+  "Syntax table in use in perl-mode buffers.")
+
+(if perl-mode-syntax-table
+    ()
+  (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
+  (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
+  (modify-syntax-entry ?# "<" perl-mode-syntax-table)
+  (modify-syntax-entry ?$ "/" perl-mode-syntax-table)
+  (modify-syntax-entry ?% "." perl-mode-syntax-table)
+  (modify-syntax-entry ?& "." perl-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
+  (modify-syntax-entry ?* "." perl-mode-syntax-table)
+  (modify-syntax-entry ?+ "." perl-mode-syntax-table)
+  (modify-syntax-entry ?- "." perl-mode-syntax-table)
+  (modify-syntax-entry ?/ "." perl-mode-syntax-table)
+  (modify-syntax-entry ?< "." perl-mode-syntax-table)
+  (modify-syntax-entry ?= "." perl-mode-syntax-table)
+  (modify-syntax-entry ?> "." perl-mode-syntax-table)
+  (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
+  (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
+  (modify-syntax-entry ?| "." perl-mode-syntax-table)
+)
+
+(defconst perl-indent-level 4
+  "*Indentation of Perl statements with respect to containing block.")
+(defconst perl-continued-statement-offset 4
+  "*Extra indent for lines not starting new statements.")
+(defconst perl-continued-brace-offset -4
+  "*Extra indent for substatements that start with open-braces.
+This is in addition to perl-continued-statement-offset.")
+(defconst perl-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context.")
+(defconst perl-brace-imaginary-offset 0
+  "*Imagined indentation of an open brace that actually follows a statement.")
+(defconst perl-label-offset -2
+  "*Offset of Perl label lines relative to usual indentation.")
+
+(defconst perl-tab-always-indent t
+  "*Non-nil means TAB in Perl mode should always indent the current line,
+regardless of where in the line point is when the TAB command is used.")
+
+(defconst perl-tab-to-comment t
+  "*Non-nil means that for lines which don't need indenting, TAB will
+either indent an existing comment, move to end-of-line, or if at end-of-line
+already, create a new comment.")
+
+(defconst perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
+  "*Lines starting with this regular expression will not be auto-indented.")
+
+(defun perl-mode ()
+  "Major mode for editing Perl code.
+Expression and list commands understand all Perl brackets.
+Tab indents for Perl code.
+Comments are delimited with # ... \\n.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+\\{perl-mode-map}
+Variables controlling indentation style:
+ perl-tab-always-indent
+    Non-nil means TAB in Perl mode should always indent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ perl-tab-to-comment
+    Non-nil means that for lines which don't need indenting, TAB will
+    either delete an empty comment, indent an existing comment, move 
+    to end-of-line, or if at end-of-line already, create a new comment.
+ perl-nochange
+    Lines starting with this regular expression will not be auto-indented.
+ perl-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.
+ perl-continued-statement-offset
+    Extra indentation given to a substatement, such as the
+    then-clause of an if or body of a while.
+ perl-continued-brace-offset
+    Extra indentation given to a brace that starts a substatement.
+    This is in addition to perl-continued-statement-offset.
+ perl-brace-offset
+    Extra indentation for line if it starts with an open brace.
+ perl-brace-imaginary-offset
+    An open brace following other text is treated as if it were
+    this far to the right of the start of its line.
+ perl-label-offset
+    Extra indentation for line that is a label.
+
+Various indentation styles:       K&R  BSD  BLK  GNU  LW
+  perl-indent-level                5    8    0    2    4
+  perl-continued-statement-offset  5    8    4    2    4
+  perl-continued-brace-offset      0    0    0    0   -4
+  perl-brace-offset               -5   -8    0    0    0
+  perl-brace-imaginary-offset      0    0    4    0    0
+  perl-label-offset               -5   -8   -2   -2   -2
+
+Turning on Perl mode calls the value of the variable perl-mode-hook with no 
+args, if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map perl-mode-map)
+  (setq major-mode 'perl-mode)
+  (setq mode-name "Perl")
+  (setq local-abbrev-table perl-mode-abbrev-table)
+  (set-syntax-table perl-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 'perl-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 32)
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'perl-comment-indent)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments nil)
+  (run-hooks 'perl-mode-hook))
+
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in Perl code
+;; based on its context.
+(defun perl-comment-indent ()
+  (if (and (bolp) (not (eolp)))
+      0					;Existing comment at bol stays there.
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (1+ (current-column))	;Else indent at comment column
+	   comment-column))))		; except leave at least one space.
+
+(defun electric-perl-terminator (arg)
+  "Insert character.  If at end-of-line, and not in a comment or a quote,
+correct the line's indentation."
+  (interactive "P")
+  (let ((insertpos (point)))
+    (and (not arg)			; decide whether to indent
+	 (eolp)
+	 (save-excursion
+	   (beginning-of-line)
+	   (and (not			; eliminate comments quickly
+		 (re-search-forward comment-start-skip insertpos t)) 
+		(or (/= last-command-char ?:)
+		    ;; Colon is special only after a label ....
+		    (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
+		(let ((pps (parse-partial-sexp 
+			    (perl-beginning-of-function) insertpos)))
+		  (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
+	 (progn				; must insert, indent, delete
+	   (insert-char last-command-char 1)
+	   (perl-indent-line)
+	   (delete-char -1))))
+  (self-insert-command (prefix-numeric-value arg)))
+
+;; not used anymore, but may be useful someday:
+;;(defun perl-inside-parens-p ()
+;;  (condition-case ()
+;;      (save-excursion
+;;	(save-restriction
+;;	  (narrow-to-region (point)
+;;			    (perl-beginning-of-function))
+;;	  (goto-char (point-max))
+;;	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
+;;    (error nil)))
+
+(defun perl-indent-command (&optional arg)
+  "Indent current line as Perl code, or optionally, insert a tab character.
+
+With an argument, indent the current line, regardless of other options.
+
+If perl-tab-always-indent is nil and point is not in the indentation
+area at the beginning of the line, simply insert a tab.
+
+Otherwise, indent the current line.  If point was within the indentation
+area it is moved to the end of the indentation area.  If the line was
+already indented properly and point was not within the indentation area,
+and if perl-tab-to-comment is non-nil (the default), then do the first
+possible action from the following list:
+
+  1) delete an empty comment
+  2) move forward to start of comment, indenting if necessary
+  3) move forward to end of line
+  4) create an empty comment
+  5) move backward to start of comment, indenting if necessary."
+  (interactive "P")
+  (if arg				; If arg, just indent this line
+      (perl-indent-line "\f")
+    (if (and (not perl-tab-always-indent)
+	     (<= (current-column) (current-indentation)))
+	(insert-tab)
+      (let (bof lsexp delta (oldpnt (point)))
+	(beginning-of-line) 
+	(setq lsexp (point))
+	(setq bof (perl-beginning-of-function))
+	(goto-char oldpnt)
+	(setq delta (perl-indent-line "\f\\|;?#" bof))
+	(and perl-tab-to-comment
+	     (= oldpnt (point))		; done if point moved
+	     (if (listp delta)		; if line starts in a quoted string
+		 (setq lsexp (or (nth 2 delta) bof))
+	       (= delta 0))		; done if indenting occurred
+	     (let (eol state)
+	       (end-of-line) 
+	       (setq eol (point))
+	       (if (= (char-after bof) ?=)
+		   (if (= oldpnt eol)
+		       (message "In a format statement"))     
+		 (setq state (parse-partial-sexp lsexp eol))
+		 (if (nth 3 state)
+		     (if (= oldpnt eol)	; already at eol in a string
+			 (message "In a string which starts with a %c."
+				  (nth 3 state)))
+		   (if (not (nth 4 state))
+		       (if (= oldpnt eol) ; no comment, create one?
+			   (indent-for-comment))
+		     (beginning-of-line)
+		     (if (re-search-forward comment-start-skip eol 'move)
+			 (if (eolp)
+			     (progn	; kill existing comment
+			       (goto-char (match-beginning 0))
+			       (skip-chars-backward " \t")
+			       (kill-region (point) eol))
+			   (if (or (< oldpnt (point)) (= oldpnt eol))
+			       (indent-for-comment) ; indent existing comment
+			     (end-of-line)))
+		       (if (/= oldpnt eol)
+			   (end-of-line)
+			 (message "Use backslash to quote # characters.")
+			 (ding t))))))))))))
+
+(defun perl-indent-line (&optional nochange parse-start)
+  "Indent current line as Perl code.  Return the amount the indentation 
+changed by, or (parse-state) if line starts in a quoted string."
+  (let ((case-fold-search nil)
+	(pos (- (point-max) (point)))
+	(bof (or parse-start (save-excursion (perl-beginning-of-function))))
+	beg indent shift-amt)
+    (beginning-of-line)
+    (setq beg (point))
+    (setq shift-amt
+	  (cond ((= (char-after bof) ?=) 0)
+		((listp (setq indent (calculate-perl-indent bof))) indent)
+		((looking-at (or nochange perl-nochange)) 0)
+		(t
+		 (skip-chars-forward " \t\f")
+		 (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
+			(setq indent (max 1 (+ indent perl-label-offset))))
+		       ((= (following-char) ?})
+			(setq indent (- indent perl-indent-level)))
+		       ((= (following-char) ?{)
+			(setq indent (+ indent perl-brace-offset))))
+		 (- indent (current-column)))))
+    (skip-chars-forward " \t\f")
+    (if (and (numberp shift-amt) (/= 0 shift-amt))
+	(progn (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 calculate-perl-indent (&optional parse-start)
+  "Return appropriate indentation for current line as Perl code.
+In usual case returns an integer: the column to indent to.
+Returns (parse-state) if line starts inside a string."
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point))
+	  (case-fold-search nil)
+	  (colon-line-end 0)
+	  state containing-sexp)
+      (if parse-start			;used to avoid searching
+	  (goto-char parse-start)
+	(perl-beginning-of-function))
+      (while (< (point) indent-point)	;repeat until right sexp
+	(setq parse-start (point))
+	(setq state (parse-partial-sexp (point) indent-point 0))
+; state = (depth_in_parens innermost_containing_list last_complete_sexp
+;          string_terminator_or_nil inside_commentp following_quotep
+;          minimum_paren-depth_this_scan)
+; Parsing stops if depth in parentheses becomes equal to third arg.
+	(setq containing-sexp (nth 1 state)))
+      (cond ((nth 3 state) state)	; In a quoted string?
+	    ((null containing-sexp)	; Line is at top level.
+	     (skip-chars-forward " \t\f")
+	     (if (= (following-char) ?{)
+		 0   ; move to beginning of line if it starts a function body
+	       ;; indent a little if this is a continuation line
+	       (perl-backward-to-noncomment)
+	       (if (or (bobp)
+		       (memq (preceding-char) '(?\; ?\})))
+		   0 perl-continued-statement-offset)))
+	    ((/= (char-after containing-sexp) ?{)
+	     ;; line is expression, not statement:
+	     ;; indent to just after the surrounding open.
+	     (goto-char (1+ containing-sexp))
+	     (current-column))
+	    (t
+	     ;; Statement level.  Is it a continuation or a new statement?
+	     ;; Find previous non-comment character.
+	     (perl-backward-to-noncomment)
+	     ;; 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) ?:)
+			     (memq (char-syntax (char-after (- (point) 2)))
+				   '(?w ?_))))
+	       (if (eq (preceding-char) ?\,)
+		   (perl-backward-to-start-of-continued-exp containing-sexp))
+	       (beginning-of-line)
+	       (perl-backward-to-noncomment))
+	     ;; Now we get the answer.
+	     (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
+		 ;; This line is continuation of preceding line's statement;
+		 ;; indent  perl-continued-statement-offset  more than the
+		 ;; previous line of the statement.
+		 (progn
+		   (perl-backward-to-start-of-continued-exp containing-sexp)
+		   (+ perl-continued-statement-offset (current-column)
+		      (if (save-excursion (goto-char indent-point)
+					  (looking-at "[ \t]*{"))
+			  perl-continued-brace-offset 0)))
+	       ;; This line starts a new statement.
+	       ;; Position at last unclosed open.
+	       (goto-char containing-sexp)
+	       (or
+		 ;; If open paren is in col 0, close brace is special
+		 (and (bolp)
+		      (save-excursion (goto-char indent-point)
+				      (looking-at "[ \t]*}"))
+		      perl-indent-level)
+		 ;; Is line first statement after an open-brace?
+		 ;; If no, find that first statement and indent like it.
+		 (save-excursion
+		   (forward-char 1)
+		   ;; Skip over comments and labels following openbrace.
+		   (while (progn
+			    (skip-chars-forward " \t\f\n")
+			    (cond ((looking-at ";?#")
+				   (forward-line 1) t)
+				  ((looking-at "\\(\\w\\|\\s_\\)+:")
+				   (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))
+			    (- (current-indentation) perl-label-offset)
+			  (current-column))))
+		 ;; If no previous statement,
+		 ;; indent it relative to line brace is on.
+		 ;; For open paren in column zero, don't let statement
+		 ;; start there too.  If perl-indent-level is zero,
+		 ;; use perl-brace-offset + perl-continued-statement-offset
+		 ;; For open-braces not the first thing in a line,
+		 ;; add in perl-brace-imaginary-offset.
+		 (+ (if (and (bolp) (zerop perl-indent-level))
+			(+ perl-brace-offset perl-continued-statement-offset)
+		      perl-indent-level)
+		    ;; Move back over whitespace before the openbrace.
+		    ;; If openbrace is not first nonwhite thing on the line,
+		    ;; add the perl-brace-imaginary-offset.
+		    (progn (skip-chars-backward " \t")
+			   (if (bolp) 0 perl-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.
+		      (current-indentation))))))))))
+
+(defun perl-backward-to-noncomment ()
+  "Move point backward to after the first non-white-space, skipping comments."
+  (interactive)
+  (let (opoint stop)
+    (while (not stop)
+      (setq opoint (point))
+      (beginning-of-line)
+      (if (re-search-forward comment-start-skip opoint 'move 1)
+	  (progn (goto-char (match-end 1))
+		 (skip-chars-forward ";")))
+      (skip-chars-backward " \t\f")
+      (setq stop (or (bobp)
+		     (not (bolp))
+		     (forward-char -1))))))
+
+(defun perl-backward-to-start-of-continued-exp (lim)
+  (if (= (preceding-char) ?\))
+      (forward-sexp -1))
+  (beginning-of-line)
+  (if (<= (point) lim)
+      (goto-char (1+ lim)))
+  (skip-chars-forward " \t\f"))
+
+;; note: this may be slower than the c-mode version, but I can understand it.
+(defun indent-perl-exp ()
+  "Indent each line of the Perl grouping following point."
+  (interactive)
+  (let* ((case-fold-search nil)
+	 (oldpnt (point-marker))
+	 (bof-mark (save-excursion
+		     (end-of-line 2)
+		     (perl-beginning-of-function)
+		     (point-marker)))
+	 eol last-mark lsexp-mark delta)
+    (if (= (char-after (marker-position bof-mark)) ?=)
+	(message "Can't indent a format statement")
+      (message "Indenting Perl expression...")
+      (save-excursion (end-of-line) (setq eol (point)))
+      (save-excursion			; locate matching close paren
+	(while (and (not (eobp)) (<= (point) eol))
+	  (parse-partial-sexp (point) (point-max) 0))
+	(setq last-mark (point-marker)))
+      (setq lsexp-mark bof-mark)
+      (beginning-of-line)
+      (while (< (point) (marker-position last-mark))
+	(setq delta (perl-indent-line nil (marker-position bof-mark)))
+	(if (numberp delta)		; unquoted start-of-line?
+	    (progn 
+	      (if (eolp)
+		  (delete-horizontal-space))
+	      (setq lsexp-mark (point-marker))))
+	(end-of-line)
+	(setq eol (point))
+	(if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
+	    (progn			; line ends in a comment
+	      (beginning-of-line)
+	      (if (or (not (looking-at "\\s-*;?#"))
+		      (listp delta)
+		      (and (/= 0 delta)
+			   (= (- (current-indentation) delta) comment-column)))
+		  (if (re-search-forward comment-start-skip eol t)
+		      (indent-for-comment))))) ; indent existing comment
+	(forward-line 1))
+      (goto-char (marker-position oldpnt))
+      (message "Indenting Perl expression...done"))))
+
+(defun perl-beginning-of-function (&optional arg)
+  "Move backward to next beginning-of-function, or as far as possible.
+With argument, repeat that many times; negative args move forward.
+Returns new value of point in all cases."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (if (< arg 0) (forward-char 1))
+  (and (/= arg 0)
+       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
+			   nil 'move arg)
+       (goto-char (1- (match-end 0))))
+  (point))
+
+;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
+;; no bugs have been removed :-)
+(defun perl-end-of-function (&optional arg)
+  "Move forward to next end-of-function.
+The end of a function is found by moving forward from the beginning of one.
+With argument, repeat that many times; negative args move backward."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (let ((first t))
+    (while (and (> arg 0) (< (point) (point-max)))
+      (let ((pos (point)) npos)
+	(while (progn
+		(if (and first
+			 (progn
+			  (forward-char 1)
+			  (perl-beginning-of-function 1)
+			  (not (bobp))))
+		    nil
+		  (or (bobp) (forward-char -1))
+		  (perl-beginning-of-function -1))
+		(setq first nil)
+		(forward-list 1)
+		(skip-chars-forward " \t")
+		(if (looking-at "[#\n]")
+		    (forward-line 1))
+		(<= (point) pos))))
+      (setq arg (1- arg)))
+    (while (< arg 0)
+      (let ((pos (point)))
+	(perl-beginning-of-function 1)
+	(forward-sexp 1)
+	(forward-line 1)
+	(if (>= (point) pos)
+	    (if (progn (perl-beginning-of-function 2) (not (bobp)))
+		(progn
+		  (forward-list 1)
+		  (skip-chars-forward " \t")
+		  (if (looking-at "[#\n]")
+		      (forward-line 1)))
+	      (goto-char (point-min)))))
+      (setq arg (1+ arg)))))
+
+(defun mark-perl-function ()
+  "Put mark at end of Perl function, point at beginning."
+  (interactive)
+  (push-mark (point))
+  (perl-end-of-function)
+  (push-mark (point))
+  (perl-beginning-of-function)
+  (backward-paragraph))
+
+;;;;;;;; That's all, folks! ;;;;;;;;;
diff --git a/gnu/usr.bin/perl/emacs/perldb.el b/gnu/usr.bin/perl/emacs/perldb.el
new file mode 100644
index 000000000000..66951be26d5e
--- /dev/null
+++ b/gnu/usr.bin/perl/emacs/perldb.el
@@ -0,0 +1,423 @@
+;; Run perl -d under Emacs
+;; Based on gdb.el, as written by W. Schelter, and modified by rms.
+;; Modified for Perl by Ray Lischner (uunet!mntgfx!lisch), Nov 1990.
+
+;; This file is part of GNU Emacs.
+;; Copyright (C) 1988,1990 Free Software Foundation, Inc.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
+;; to anyone for the consequences of using it or for whether it serves
+;; any particular purpose or works at all, unless he says so in writing.
+;; Refer to the GNU Emacs General Public License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute GNU
+;; Emacs, but only under the conditions described in the GNU Emacs
+;; General Public License.  A copy of this license is supposed to have
+;; been given to you along with GNU Emacs so you can know your rights and
+;; responsibilities.  It should be in a file named COPYING.  Among other
+;; things, the copyright notice and this notice must be preserved on all
+;; copies.
+
+;; Description of perl -d interface:
+
+;; A facility is provided for the simultaneous display of the source code
+;; in one window, while using perldb to step through a function in the
+;; other.  A small arrow in the source window, indicates the current
+;; line.
+
+;; Starting up:
+
+;; In order to use this facility, invoke the command PERLDB to obtain a
+;; shell window with the appropriate command bindings.  You will be asked
+;; for the name of a file to run and additional command line arguments.
+;; Perldb will be invoked on this file, in a window named *perldb-foo*
+;; if the file is foo.
+
+;; M-s steps by one line, and redisplays the source file and line.
+
+;; You may easily create additional commands and bindings to interact
+;; with the display.  For example to put the perl debugger command n on \M-n
+;; (def-perldb n "\M-n")
+
+;; This causes the emacs command perldb-next to be defined, and runs
+;; perldb-display-frame after the command.
+
+;; perldb-display-frame is the basic display function.  It tries to display
+;; in the other window, the file and line corresponding to the current
+;; position in the perldb window.  For example after a perldb-step, it would
+;; display the line corresponding to the position for the last step.  Or
+;; if you have done a backtrace in the perldb buffer, and move the cursor
+;; into one of the frames, it would display the position corresponding to
+;; that frame.
+
+;; perldb-display-frame is invoked automatically when a filename-and-line-number
+;; appears in the output.
+
+
+(require 'shell)
+
+(defvar perldb-prompt-pattern "^  DB<[0-9]+> "
+  "A regexp to recognize the prompt for perldb.") 
+
+(defvar perldb-mode-map nil
+  "Keymap for perldb-mode.")
+
+(if perldb-mode-map
+   nil
+  (setq perldb-mode-map (copy-keymap shell-mode-map))
+  (define-key perldb-mode-map "\C-l" 'perldb-refresh))
+
+(define-key ctl-x-map " " 'perldb-break)
+(define-key ctl-x-map "&" 'send-perldb-command)
+
+;;Of course you may use `def-perldb' with any other perldb command, including
+;;user defined ones.   
+
+(defmacro def-perldb (name key &optional doc)
+  (let* ((fun (intern (concat "perldb-" name))))
+    (` (progn
+	 (defun (, fun) (arg)
+	   (, (or doc ""))
+	   (interactive "p")
+	   (perldb-call (if (not (= 1 arg))
+			    (concat (, name) arg)
+			  (, name))))
+	 (define-key perldb-mode-map (, key) (quote (, fun)))))))
+
+(def-perldb "s"   "\M-s" "Step one source line with display")
+(def-perldb "n"   "\M-n" "Step one source line (skip functions)")
+(def-perldb "c"   "\M-c" "Continue with display")
+(def-perldb "r"   "\C-c\C-r" "Return from current subroutine")
+(def-perldb "A"   "\C-c\C-a" "Delete all actions")
+
+(defun perldb-mode ()
+  "Major mode for interacting with an inferior Perl debugger process.
+The following commands are available:
+
+\\{perldb-mode-map}
+
+\\[perldb-display-frame] displays in the other window
+the last line referred to in the perldb buffer.
+
+\\[perldb-s],\\[perldb-n], and \\[perldb-n] in the perldb window,
+call perldb to step, next or continue and then update the other window
+with the current file and position.
+
+If you are in a source file, you may select a point to break
+at, by doing \\[perldb-break].
+
+Commands:
+Many commands are inherited from shell mode. 
+Additionally we have:
+
+\\[perldb-display-frame] display frames file in other window
+\\[perldb-s] advance one line in program
+\\[perldb-n] advance one line in program (skip over calls).
+\\[send-perldb-command] used for special printing of an arg at the current point.
+C-x SPACE sets break point at current line."
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'perldb-mode)
+  (setq mode-name "Inferior Perl")
+  (setq mode-line-process '(": %s"))
+  (use-local-map perldb-mode-map)
+  (make-local-variable 'last-input-start)
+  (setq last-input-start (make-marker))
+  (make-local-variable 'last-input-end)
+  (setq last-input-end (make-marker))
+  (make-local-variable 'perldb-last-frame)
+  (setq perldb-last-frame nil)
+  (make-local-variable 'perldb-last-frame-displayed-p)
+  (setq perldb-last-frame-displayed-p t)
+  (make-local-variable 'perldb-delete-prompt-marker)
+  (setq perldb-delete-prompt-marker nil)
+  (make-local-variable 'perldb-filter-accumulator)
+  (setq perldb-filter-accumulator nil)
+  (make-local-variable 'shell-prompt-pattern)
+  (setq shell-prompt-pattern perldb-prompt-pattern)
+  (run-hooks 'shell-mode-hook 'perldb-mode-hook))
+
+(defvar current-perldb-buffer nil)
+
+(defvar perldb-command-name "perl"
+  "Pathname for executing perl -d.")
+
+(defun end-of-quoted-arg (argstr start end)
+  (let* ((chr (substring argstr start (1+ start)))
+	 (idx (string-match (concat "[^\\]" chr) argstr (1+ start))))
+    (and idx (1+ idx))
+    )
+)
+
+(defun parse-args-helper (arglist argstr start end)
+  (while (and (< start end) (string-match "[ \t\n\f\r\b]"
+					  (substring argstr start (1+ start))))
+    (setq start (1+ start)))
+  (cond
+    ((= start end) arglist)
+    ((string-match "[\"']" (substring argstr start (1+ start)))
+     (let ((next (end-of-quoted-arg argstr start end)))
+       (parse-args-helper (cons (substring argstr (1+ start) next) arglist)
+			  argstr (1+ next) end)))
+    (t (let ((next (string-match "[ \t\n\f\b\r]" argstr start)))
+	 (if next
+	     (parse-args-helper (cons (substring argstr start next) arglist)
+				argstr (1+ next) end)
+	   (cons (substring argstr start) arglist))))
+    )
+  )
+    
+(defun parse-args (args)
+  "Extract arguments from a string ARGS.
+White space separates arguments, with single or double quotes
+used to protect spaces.  A list of strings is returned, e.g.,
+(parse-args \"foo bar 'two args'\") => (\"foo\" \"bar\" \"two args\")."
+  (nreverse (parse-args-helper '() args 0 (length args)))
+)
+
+(defun perldb (path args)
+  "Run perldb on program FILE in buffer *perldb-FILE*.
+The default directory for the current buffer becomes the initial
+working directory, by analogy with  gdb .  If you wish to change this, use
+the Perl command `chdir(DIR)'."
+  (interactive "FRun perl -d on file: \nsCommand line arguments: ")
+  (setq path (expand-file-name path))
+  (let ((file (file-name-nondirectory path))
+	(dir default-directory))
+    (switch-to-buffer (concat "*perldb-" file "*"))
+    (setq default-directory dir)
+    (or (bolp) (newline))
+    (insert "Current directory is " default-directory "\n")
+    (apply 'make-shell
+	   (concat "perldb-" file) perldb-command-name nil "-d" path "-emacs"
+	   (parse-args args))
+    (perldb-mode)
+    (set-process-filter (get-buffer-process (current-buffer)) 'perldb-filter)
+    (set-process-sentinel (get-buffer-process (current-buffer)) 'perldb-sentinel)
+    (perldb-set-buffer)))
+
+(defun perldb-set-buffer ()
+  (cond ((eq major-mode 'perldb-mode)
+	(setq current-perldb-buffer (current-buffer)))))
+
+;; This function is responsible for inserting output from Perl
+;; into the buffer.
+;; Aside from inserting the text, it notices and deletes
+;; each filename-and-line-number;
+;; that Perl prints to identify the selected frame.
+;; It records the filename and line number, and maybe displays that file.
+(defun perldb-filter (proc string)
+  (let ((inhibit-quit t))
+    (if perldb-filter-accumulator
+	(perldb-filter-accumulate-marker proc
+				      (concat perldb-filter-accumulator string))
+	(perldb-filter-scan-input proc string))))
+
+(defun perldb-filter-accumulate-marker (proc string)
+  (setq perldb-filter-accumulator nil)
+  (if (> (length string) 1)
+      (if (= (aref string 1) ?\032)
+	  (let ((end (string-match "\n" string)))
+	    (if end
+		(progn
+		  (let* ((first-colon (string-match ":" string 2))
+			 (second-colon
+			  (string-match ":" string (1+ first-colon))))
+		    (setq perldb-last-frame
+			  (cons (substring string 2 first-colon)
+				(string-to-int
+				 (substring string (1+ first-colon)
+					    second-colon)))))
+		  (setq perldb-last-frame-displayed-p nil)
+		  (perldb-filter-scan-input proc
+					 (substring string (1+ end))))
+	      (setq perldb-filter-accumulator string)))
+	(perldb-filter-insert proc "\032")
+	(perldb-filter-scan-input proc (substring string 1)))
+    (setq perldb-filter-accumulator string)))
+
+(defun perldb-filter-scan-input (proc string)
+  (if (equal string "")
+      (setq perldb-filter-accumulator nil)
+      (let ((start (string-match "\032" string)))
+	(if start
+	    (progn (perldb-filter-insert proc (substring string 0 start))
+		   (perldb-filter-accumulate-marker proc
+						 (substring string start)))
+	    (perldb-filter-insert proc string)))))
+
+(defun perldb-filter-insert (proc string)
+  (let ((moving (= (point) (process-mark proc)))
+	(output-after-point (< (point) (process-mark proc)))
+	(old-buffer (current-buffer))
+	start)
+    (set-buffer (process-buffer proc))
+    (unwind-protect
+	(save-excursion
+	  ;; Insert the text, moving the process-marker.
+	  (goto-char (process-mark proc))
+	  (setq start (point))
+	  (insert string)
+	  (set-marker (process-mark proc) (point))
+	  (perldb-maybe-delete-prompt)
+	  ;; Check for a filename-and-line number.
+	  (perldb-display-frame
+	   ;; Don't display the specified file
+	   ;; unless (1) point is at or after the position where output appears
+	   ;; and (2) this buffer is on the screen.
+	   (or output-after-point
+	       (not (get-buffer-window (current-buffer))))
+	   ;; Display a file only when a new filename-and-line-number appears.
+	   t))
+      (set-buffer old-buffer))
+    (if moving (goto-char (process-mark proc)))))
+
+(defun perldb-sentinel (proc msg)
+  (cond ((null (buffer-name (process-buffer proc)))
+	 ;; buffer killed
+	 ;; Stop displaying an arrow in a source file.
+	 (setq overlay-arrow-position nil)
+	 (set-process-buffer proc nil))
+	((memq (process-status proc) '(signal exit))
+	 ;; Stop displaying an arrow in a source file.
+	 (setq overlay-arrow-position nil)
+	 ;; Fix the mode line.
+	 (setq mode-line-process
+	       (concat ": "
+		       (symbol-name (process-status proc))))
+	 (let* ((obuf (current-buffer)))
+	   ;; save-excursion isn't the right thing if
+	   ;;  process-buffer is current-buffer
+	   (unwind-protect
+	       (progn
+		 ;; Write something in *compilation* and hack its mode line,
+		 (set-buffer (process-buffer proc))
+		 ;; Force mode line redisplay soon
+		 (set-buffer-modified-p (buffer-modified-p))
+		 (if (eobp)
+		     (insert ?\n mode-name " " msg)
+		   (save-excursion
+		     (goto-char (point-max))
+		     (insert ?\n mode-name " " msg)))
+		 ;; If buffer and mode line will show that the process
+		 ;; is dead, we can delete it now.  Otherwise it
+		 ;; will stay around until M-x list-processes.
+		 (delete-process proc))
+	     ;; Restore old buffer, but don't restore old point
+	     ;; if obuf is the perldb buffer.
+	     (set-buffer obuf))))))
+
+
+(defun perldb-refresh ()
+  "Fix up a possibly garbled display, and redraw the arrow."
+  (interactive)
+  (redraw-display)
+  (perldb-display-frame))
+
+(defun perldb-display-frame (&optional nodisplay noauto)
+  "Find, obey and delete the last filename-and-line marker from PERLDB.
+The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
+Obeying it means displaying in another window the specified file and line."
+  (interactive)
+  (perldb-set-buffer)
+  (and perldb-last-frame (not nodisplay)
+       (or (not perldb-last-frame-displayed-p) (not noauto))
+       (progn (perldb-display-line (car perldb-last-frame) (cdr perldb-last-frame))
+	      (setq perldb-last-frame-displayed-p t))))
+
+;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
+;; and that its line LINE is visible.
+;; Put the overlay-arrow on the line LINE in that buffer.
+
+(defun perldb-display-line (true-file line)
+  (let* ((buffer (find-file-noselect true-file))
+	 (window (display-buffer buffer t))
+	 (pos))
+    (save-excursion
+      (set-buffer buffer)
+      (save-restriction
+	(widen)
+	(goto-line line)
+	(setq pos (point))
+	(setq overlay-arrow-string "=>")
+	(or overlay-arrow-position
+	    (setq overlay-arrow-position (make-marker)))
+	(set-marker overlay-arrow-position (point) (current-buffer)))
+      (cond ((or (< pos (point-min)) (> pos (point-max)))
+	     (widen)
+	     (goto-char pos))))
+    (set-window-point window overlay-arrow-position)))
+
+(defun perldb-call (command)
+  "Invoke perldb COMMAND displaying source in other window."
+  (interactive)
+  (goto-char (point-max))
+  (setq perldb-delete-prompt-marker (point-marker))
+  (perldb-set-buffer)
+  (send-string (get-buffer-process current-perldb-buffer)
+	       (concat command "\n")))
+
+(defun perldb-maybe-delete-prompt ()
+  (if (and perldb-delete-prompt-marker
+	   (> (point-max) (marker-position perldb-delete-prompt-marker)))
+      (let (start)
+	(goto-char perldb-delete-prompt-marker)
+	(setq start (point))
+	(beginning-of-line)
+	(delete-region (point) start)
+	(setq perldb-delete-prompt-marker nil))))
+
+(defun perldb-break ()
+  "Set PERLDB breakpoint at this source line."
+  (interactive)
+  (let ((line (save-restriction
+		(widen)
+		(1+ (count-lines 1 (point))))))
+    (send-string (get-buffer-process current-perldb-buffer)
+		 (concat "b " line "\n"))))
+
+(defun perldb-read-token()
+  "Return a string containing the token found in the buffer at point.
+A token can be a number or an identifier.  If the token is a name prefaced
+by `$', `@', or `%', the leading character is included in the token."
+  (save-excursion
+    (let (begin)
+      (or (looking-at "[$@%]")
+	  (re-search-backward "[^a-zA-Z_0-9]" (point-min) 'move))
+      (setq begin (point))
+      (or (looking-at "[$@%]") (setq begin (+ begin 1)))
+      (forward-char 1)
+      (buffer-substring begin
+			(if (re-search-forward "[^a-zA-Z_0-9]"
+					       (point-max) 'move)
+			       (- (point) 1)
+			  (point)))
+)))
+
+(defvar perldb-commands nil
+  "List of strings or functions used by send-perldb-command.
+It is for customization by the user.")
+
+(defun send-perldb-command (arg)
+  "Issue a Perl debugger command selected by the prefix arg.  A numeric
+arg selects the ARG'th member COMMAND of the list perldb-commands.
+The token under the cursor is passed to the command.  If COMMAND is a
+string, (format COMMAND TOKEN) is inserted at the end of the perldb
+buffer, otherwise (funcall COMMAND TOKEN) is inserted.  If there is
+no such COMMAND, then the token itself is inserted.  For example,
+\"p %s\" is a possible string to be a member of perldb-commands,
+or \"p $ENV{%s}\"."
+  (interactive "P")
+  (let (comm token)
+    (if arg (setq comm (nth arg perldb-commands)))
+    (setq token (perldb-read-token))
+    (if (eq (current-buffer) current-perldb-buffer)
+	(set-mark (point)))
+    (cond (comm
+	   (setq comm
+		 (if (stringp comm) (format comm token) (funcall comm token))))
+	  (t (setq comm token)))
+    (switch-to-buffer-other-window current-perldb-buffer)
+    (goto-char (dot-max))
+    (insert-string comm)))
diff --git a/gnu/usr.bin/perl/emacs/perldb.pl b/gnu/usr.bin/perl/emacs/perldb.pl
new file mode 100644
index 000000000000..7c9e6513ea0c
--- /dev/null
+++ b/gnu/usr.bin/perl/emacs/perldb.pl
@@ -0,0 +1,568 @@
+package DB;
+
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+
+$header = '$Header: /home/cvs/386BSD/ports/lang/perl/emacs/perldb.pl,v 1.1.1.1 1993/08/23 21:29:46 nate Exp $';
+#
+# 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 do DB'DB(<linenum>); in front of every place that can
+# have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
+#
+# $Log: perldb.pl,v $
+# Revision 1.1.1.1  1993/08/23  21:29:46  nate
+# PERL!
+#
+# Revision 4.0  91/03/20  01:18:58  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.6  91/01/11  18:08:58  lwall
+# patch42: @_ couldn't be accessed from debugger
+# 
+# Revision 3.0.1.5  90/11/10  01:40:26  lwall
+# patch38: the debugger wouldn't stop correctly or do action routines
+# 
+# Revision 3.0.1.4  90/10/15  17:40:38  lwall
+# patch29: added caller
+# patch29: the debugger now understands packages and evals
+# patch29: scripts now run at almost full speed under the debugger
+# patch29: more variables are settable from debugger
+# 
+# Revision 3.0.1.3  90/08/09  04:00:58  lwall
+# patch19: debugger now allows continuation lines
+# patch19: debugger can now dump lists of variables
+# patch19: debugger can now add aliases easily from prompt
+# 
+# Revision 3.0.1.2  90/03/12  16:39:39  lwall
+# patch13: perl -d didn't format stack traces of *foo right
+# patch13: perl -d wiped out scalar return values of subroutines
+# 
+# Revision 3.0.1.1  89/10/26  23:14:02  lwall
+# patch1: RCS expanded an unintended $Header in lib/perldb.pl
+# 
+# Revision 3.0  89/10/18  15:19:46  lwall
+# 3.0 baseline
+# 
+# Revision 2.0  88/06/05  00:09:45  root
+# Baseline version 2.0.
+# 
+#
+
+open(IN, "</dev/tty") || open(IN,  "<&STDIN");	# so we don't dingle stdin
+open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");	# so we don't dongle stdout
+select(OUT);
+$| = 1;				# for DB'OUT
+select(STDOUT);
+$| = 1;				# for real STDOUT
+$sub = '';
+
+# Is Perl being run from Emacs?
+$emacs = $main'ARGV[$[] eq '-emacs';
+shift(@main'ARGV) if $emacs;
+
+$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n";
+
+sub DB {
+    &save;
+    ($package, $filename, $line) = caller;
+    $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
+	"package $package;";		# this won't let them modify, alas
+    local(*dbline) = "_<$filename";
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	}
+	else {
+	    $evalarg = "\$DB'signal |= do {$stop;}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    if ($single || $trace || $signal) {
+	if ($emacs) {
+	    print OUT "\032\032$filename:$line:0\n";
+	} else {
+	    print OUT "$package'" unless $sub =~ /'/;
+	    print OUT "$sub($filename:$line):\t",$dbline[$line];
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+		last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+		print OUT "$sub($filename:$i):\t",$dbline[$i];
+	    }
+	}
+    }
+    $evalarg = $action, &eval if $action;
+    if ($single || $signal) {
+	$evalarg = $pre, &eval if $pre;
+	print OUT $#stack . " levels deep in subroutine calls!\n"
+	    if $single & 4;
+	$start = $line;
+	while ((print OUT "  DB<", $#hist+1, "> "), $cmd=&gets) {
+	    $single = 0;
+	    $signal = 0;
+	    $cmd eq '' && exit 0;
+	    chop($cmd);
+	    $cmd =~ s/\\$// && do {
+		print OUT "  cont: ";
+		$cmd .= &gets;
+		redo;
+	    };
+	    $cmd =~ /^q$/ && exit 0;
+	    $cmd =~ /^$/ && ($cmd = $laststep);
+	    push(@hist,$cmd) if length($cmd) > 1;
+	    ($i) = split(/\s+/,$cmd);
+	    eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i};
+	    $cmd =~ /^h$/ && do {
+		print OUT "
+T		Stack trace.
+s		Single step.
+n		Next, steps over subroutine calls.
+r		Return from current subroutine.
+c [line]	Continue; optionally inserts a one-time-only breakpoint 
+		at the specified line.
+<CR>		Repeat last n or s.
+l min+incr	List incr+1 lines starting at min.
+l min-max	List lines.
+l line		List line;
+l		List next window.
+-		List previous window.
+w line		List window around line.
+l subname	List subroutine.
+f filename	Switch to filename.
+/pattern/	Search forwards for pattern; final / is optional.
+?pattern?	Search backwards for pattern.
+L		List breakpoints and actions.
+S		List subroutine names.
+t		Toggle trace mode.
+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 breakpoint.
+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).
+X [vars]	Same as \"V currentpackage [vars]\".
+< command	Define command before prompt.
+| command	Define command after prompt.
+! number	Redo command (default previous command).
+! -number	Redo number\'th to last command.
+H -number	Display last number commands (default all).
+q or ^D		Quit.
+p expr		Same as \"print DB'OUT expr\" in current package.
+= [alias value]	Define a command alias, or list current aliases.
+command		Execute as a perl statement in current package.
+
+";
+		next; };
+	    $cmd =~ /^t$/ && do {
+		$trace = !$trace;
+		print OUT "Trace = ".($trace?"on":"off")."\n";
+		next; };
+	    $cmd =~ /^S$/ && do {
+		foreach $subname (sort(keys %sub)) {
+		    print OUT $subname,"\n";
+		}
+		next; };
+	    $cmd =~ s/^X\b/V $package/;
+	    $cmd =~ /^V$/ && do {
+		$cmd = 'V $package'; };
+	    $cmd =~ /^V\s*(\S+)\s*(.*)/ && do {
+		$packname = $1;
+		@vars = split(' ',$2);
+		do 'dumpvar.pl' unless defined &main'dumpvar;
+		if (defined &main'dumpvar) {
+		    &main'dumpvar($packname,@vars);
+		}
+		else {
+		    print DB'OUT "dumpvar.pl not available.\n";
+		}
+		next; };
+	    $cmd =~ /^f\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;
+		}
+		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 anything matching $file.\n";
+		    next;
+		}
+		elsif ($file ne $filename) {
+		    *dbline = "_<$file";
+		    $max = $#dbline;
+		    $filename = $file;
+		    $start = 1;
+		    $cmd = "l";
+		} };
+	    $cmd =~ /^l\s*(['A-Za-z_]['\w]*)/ && do {
+		$subname = $1;
+		$subname = "main'" . $subname unless $subname =~ /'/;
+		$subname = "main" . $subname if substr($subname,0,1) eq "'";
+		($file,$subrange) = split(/:/,$sub{$subname});
+		if ($file ne $filename) {
+		    *dbline = "_<$file";
+		    $max = $#dbline;
+		    $filename = $file;
+		}
+		if ($subrange) {
+		    if (eval($subrange) < -$window) {
+			$subrange =~ s/-.*/+/;
+		    }
+		    $cmd = "l $subrange";
+		} else {
+		    print OUT "Subroutine $1 not found.\n";
+		    next;
+		} };
+	    $cmd =~ /^w\s*(\d*)$/ && do {
+		$incr = $window - 1;
+		$start = $1 if $1;
+		$start -= $preview;
+		$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\s*(\d*)\+(\d*)$/ && do {
+		$start = $1 if $1;
+		$incr = $2;
+		$incr = $window - 1 unless $incr;
+		$cmd = 'l ' . $start . '-' . ($start + $incr); };
+	    $cmd =~ /^l\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+		$end = (!$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++) {
+			print OUT "$i:\t", $dbline[$i];
+			last if $signal;
+		    }
+		}
+		$start = $i;	# remember in case they want more
+		$start = $max if $start > $max;
+		next; };
+	    $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 =~ /^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 =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do {
+		$subname = $1;
+		$cond = $2 || '1';
+		$subname = "$package'" . $subname unless $subname =~ /'/;
+		$subname = "main" . $subname if substr($subname,0,1) eq "'";
+		($filename,$i) = split(/[:-]/, $sub{$subname});
+		if ($i) {
+		    *dbline = "_<$filename";
+		    ++$i while $dbline[$i] == 0 && $i < $#dbline;
+		    $dbline{$i} =~ s/^[^\0]*/$cond/;
+		} else {
+		    print OUT "Subroutine $subname not found.\n";
+		}
+		next; };
+	    $cmd =~ /^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 =~ /^d\s*(\d+)?/ && do {
+		$i = ($1?$1:$line);
+		$dbline{$i} =~ s/^[^\0]*//;
+		delete $dbline{$i} if $dbline{$i} eq '';
+		next; };
+	    $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 =~ /^<\s*(.*)/ && do {
+		$pre = do action($1);
+		next; };
+	    $cmd =~ /^>\s*(.*)/ && do {
+		$post = do action($1);
+		next; };
+	    $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do {
+		$i = $1;
+		if ($dbline[$i] == 0) {
+		    print OUT "Line $i may not have an action.\n";
+		} else {
+		    $dbline{$i} =~ s/\0[^\0]*//;
+		    $dbline{$i} .= "\0" . do action($3);
+		}
+		next; };
+	    $cmd =~ /^n$/ && do {
+		$single = 2;
+		$laststep = $cmd;
+		last; };
+	    $cmd =~ /^s$/ && do {
+		$single = 1;
+		$laststep = $cmd;
+		last; };
+	    $cmd =~ /^c\s*(\d*)\s*$/ && do {
+		$i = $1;
+		if ($i) {
+		    if ($dbline[$i] == 0) {
+		        print OUT "Line $i not breakable.\n";
+			next;
+		    }
+		    $dbline{$i} =~ s/(\0|$)/;9$1/;	# add one-time-only b.p.
+		}
+		for ($i=0; $i <= $#stack; ) {
+		    $stack[$i++] &= ~1;
+		}
+		last; };
+	    $cmd =~ /^r$/ && do {
+		$stack[$#stack] |= 2;
+		last; };
+	    $cmd =~ /^T$/ && do {
+		local($p,$f,$l,$s,$h,$a,@a,@sub);
+		for ($i = 1; ($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(@sub, "$w&$s$a from file $f line $l\n");
+		    last if $signal;
+		}
+		for ($i=0; $i <= $#sub; $i++) {
+		    last if $signal;
+		    print OUT $sub[$i];
+		}
+	        next; };
+	    $cmd =~ /^\/(.*)$/ && do {
+		$inpat = $1;
+		$inpat =~ s:([^\\])/$:$1:;
+		if ($inpat ne "") {
+		    eval '$inpat =~ m'."\n$inpat\n";	
+		    if ($@ ne "") {
+		    	print OUT "$@";
+		    	next;
+		    }
+		    $pat = $inpat;
+		}
+		$end = $start;
+		eval '
+		for (;;) {
+		    ++$start;
+		    $start = 1 if ($start > $max);
+		    last if ($start == $end);
+		    if ($dbline[$start] =~ m'."\n$pat\n".'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 =~ /^\?(.*)$/ && do {
+		$inpat = $1;
+		$inpat =~ s:([^\\])\?$:$1:;
+		if ($inpat ne "") {
+		    eval '$inpat =~ m'."\n$inpat\n";	
+		    if ($@ ne "") {
+		    	print OUT "$@";
+		    	next;
+		    }
+		    $pat = $inpat;
+		}
+		$end = $start;
+		eval '
+		for (;;) {
+		    --$start;
+		    $start = $max if ($start <= 0);
+		    last if ($start == $end);
+		    if ($dbline[$start] =~ m'."\n$pat\n".'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 =~ /^!+\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 =~ /^!(.+)$/ && 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 = $hist[$i] . "\n";
+		print OUT $cmd;
+		redo; };
+	    $cmd =~ /^H\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 =~ s/^p( .*)?$/print DB'OUT$1/;
+	    $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; };
+	    $evalarg = $cmd; &eval;
+	    print OUT "\n";
+	}
+	if ($post) {
+	    $evalarg = $post; &eval;
+	}
+    }
+    ($@, $!, $[, $,, $/, $\) = @saved;
+}
+
+sub save {
+    @saved = ($@, $!, $[, $,, $/, $\);
+    $[ = 0; $, = ""; $/ = "\n"; $\ = "";
+}
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub eval {
+    eval "$usercontext $evalarg; &DB'save";
+    print OUT $@;
+}
+
+sub action {
+    local($action) = @_;
+    while ($action =~ s/\\$//) {
+	print OUT "+ ";
+	$action .= &gets;
+    }
+    $action;
+}
+
+sub gets {
+    local($.);
+    <IN>;
+}
+
+sub catch {
+    $signal = 1;
+}
+
+sub sub {
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    if (wantarray) {
+	@i = &$sub;
+	$single |= pop(@stack);
+	@i;
+    }
+    else {
+	$i = &$sub;
+	$single |= pop(@stack);
+	$i;
+    }
+}
+
+$single = 1;			# so it stops on first executable statement
+@hist = ('?');
+$SIG{'INT'} = "DB'catch";
+$deep = 100;		# warning if stack gets this deep
+$window = 10;
+$preview = 3;
+
+@stack = (0);
+@ARGS = @ARGV;
+for (@args) {
+    s/'/\\'/g;
+    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+}
+
+if (-f '.perldb') {
+    do './.perldb';
+}
+elsif (-f "$ENV{'LOGDIR'}/.perldb") {
+    do "$ENV{'LOGDIR'}/.perldb";
+}
+elsif (-f "$ENV{'HOME'}/.perldb") {
+    do "$ENV{'HOME'}/.perldb";
+}
+
+1;
diff --git a/gnu/usr.bin/perl/emacs/tedstuff b/gnu/usr.bin/perl/emacs/tedstuff
new file mode 100644
index 000000000000..257bbc8553b9
--- /dev/null
+++ b/gnu/usr.bin/perl/emacs/tedstuff
@@ -0,0 +1,296 @@
+Article 4417 of comp.lang.perl:
+Path: jpl-devvax!elroy.jpl.nasa.gov!decwrl!mcnc!uvaarpa!mmdf
+From: ted@evi.com (Ted Stefanik)
+Newsgroups: comp.lang.perl
+Subject: Correction to Perl fatal error marking in GNU Emacs
+Message-ID: <1991Feb27.065853.15801@uvaarpa.Virginia.EDU>
+Date: 27 Feb 91 06:58:53 GMT
+Sender: mmdf@uvaarpa.Virginia.EDU (Uvaarpa Mail System)
+Reply-To: ted@evi.com (Ted Stefanik)
+Organization: The Internet
+Lines: 282
+
+Reading my own message, it occurred to me that I didn't quite satisfy the
+request of stef@zweig.sun (Stephane Payrard):
+
+| Does anyone has extended perdb/perdb.el to position the
+| point to the first syntax error? It would be cool.
+
+What I posted is a way to use the "M-x compile" command to test perl scripts.
+(Needless to say, the script cannot be not interactive; you can't provide input
+to a *compilation* buffer).  When creating new Perl programs, I use "M-x
+compile" until I'm sure that they are syntatically correct; if syntax errors
+occur, C-x` takes me to each in sequence.  After I'm sure the syntax is
+correct, I start worrying about semantics, and switch to "M-x perldb" if
+necessary.
+
+Therefore, the stuff I posted works great with "M-x compile", but not at all
+with "M-x perldb".
+
+Next, let me update what I posted.  I found that perl's die() command doesn't
+print the same format error message as perl does when it dies with a syntax
+error.   If you put the following in your ".emacs" file, it causes C-x` to
+recognize both kinds of errors:
+
+(load-library "compile")
+(setq compilation-error-regexp
+  "\\([^ :\n]+\\(: *\\|, line \\|(\\)[0-9]+\\)\\|\\([0-9]+ *of *[^ \n]+\\|[^ \n]+ \\(at \\)*line [0-9]+\\)")
+
+Last, so I don't look like a total fool, let me propose a way to satisfy
+Stephane Payrard's original request (repeated again):
+
+| Does anyone has extended perdb/perdb.el to position the
+| point to the first syntax error? It would be cool.
+
+I'm not satisfied with just the "first syntax error".  Perl's parser is better
+than most about not getting out of sync; therefore, if it reports multiple
+errors, you can usually be assured they are all real errors.
+
+So... I hacked in the "next-error" function from "compile.el" to form
+"perldb-next-error".  You can apply the patches at the end of this message
+to add "perldb-next-error" to your "perldb.el".
+
+Notes:
+   1) The patch binds "perldb-next-error" to C-x~ (because ~ is the shift
+      of ` on my keyboard, and C-x~ is not yet taken in my version of EMACS).
+
+   2) "next-error" is meant to work on a single *compilation* buffer; any new
+      "M-x compile" or "M-x grep" command will clear the old *compilation*
+      buffer and reset the compilation-error parser to start at the top of the
+      *compilation* buffer.
+
+     "perldb-next-error", on the other hand, has to deal with multiple
+      *perldb-<foo>* buffers, each of which keep growing.  "perldb-next-error"
+      correctly handles the constantly growing *perldb-<foo>* buffers by
+      keeping track of the last reported error in the "current-perldb-buffer".
+
+      Sadly however, when you invoke a new "M-x perldb" on a different Perl
+      script, "perldb-next-error" will start parsing the new *perldb-<bar>*
+      buffer at the top (even if it was previously parsed), and will completely
+      lose the marker of the last reported error in *perldb-<foo>*.
+
+   3) "perldb-next-error" still uses "compilation-error-regexp" to find
+      fatal errors.  Therefore, both the "M-x compile"/C-x` scheme and
+      the "M-x perldb"/C-x~ scheme can be used to find fatal errors that
+      match the common "compilation-error-regexp".  You *will* want to install
+      that "compilation-error-regexp" stuff into your .emacs file.
+
+   4) The patch was developed and tested with GNU Emacs 18.55.
+
+   5) Since the patch was ripped off from compile.el, the code is (of
+      course) subject to the GNU copyleft.
+
+*** perldb.el.orig	Wed Feb 27 00:44:27 1991
+--- perldb.el	Wed Feb 27 00:44:30 1991
+***************
+*** 199,205 ****
+  
+  (defun perldb-set-buffer ()
+    (cond ((eq major-mode 'perldb-mode)
+! 	(setq current-perldb-buffer (current-buffer)))))
+  
+  ;; This function is responsible for inserting output from Perl
+  ;; into the buffer.
+--- 199,211 ----
+  
+  (defun perldb-set-buffer ()
+    (cond ((eq major-mode 'perldb-mode)
+!          (cond ((not (eq current-perldb-buffer (current-buffer)))
+!                 (perldb-forget-errors)
+!                 (setq perldb-parsing-end 2)) ;; 2 to defeat grep defeater
+!                (t
+!                 (if (> perldb-parsing-end (point-max))
+!                     (setq perldb-parsing-end (max (point-max) 2)))))
+!          (setq current-perldb-buffer (current-buffer)))))
+  
+  ;; This function is responsible for inserting output from Perl
+  ;; into the buffer.
+***************
+*** 291,297 ****
+  	   ;;  process-buffer is current-buffer
+  	   (unwind-protect
+  	       (progn
+! 		 ;; Write something in *compilation* and hack its mode line,
+  		 (set-buffer (process-buffer proc))
+  		 ;; Force mode line redisplay soon
+  		 (set-buffer-modified-p (buffer-modified-p))
+--- 297,303 ----
+  	   ;;  process-buffer is current-buffer
+  	   (unwind-protect
+  	       (progn
+! 		 ;; Write something in *perldb-<foo>* and hack its mode line,
+  		 (set-buffer (process-buffer proc))
+  		 ;; Force mode line redisplay soon
+  		 (set-buffer-modified-p (buffer-modified-p))
+***************
+*** 421,423 ****
+--- 427,593 ----
+      (switch-to-buffer-other-window current-perldb-buffer)
+      (goto-char (dot-max))
+      (insert-string comm)))
++ 
++ (defvar perldb-error-list nil
++   "List of error message descriptors for visiting erring functions.
++ Each error descriptor is a list of length two.
++ Its car is a marker pointing to an error message.
++ Its cadr is a marker pointing to the text of the line the message is about,
++   or nil if that is not interesting.
++ The value may be t instead of a list;
++ this means that the buffer of error messages should be reparsed
++ the next time the list of errors is wanted.")
++ 
++ (defvar perldb-parsing-end nil
++   "Position of end of buffer when last error messages parsed.")
++ 
++ (defvar perldb-error-message "No more fatal Perl errors"
++   "Message to print when no more matches for compilation-error-regexp are found")
++ 
++ (defun perldb-next-error (&optional argp)
++   "Visit next perldb error message and corresponding source code.
++ This operates on the output from the \\[perldb] command.
++ If all preparsed error messages have been processed,
++ the error message buffer is checked for new ones.
++ A non-nil argument (prefix arg, if interactive)
++ means reparse the error message buffer and start at the first error."
++   (interactive "P")
++   (if (or (eq perldb-error-list t)
++ 	  argp)
++       (progn (perldb-forget-errors)
++ 	     (setq perldb-parsing-end 2))) ;; 2 to defeat grep defeater
++   (if perldb-error-list
++       nil
++     (save-excursion
++       (switch-to-buffer current-perldb-buffer)
++       (perldb-parse-errors)))
++   (let ((next-error (car perldb-error-list)))
++     (if (null next-error)
++ 	(error (concat perldb-error-message
++ 		       (if (and (get-buffer-process current-perldb-buffer)
++ 				(eq (process-status
++                                      (get-buffer-process
++                                       current-perldb-buffer))
++ 				    'run))
++ 			   " yet" ""))))
++     (setq perldb-error-list (cdr perldb-error-list))
++     (if (null (car (cdr next-error)))
++ 	nil
++       (switch-to-buffer (marker-buffer (car (cdr next-error))))
++       (goto-char (car (cdr next-error)))
++       (set-marker (car (cdr next-error)) nil))
++     (let* ((pop-up-windows t)
++ 	   (w (display-buffer (marker-buffer (car next-error)))))
++       (set-window-point w (car next-error))
++       (set-window-start w (car next-error)))
++     (set-marker (car next-error) nil)))
++ 
++ ;; Set perldb-error-list to nil, and
++ ;; unchain the markers that point to the error messages and their text,
++ ;; so that they no longer slow down gap motion.
++ ;; This would happen anyway at the next garbage collection,
++ ;; but it is better to do it right away.
++ (defun perldb-forget-errors ()
++   (if (eq perldb-error-list t)
++       (setq perldb-error-list nil))
++   (while perldb-error-list
++     (let ((next-error (car perldb-error-list)))
++       (set-marker (car next-error) nil)
++       (if (car (cdr next-error))
++ 	  (set-marker (car (cdr next-error)) nil)))
++     (setq perldb-error-list (cdr perldb-error-list))))
++ 
++ (defun perldb-parse-errors ()
++   "Parse the current buffer as error messages.
++ This makes a list of error descriptors, perldb-error-list.
++ For each source-file, line-number pair in the buffer,
++ the source file is read in, and the text location is saved in perldb-error-list.
++ The function next-error, assigned to \\[next-error], takes the next error off the list
++ and visits its location."
++   (setq perldb-error-list nil)
++   (message "Parsing error messages...")
++   (let (text-buffer
++ 	last-filename last-linenum)
++     ;; Don't reparse messages already seen at last parse.
++     (goto-char perldb-parsing-end)
++     ;; Don't parse the first two lines as error messages.
++     ;; This matters for grep.
++     (if (bobp)
++ 	(forward-line 2))
++     (while (re-search-forward compilation-error-regexp nil t)
++       (let (linenum filename
++ 	    error-marker text-marker)
++ 	;; Extract file name and line number from error message.
++ 	(save-restriction
++ 	  (narrow-to-region (match-beginning 0) (match-end 0))
++ 	  (goto-char (point-max))
++ 	  (skip-chars-backward "[0-9]")
++ 	  ;; If it's a lint message, use the last file(linenum) on the line.
++ 	  ;; Normally we use the first on the line.
++ 	  (if (= (preceding-char) ?\()
++ 	      (progn
++ 		(narrow-to-region (point-min) (1+ (buffer-size)))
++ 		(end-of-line)
++ 		(re-search-backward compilation-error-regexp)
++ 		(skip-chars-backward "^ \t\n")
++ 		(narrow-to-region (point) (match-end 0))
++ 		(goto-char (point-max))
++ 		(skip-chars-backward "[0-9]")))
++ 	  ;; Are we looking at a "filename-first" or "line-number-first" form?
++ 	  (if (looking-at "[0-9]")
++ 	      (progn
++ 		(setq linenum (read (current-buffer)))
++ 		(goto-char (point-min)))
++ 	    ;; Line number at start, file name at end.
++ 	    (progn
++ 	      (goto-char (point-min))
++ 	      (setq linenum (read (current-buffer)))
++ 	      (goto-char (point-max))
++ 	      (skip-chars-backward "^ \t\n")))
++ 	  (setq filename (perldb-grab-filename)))
++ 	;; Locate the erring file and line.
++ 	(if (and (equal filename last-filename)
++ 		 (= linenum last-linenum))
++ 	    nil
++ 	  (beginning-of-line 1)
++ 	  (setq error-marker (point-marker))
++ 	  ;; text-buffer gets the buffer containing this error's file.
++ 	  (if (not (equal filename last-filename))
++ 	      (setq text-buffer
++ 		    (and (file-exists-p (setq last-filename filename))
++ 			 (find-file-noselect filename))
++ 		    last-linenum 0))
++ 	  (if text-buffer
++ 	      ;; Go to that buffer and find the erring line.
++ 	      (save-excursion
++ 		(set-buffer text-buffer)
++ 		(if (zerop last-linenum)
++ 		    (progn
++ 		      (goto-char 1)
++ 		      (setq last-linenum 1)))
++ 		(forward-line (- linenum last-linenum))
++ 		(setq last-linenum linenum)
++ 		(setq text-marker (point-marker))
++ 		(setq perldb-error-list
++ 		      (cons (list error-marker text-marker)
++ 			    perldb-error-list)))))
++ 	(forward-line 1)))
++     (setq perldb-parsing-end (point-max)))
++   (message "Parsing error messages...done")
++   (setq perldb-error-list (nreverse perldb-error-list)))
++ 
++ (defun perldb-grab-filename ()
++   "Return a string which is a filename, starting at point.
++ Ignore quotes and parentheses around it, as well as trailing colons."
++   (if (eq (following-char) ?\")
++       (save-restriction
++ 	(narrow-to-region (point)
++ 			  (progn (forward-sexp 1) (point)))
++ 	(goto-char (point-min))
++ 	(read (current-buffer)))
++     (buffer-substring (point)
++ 		      (progn
++ 			(skip-chars-forward "^ :,\n\t(")
++ 			(point)))))
++ 
++ (define-key ctl-x-map "~" 'perldb-next-error)
+
+
diff --git a/gnu/usr.bin/perl/h2pl/README b/gnu/usr.bin/perl/h2pl/README
new file mode 100644
index 000000000000..5fe8ae7aa338
--- /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 000000000000..422185eb7b43
--- /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 000000000000..8ac55a349755
--- /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 000000000000..285bff185910
--- /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 000000000000..d9ba3be190f5
--- /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 000000000000..0b552caa00e6
--- /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 000000000000..f4cb777ee917
--- /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 000000000000..403fffaf86ce
--- /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 000000000000..cb4b8ab86ea4
--- /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 000000000000..ffb0f0b0b9e2
--- /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 000000000000..2677cc982bcf
--- /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 000000000000..fcbf92651612
--- /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/lib/Makefile b/gnu/usr.bin/perl/lib/Makefile
new file mode 100644
index 000000000000..375720d449f4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Makefile
@@ -0,0 +1,19 @@
+PLIBDIR= /usr/local/lib/perl
+
+PLIB+= abbrev.pl assert.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl
+PLIB+= chat2.pl complete.pl ctime.pl dumpvar.pl exceptions.pl fastcwd.pl
+PLIB+= find.pl finddepth.pl flush.pl getcwd.pl getopts.pl importenv.pl
+PLIB+= look.pl newgetopt.pl open2.pl perldb.pl pwd.pl shellwords.pl
+PLIB+= stat.pl syslog.pl termcap.pl timelocal.pl validate.pl 
+
+install:
+	mkdir -p ${PLIBDIR}
+	install -c -o ${BINOWN} -g ${BINGRP} -m 444 ${PLIB} ${PLIBDIR}
+
+clean:
+cleandir:
+obj:
+
+.include <bsd.prog.mk>
+
+
diff --git a/gnu/usr.bin/perl/lib/abbrev.pl b/gnu/usr.bin/perl/lib/abbrev.pl
new file mode 100644
index 000000000000..c233d4af7e63
--- /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 000000000000..cfda70cf299a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/assert.pl
@@ -0,0 +1,52 @@
+# 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: $_[0]",$@) unless eval $_[0];
+} 
+
+sub panic {
+    select(STDERR);
+
+    print "\npanic: @_\n";
+
+    exit 1 if $] <= 4.003;  # caller broken
+
+    # stack traceback gratefully borrowed from perl debugger
+
+    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");
+    }
+    for ($i=0; $i <= $#sub; $i++) {
+	print $sub[$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 000000000000..278f11d815da
--- /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($_[0]);
+    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($_[0]);
+    s/^-/+/;		                       # mash sign
+    $_;
+}
+
+# multiplication
+sub main'fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[0]),&'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($_[0]),&'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($_[0],&'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($_[0]),&'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,0,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,0,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    &'badd($q, ((substr($q,0,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($_[0]),$_[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,0,$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($_[0]),$_[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,0,$trunc),
+		      "+0".substr($xm,$trunc,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($_[0]),&'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,0,1).'1')
+             || &bigint'cmp($xm,$ym))
+	);
+    }
+}
+
+# square root by Newtons method.
+sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (&'fnorm($_[0]), $_[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 000000000000..5c79da9898ae
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigint.pl
@@ -0,0 +1,271 @@
+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
+#
+
+# 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,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,0,1),length($d)-2);
+    substr($d,0,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($_[0]),&'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($_[0]),&'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($_[0],&'bneg($_[1]));    
+}
+
+# GCD -- Euclids algorithm Knuth Vol 2 pg 296
+sub main'bgcd { #(num_str, num_str) return num_str
+    local($x,$y) = (&'bnorm($_[0]),&'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($_[0]), &'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, 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($_[0]), &'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[0];
+    $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[$#y-1,$#y];
+    while ($#x > $#y) {
+	($u2,$u1,$u0) = @x[($#x-2)..$#x];
+	$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 = 0, $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 = 0, $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, 0));
+    } 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 000000000000..fb10cf35de1f
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigrat.pl
@@ -0,0 +1,148 @@
+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);
+	if ($gcd ne '+1') { 
+	    $num = &'bdiv($num,$gcd);
+	    $dom = &'bdiv($dom,$gcd);
+	} else {
+	    $num = &'bnorm($num);
+	    $dom = &'bnorm($dom);
+	}
+	substr($dom,0,1) = '';
+	"$num/$dom";
+    }
+}
+
+# negation
+sub main'rneg { #(rat_num) return rat_num
+    local($_) = &'rnorm($_[0]);
+    tr/-+/+-/ if ($_ ne '+0/1');
+    $_;
+}
+
+# absolute value
+sub main'rabs { #(rat_num) return $rat_num
+    local($_) = &'rnorm($_[0]);
+    substr($_,0,1) = '+' unless $_ eq 'NaN';
+    $_;
+}
+
+# multipication
+sub main'rmul { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    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($_[0]));
+    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($_[0]));
+    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($_[0]));
+    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($_[0]));
+    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($_[0]));
+    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($_[0]), $_[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 000000000000..513c25b6fe15
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/cacheout.pl
@@ -0,0 +1,40 @@
+# Open in their package.
+
+sub cacheout'open {
+    open($_[0], $_[1]);
+}
+
+# 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.pl b/gnu/usr.bin/perl/lib/chat2.pl
new file mode 100644
index 000000000000..662872c2d30d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/chat2.pl
@@ -0,0 +1,339 @@
+## 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) = &_getpty(S,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;
+		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);
+		}
+	}
+	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 000000000000..dabf8f66adea
--- /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($[) = 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 000000000000..4c59754b7b81
--- /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: 1.1.1.1 $$Date: 1993/08/23 21:29:52 $
+;#   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 += ($year < 70) ? 2000 : 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/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
new file mode 100644
index 000000000000..542749448527
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -0,0 +1,37 @@
+package dumpvar;
+
+# translate control chars to ^X - Randal Schwartz
+sub unctrl {
+	local($_) = @_;
+	s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+	$_;
+}
+sub main'dumpvar {
+    ($package,@vars) = @_;
+    local(*stab) = eval("*_$package");
+    while (($key,$val) = each(%stab)) {
+	{
+	    next if @vars && !grep($key eq $_,@vars);
+	    local(*entry) = $val;
+	    if (defined $entry) {
+		print "\$$key = '",&unctrl($entry),"'\n";
+	    }
+	    if (defined @entry) {
+		print "\@$key = (\n";
+		foreach $num ($[ .. $#entry) {
+		    print "  $num\t'",&unctrl($entry[$num]),"'\n";
+		}
+		print ")\n";
+	    }
+	    if ($key ne "_$package" && $key ne "_DB" && defined %entry) {
+		print "\%$key = (\n";
+		foreach $key (sort keys(%entry)) {
+		    print "  $key\t'",&unctrl($entry{$key}),"'\n";
+		}
+		print ")\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 000000000000..02c4498d3211
--- /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 000000000000..6b452e8d788c
--- /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 000000000000..8dab0540f327
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/find.pl
@@ -0,0 +1,106 @@
+# 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);
+#	}
+
+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;
+		$topdir =~ s,/$,, ;
+		&finddir($topdir,$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) {        # 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) {    # 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 000000000000..15e4daf561da
--- /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)) {
+		$topdir =~ s,/$,, ;
+		&finddepthdir($topdir,$topnlink);
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&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 000000000000..55002b9919c7
--- /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/getcwd.pl b/gnu/usr.bin/perl/lib/getcwd.pl
new file mode 100644
index 000000000000..a3214ba715df
--- /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 ($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 000000000000..6772d54aae20
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getopt.pl
@@ -0,0 +1,41 @@
+;# $RCSfile: getopt.pl,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:52 $
+
+;# 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 000000000000..a0818d1e3a0a
--- /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/importenv.pl b/gnu/usr.bin/perl/lib/importenv.pl
new file mode 100644
index 000000000000..c9ad330b6d03
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/importenv.pl
@@ -0,0 +1,16 @@
+;# $Header: /home/cvs/386BSD/ports/lang/perl/lib/importenv.pl,v 1.1.1.1 1993/08/23 21:29:53 nate Exp $
+
+;# 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/look.pl b/gnu/usr.bin/perl/lib/look.pl
new file mode 100644
index 000000000000..4c14e64727a5
--- /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 000000000000..0e4cbfd49ab9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/newgetopt.pl
@@ -0,0 +1,271 @@
+# newgetopt.pl -- new options parsing
+
+# SCCS Status     : @(#)@ newgetopt.pl	1.13
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Tue Jun  2 11:24:03 1992
+# Update Count    : 75
+# Status          : Okay
+
+# This package implements a new getopt function. This function adheres
+# to the new syntax (long option names, no bundling).
+#
+# Arguments to the function are:
+#
+#  - a list of possible options. These should designate valid perl
+#    identifiers, optionally followed by an argument specifier ("="
+#    for mandatory arguments or ":" for optional arguments) and an
+#    argument type specifier: "n" or "i" for integer numbers, "f" for
+#    real (fix) numbers or "s" for strings.
+#    If an "@" sign is appended, the option is treated as an array.
+#    Value(s) are not set, but pushed.
+#
+#  - if the first option of the list consists of non-alphanumeric
+#    characters only, it is interpreted as a generic option starter.
+#    Everything starting with one of the characters from the starter
+#    will be considered an option.
+#    Likewise, a double occurrence (e.g. "--") signals end of
+#    the options list.
+#    The default value for the starter is "-", "--" or "+".
+#
+# Upon return, the option variables, prefixed with "opt_", are defined
+# and set to the respective option arguments, if any.
+# Options that do not take an argument are set to 1. Note that an
+# option with an optional argument will be defined, but set to '' if
+# no actual argument has been supplied.
+# A return status of 0 (false) indicates that the function detected
+# one or more errors.
+#
+# Special care is taken to give a correct treatment to optional arguments.
+#
+# E.g. if option "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 "foo=s" and "bar:s" :
+#
+#    -bar -xxx		-> $opt_bar = '', '-xxx' is next option
+#    -foo -bar		-> $opt_foo = '-bar'
+#    -foo --		-> $opt_foo = '--'
+#
+# HISTORY 
+# 2-Jun-1992		Johan Vromans	
+#    Do not use //o to allow multiple NGetOpt calls with different delimeters.
+#    Prevent typeless option from using previous $array state.
+#    Prevent empty option from being eaten as a (negative) number.
+
+# 25-May-1992		Johan Vromans	
+#    Add array options. "foo=s@" will return an array @opt_foo that
+#    contains all values that were supplied. E.g. "-foo one -foo -two" will
+#    return @opt_foo = ("one", "-two");
+#    Correct bug in handling options that allow for a argument when followed
+#    by another option.
+
+# 4-May-1992		Johan Vromans	
+#    Add $ignorecase to match options in either case.
+#    Allow '' option.
+
+# 19-Mar-1992		Johan Vromans	
+#    Allow require from packages.
+#    NGetOpt is now defined in the package that requires it.
+#    @ARGV and $opt_... are taken from the package that calls it.
+#    Use standard (?) option prefixes: -, -- and +.
+
+# 20-Sep-1990		Johan Vromans	
+#    Set options w/o argument to 1.
+#    Correct the dreadful semicolon/require bug.
+
+
+{   package newgetopt;
+    $debug = 0;			# for debugging
+    $ignorecase = 1;		# ignore case when matching options
+}
+
+sub NGetOpt {
+
+    @newgetopt'optionlist = @_;
+    *newgetopt'ARGV = *ARGV;
+
+    package newgetopt;
+
+    local ($[) = 0;
+    local ($genprefix) = "(--|-|\\+)";
+    local ($argend) = "--";
+    local ($error) = 0;
+    local ($opt, $optx, $arg, $type, $mand, %opctl);
+    local ($pkg) = (caller)[0];
+
+    print STDERR "NGetOpt 1.13 -- called from $pkg\n" if $debug;
+
+    # 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 . "]";
+	undef $argend;
+    }
+
+    # Verify correctness of optionlist.
+    %opctl = ();
+    foreach $opt ( @optionlist ) {
+	$opt =~ tr/A-Z/a-z/ if $ignorecase;
+	if ( $opt !~ /^(\w*)([=:][infse]@?)?$/ ) {
+	    print STDERR ("Error in option spec: \"", $opt, "\"\n");
+	    $error++;
+	    next;
+	}
+	$opctl{$1} = defined $2 ? $2 : "";
+    }
+
+    return 0 if $error;
+
+    if ( $debug ) {
+	local ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+    }
+
+    # Process argument list
+
+    while ( $#ARGV >= 0 ) {
+
+	# >>> See also the continue block <<<
+
+	# Get next argument
+	$opt = shift (@ARGV);
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+	$arg = undef;
+
+	# Check for exhausted list.
+	if ( $opt =~ /^$genprefix/ ) {
+	    # Double occurrence is terminator
+	    return ($error == 0) 
+		if ($opt eq "$+$+") || ((defined $argend) && $opt eq $argend);
+	    $opt = $';		# option name (w/o prefix)
+	}
+	else {
+	    # Apparently not an option - push back and exit.
+	    unshift (@ARGV, $opt);
+	    return ($error == 0);
+	}
+
+	# Look it up.
+	$opt =~ tr/A-Z/a-z/ if $ignorecase;
+	unless  ( defined ( $type = $opctl{$opt} ) ) {
+	    print STDERR ("Unknown option: ", $opt, "\n");
+	    $error++;
+	    next;
+	}
+
+	# Determine argument status.
+	print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+
+	# If it is an option w/o argument, we're almost finished with it.
+	if ( $type eq "" ) {
+	    $arg = 1;		# supply explicit value
+	    $array = 0;
+	    next;
+	}
+
+	# Get mandatory status and type info.
+	($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
+
+	# Check if the argument list is exhausted.
+	if ( $#ARGV < 0 ) {
+
+	    # Complain if this option needs an argument.
+	    if ( $mand eq "=" ) {
+		print STDERR ("Option ", $opt, " requires an argument\n");
+		$error++;
+	    }
+	    if ( $mand eq ":" ) {
+		$arg = $type eq "s" ? "" : 0;
+	    }
+	    next;
+	}
+
+	# Get (possibly optional) argument.
+	$arg = shift (@ARGV);
+
+	# Check if it is a valid argument. A mandatory string takes
+	# anything. 
+	if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/ ) {
+
+	    # Check for option list terminator.
+	    if ( $arg eq "$+$+" || 
+		 ((defined $argend) && $arg eq $argend)) {
+		# Push back so the outer loop will terminate.
+		unshift (@ARGV, $arg);
+		# Complain if an argument is required.
+		if ($mand eq "=") {
+		    print STDERR ("Option ", $opt, " requires an argument\n");
+		    $error++;
+		    undef $arg;	# don't assign it
+		}
+		else {
+		    # Supply empty value.
+		    $arg = $type eq "s" ? "" : 0;
+		}
+		next;
+	    }
+
+	    # Maybe the optional argument is the next option?
+	    if ( $mand eq ":" && ($' eq "" || $' =~ /[a-zA-Z_]/) ) {
+		# Yep. Push back.
+		unshift (@ARGV, $arg);
+		$arg = $type eq "s" ? "" : 0;
+		next;
+	    }
+	}
+
+	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	    if ( $arg !~ /^-?[0-9]+$/ ) {
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			      $opt, " (number expected)\n");
+		$error++;
+		undef $arg;	# don't assign it
+	    }
+	    next;
+	}
+
+	if ( $type eq "f" ) { # fixed real number, int is also ok
+	    if ( $arg !~ /^-?[0-9.]+$/ ) {
+		print STDERR ("Value \"", $arg, "\" invalid for option ",
+			      $opt, " (real number expected)\n");
+		$error++;
+		undef $arg;	# don't assign it
+	    }
+	    next;
+	}
+
+	if ( $type eq "s" ) { # string
+	    next;
+	}
+
+    }
+    continue {
+	if ( defined $arg ) {
+	    if ( $array ) {
+		print STDERR ('=> push (@', $pkg, '\'opt_', $opt, ", \"$arg\")\n")
+		    if $debug;
+	        eval ('push(@' . $pkg . '\'opt_' . $opt . ", \$arg);");
+	    }
+	    else {
+		print STDERR ('=> $', $pkg, '\'opt_', $opt, " = \"$arg\"\n")
+		    if $debug;
+	        eval ('$' . $pkg . '\'opt_' . $opt . " = \$arg;");
+	    }
+	}
+    }
+
+    return ($error == 0);
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/open2.pl b/gnu/usr.bin/perl/lib/open2.pl
new file mode 100644
index 000000000000..dcd68a8cd3a0
--- /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/perldb.pl b/gnu/usr.bin/perl/lib/perldb.pl
new file mode 100644
index 000000000000..1aadb934e979
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/perldb.pl
@@ -0,0 +1,598 @@
+package DB;
+
+# 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
+
+$header = '$RCSfile: perldb.pl,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:51 $';
+#
+# 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 do DB'DB(<linenum>); in front of every place that can
+# have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
+#
+# $Log: perldb.pl,v $
+# Revision 1.1.1.1  1993/08/23  21:29:51  nate
+# PERL!
+#
+# Revision 4.0.1.3  92/06/08  13:43:57  lwall
+# patch20: support for MSDOS folded into perldb.pl
+# patch20: perldb couldn't debug file containing '-', such as STDIN designator
+# 
+# Revision 4.0.1.2  91/11/05  17:55:58  lwall
+# patch11: perldb.pl modified to run within emacs in perldb-mode
+# 
+# Revision 4.0.1.1  91/06/07  11:17:44  lwall
+# patch4: added $^P variable to control calling of perldb routines
+# patch4: debugger sometimes listed wrong number of lines for a statement
+# 
+# Revision 4.0  91/03/20  01:25:50  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.6  91/01/11  18:08:58  lwall
+# patch42: @_ couldn't be accessed from debugger
+# 
+# Revision 3.0.1.5  90/11/10  01:40:26  lwall
+# patch38: the debugger wouldn't stop correctly or do action routines
+# 
+# Revision 3.0.1.4  90/10/15  17:40:38  lwall
+# patch29: added caller
+# patch29: the debugger now understands packages and evals
+# patch29: scripts now run at almost full speed under the debugger
+# patch29: more variables are settable from debugger
+# 
+# Revision 3.0.1.3  90/08/09  04:00:58  lwall
+# patch19: debugger now allows continuation lines
+# patch19: debugger can now dump lists of variables
+# patch19: debugger can now add aliases easily from prompt
+# 
+# Revision 3.0.1.2  90/03/12  16:39:39  lwall
+# patch13: perl -d didn't format stack traces of *foo right
+# patch13: perl -d wiped out scalar return values of subroutines
+# 
+# Revision 3.0.1.1  89/10/26  23:14:02  lwall
+# patch1: RCS expanded an unintended $Header in lib/perldb.pl
+# 
+# Revision 3.0  89/10/18  15:19:46  lwall
+# 3.0 baseline
+# 
+# Revision 2.0  88/06/05  00:09:45  root
+# Baseline version 2.0.
+# 
+#
+
+if (-e "/dev/tty") {
+    $console = "/dev/tty";
+    $rcfile=".perldb";
+}
+else {
+    $console = "con";
+    $rcfile="perldb.ini";
+}
+
+open(IN, "<$console") || open(IN,  "<&STDIN");	# so we don't dingle stdin
+open(OUT,">$console") || open(OUT, ">&STDOUT");	# so we don't dongle stdout
+select(OUT);
+$| = 1;				# for DB'OUT
+select(STDOUT);
+$| = 1;				# for real STDOUT
+$sub = '';
+
+# Is Perl being run from Emacs?
+$emacs = $main'ARGV[$[] eq '-emacs';
+shift(@main'ARGV) if $emacs;
+
+$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+print OUT "\nLoading DB routines from $header\n";
+print OUT ("Emacs support ",
+	   $emacs ? "enabled" : "available",
+	   ".\n");
+print OUT "\nEnter h for help.\n\n";
+
+sub DB {
+    &save;
+    ($package, $filename, $line) = caller;
+    $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
+	"package $package;";		# this won't let them modify, alas
+    local($^P) = 0;			# don't debug our own evals
+    local(*dbline) = "_<$filename";
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	}
+	else {
+	    $evalarg = "\$DB'signal |= do {$stop;}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    if ($single || $trace || $signal) {
+	if ($emacs) {
+	    print OUT "\032\032$filename:$line:0\n";
+	} else {
+	    print OUT "$package'" unless $sub =~ /'/;
+	    print OUT "$sub($filename:$line):\t",$dbline[$line];
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+		last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+		print OUT "$sub($filename:$i):\t",$dbline[$i];
+	    }
+	}
+    }
+    $evalarg = $action, &eval if $action;
+    if ($single || $signal) {
+	$evalarg = $pre, &eval if $pre;
+	print OUT $#stack . " levels deep in subroutine calls!\n"
+	    if $single & 4;
+	$start = $line;
+      CMD:
+	while ((print OUT "  DB<", $#hist+1, "> "), $cmd=&gets) {
+	    {
+		$single = 0;
+		$signal = 0;
+		$cmd eq '' && exit 0;
+		chop($cmd);
+		$cmd =~ s/\\$// && do {
+		    print OUT "  cont: ";
+		    $cmd .= &gets;
+		    redo CMD;
+		};
+		$cmd =~ /^q$/ && exit 0;
+		$cmd =~ /^$/ && ($cmd = $laststep);
+		push(@hist,$cmd) if length($cmd) > 1;
+		($i) = split(/\s+/,$cmd);
+		eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i};
+		$cmd =~ /^h$/ && do {
+		    print OUT "
+T		Stack trace.
+s		Single step.
+n		Next, steps over subroutine calls.
+r		Return from current subroutine.
+c [line]	Continue; optionally inserts a one-time-only breakpoint 
+		at the specified line.
+<CR>		Repeat last n or s.
+l min+incr	List incr+1 lines starting at min.
+l min-max	List lines.
+l line		List line;
+l		List next window.
+-		List previous window.
+w line		List window around line.
+l subname	List subroutine.
+f filename	Switch to filename.
+/pattern/	Search forwards for pattern; final / is optional.
+?pattern?	Search backwards for pattern.
+L		List breakpoints and actions.
+S		List subroutine names.
+t		Toggle trace mode.
+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 breakpoint.
+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).
+X [vars]	Same as \"V currentpackage [vars]\".
+< command	Define command before prompt.
+> command	Define command after prompt.
+! number	Redo command (default previous command).
+! -number	Redo number\'th to last command.
+H -number	Display last number commands (default all).
+q or ^D		Quit.
+p expr		Same as \"print DB'OUT expr\" in current package.
+= [alias value]	Define a command alias, or list current aliases.
+command		Execute as a perl statement in current package.
+
+";
+		    next CMD; };
+		$cmd =~ /^t$/ && do {
+		    $trace = !$trace;
+		    print OUT "Trace = ".($trace?"on":"off")."\n";
+		    next CMD; };
+		$cmd =~ /^S$/ && do {
+		    foreach $subname (sort(keys %sub)) {
+			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 {
+		    $packname = $1;
+		    @vars = split(' ',$2);
+		    do 'dumpvar.pl' unless defined &main'dumpvar;
+		    if (defined &main'dumpvar) {
+			&main'dumpvar($packname,@vars);
+		    }
+		    else {
+			print DB'OUT "dumpvar.pl not available.\n";
+		    }
+		    next CMD; };
+		$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 anything matching $file.\n";
+			next CMD;
+		    }
+		    elsif ($file ne $filename) {
+			*dbline = "_<$file";
+			$max = $#dbline;
+			$filename = $file;
+			$start = 1;
+			$cmd = "l";
+		    } };
+		$cmd =~ /^l\b\s*(['A-Za-z_]['\w]*)/ && do {
+		    $subname = $1;
+		    $subname = "main'" . $subname unless $subname =~ /'/;
+		    $subname = "main" . $subname if substr($subname,0,1) eq "'";
+		    ($file,$subrange) = split(/:/,$sub{$subname});
+		    if ($file ne $filename) {
+			*dbline = "_<$file";
+			$max = $#dbline;
+			$filename = $file;
+		    }
+		    if ($subrange) {
+			if (eval($subrange) < -$window) {
+			    $subrange =~ s/-.*/+/;
+			}
+			$cmd = "l $subrange";
+		    } else {
+			print OUT "Subroutine $1 not found.\n";
+			next CMD;
+		    } };
+		$cmd =~ /^w\b\s*(\d*)$/ && do {
+		    $incr = $window - 1;
+		    $start = $1 if $1;
+		    $start -= $preview;
+		    $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 = (!$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++) {
+			    print OUT "$i:\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 = "$package'" . $subname unless $subname =~ /'/;
+		    $subname = "main" . $subname if substr($subname,0,1) eq "'";
+		    ($filename,$i) = split(/:/, $sub{$subname});
+		    $i += 0;
+		    if ($i) {
+			*dbline = "_<$filename";
+			++$i while $dbline[$i] == 0 && $i < $#dbline;
+			$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 =~ /^<\s*(.*)/ && do {
+		    $pre = do action($1);
+		    next CMD; };
+		$cmd =~ /^>\s*(.*)/ && do {
+		    $post = do action($1);
+		    next CMD; };
+		$cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
+		    $i = $1;
+		    if ($dbline[$i] == 0) {
+			print OUT "Line $i may not have an action.\n";
+		    } else {
+			$dbline{$i} =~ s/\0[^\0]*//;
+			$dbline{$i} .= "\0" . do action($3);
+		    }
+		    next CMD; };
+		$cmd =~ /^n$/ && do {
+		    $single = 2;
+		    $laststep = $cmd;
+		    last CMD; };
+		$cmd =~ /^s$/ && do {
+		    $single = 1;
+		    $laststep = $cmd;
+		    last CMD; };
+		$cmd =~ /^c\b\s*(\d*)\s*$/ && do {
+		    $i = $1;
+		    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] |= 2;
+		    last CMD; };
+		$cmd =~ /^T$/ && do {
+		    local($p,$f,$l,$s,$h,$a,@a,@sub);
+		    for ($i = 1; ($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(@sub, "$w&$s$a from file $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'."\n$inpat\n";	
+			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'."\n$pat\n".'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'."\n$inpat\n";	
+			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'."\n$pat\n".'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 =~ /^!+\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 =~ /^!(.+)$/ && 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 =~ /^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$1/;
+		$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; };
+	    }
+	    $evalarg = $cmd; &eval;
+	    print OUT "\n";
+	}
+	if ($post) {
+	    $evalarg = $post; &eval;
+	}
+    }
+    ($@, $!, $[, $,, $/, $\) = @saved;
+}
+
+sub save {
+    @saved = ($@, $!, $[, $,, $/, $\);
+    $[ = 0; $, = ""; $/ = "\n"; $\ = "";
+}
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub eval {
+    eval "$usercontext $evalarg; &DB'save";
+    print OUT $@;
+}
+
+sub action {
+    local($action) = @_;
+    while ($action =~ s/\\$//) {
+	print OUT "+ ";
+	$action .= &gets;
+    }
+    $action;
+}
+
+sub gets {
+    local($.);
+    <IN>;
+}
+
+sub catch {
+    $signal = 1;
+}
+
+sub sub {
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    if (wantarray) {
+	@i = &$sub;
+	$single |= pop(@stack);
+	@i;
+    }
+    else {
+	$i = &$sub;
+	$single |= pop(@stack);
+	$i;
+    }
+}
+
+$single = 1;			# so it stops on first executable statement
+@hist = ('?');
+$SIG{'INT'} = "DB'catch";
+$deep = 100;		# warning if stack gets this deep
+$window = 10;
+$preview = 3;
+
+@stack = (0);
+@ARGS = @ARGV;
+for (@args) {
+    s/'/\\'/g;
+    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+}
+
+if (-f $rcfile) {
+    do "./$rcfile";
+}
+elsif (-f "$ENV{'LOGDIR'}/$rcfile") {
+    do "$ENV{'LOGDIR'}/$rcfile";
+}
+elsif (-f "$ENV{'HOME'}/$rcfile") {
+    do "$ENV{'HOME'}/$rcfile";
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/pwd.pl b/gnu/usr.bin/perl/lib/pwd.pl
new file mode 100644
index 000000000000..16baadcdcdd4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/pwd.pl
@@ -0,0 +1,72 @@
+;# pwd.pl - keeps track of current working directory in PWD environment var
+;#
+;# $RCSfile: pwd.pl,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:52 $
+;#
+;# $Log: pwd.pl,v $
+# Revision 1.1.1.1  1993/08/23  21:29:52  nate
+# PERL!
+#
+;# Revision 4.0.1.1  92/06/08  13:45:22  lwall
+;# patch20: support added to pwd.pl to strip automounter crud
+;# 
+;# Revision 4.0  91/03/20  01:26:03  lwall
+;# 4.0 baseline.
+;# 
+;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
+;# patch42: some .pl files were missing their trailing 1;
+;# 
+;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
+;# patch19: Initial revision
+;# 
+;#
+;# 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;
+    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 000000000000..5d593daa50a2
--- /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/stat.pl b/gnu/usr.bin/perl/lib/stat.pl
new file mode 100644
index 000000000000..6186f5428d18
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/stat.pl
@@ -0,0 +1,31 @@
+;# $Header: /home/cvs/386BSD/ports/lang/perl/lib/stat.pl,v 1.1.1.1 1993/08/23 21:29:53 nate Exp $
+
+;# 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/syslog.pl b/gnu/usr.bin/perl/lib/syslog.pl
new file mode 100644
index 000000000000..94a4f6a19a00
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/syslog.pl
@@ -0,0 +1,224 @@
+#
+# syslog.pl
+#
+# $Log: syslog.pl,v $
+# Revision 1.1.1.1  1993/08/23  21:29:51  nate
+# PERL!
+#
+# Revision 4.0.1.1  92/06/08  13:48:05  lwall
+# patch20: new warning for ambiguous use of unary operators
+# 
+# Revision 4.0  91/03/20  01:26:24  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.4  90/11/10  01:41:11  lwall
+# patch38: syslog.pl was referencing an absolute path
+# 
+# Revision 3.0.1.3  90/10/15  17:42:18  lwall
+# patch29: various portability fixes
+# 
+# Revision 3.0.1.1  90/08/09  03:57:17  lwall
+# patch19: Initial revision
+# 
+# Revision 1.2  90/06/11  18:45:30  18:45:30  root ()
+# - Changed 'warn' to 'mail|warning' in test call (to give example of
+#   facility specification, and because 'warn' didn't work on HP-UX).
+# - Fixed typo in &openlog ("ncons" should be "cons").
+# - Added (package-global) $maskpri, and &setlogmask.
+# - In &syslog:
+#   - put argument test ahead of &connect (why waste cycles?),
+#   - allowed facility to be specified in &syslog's first arg (temporarily
+#     overrides any $facility set in &openlog), just as in syslog(3C),
+#   - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)),
+#   - changed $whoami code to use getlogin, getpwuid($<) and 'syslog'
+#     (in that order) when $ident is null,
+#   - made PID logging consistent with syslog(3C) and subject to $lo_pid only,
+#   - fixed typo in "print CONS" statement ($<facility should be <$facility).
+#   - changed \n to \r in print CONS (\r is useful, $message already has a \n).
+# - Changed &xlate to return -1 for an unknown name, instead of croaking.
+# 
+#
+# 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
+
+require 'syslog.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 = 1;
+    $af_inet = 2;
+
+    $stream = 1;
+    $datagram = 2;
+
+    ($name,$aliases,$proto) = getprotobyname('udp');
+    $udp = $proto;
+
+    ($name,$aliase,$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/termcap.pl b/gnu/usr.bin/perl/lib/termcap.pl
new file mode 100644
index 000000000000..81556dbd3fb4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/termcap.pl
@@ -0,0 +1,165 @@
+;# $RCSfile: termcap.pl,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:52 $
+;#
+;# 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;
+    $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 000000000000..b7367fae9dbd
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/timelocal.pl
@@ -0,0 +1,82 @@
+;# 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.
+
+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;
+}
+
+sub timegm {
+    package timelocal;
+
+    local($[) = 0;
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    package timelocal;
+
+    local($[) = 0;
+    $time = &main'timegm + $tzmin*$MIN;
+    @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 ctime.pl\n" if $month > 11;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (363 * $DAYS);
+	@g = gmtime($guess);
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (27 * $DAYS);
+	@g = gmtime($guess);
+    }
+    $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/validate.pl b/gnu/usr.bin/perl/lib/validate.pl
new file mode 100644
index 000000000000..4b901b6c314e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/validate.pl
@@ -0,0 +1,104 @@
+;# $Header: /home/cvs/386BSD/ports/lang/perl/lib/validate.pl,v 1.1.1.1 1993/08/23 21:29:51 nate Exp $
+
+;# 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/misc/c2ph b/gnu/usr.bin/perl/misc/c2ph
new file mode 100644
index 000000000000..0e06c9c81a7f
--- /dev/null
+++ b/gnu/usr.bin/perl/misc/c2ph
@@ -0,0 +1,1071 @@
+#!/usr/gnu/bin/perl
+#
+#
+#   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.
+#
+
+$RCSID = '$RCSfile: c2ph,v $$Revision: 1.2 $$Date: 1994/03/05 01:28:15 $';
+
+
+######################################################################
+
+# 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+//; 
+	&stab; 
+    }
+    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};
+	    $build_recursed = 0;
+	    &build_template($name) unless defined $template{&psou($name)} ||
+					$opt_s && !$interested{$name};
+	} 
+	print STDERR "\n\n" if $trace;
+    }
+
+    print STDERR "dumping structs: " if $trace;
+
+
+    foreach $name (sort keys %struct) {
+	next if $opt_s && !$interested{$name};
+	print STDERR "$name " if $trace;
+
+	undef @sizeof;
+	undef @typedef;
+	undef @offsetof;
+	undef @indices;
+	undef @typeof;
+
+	$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 "\$${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";
+
+	    $template_printed{$fname}++;
+	    $size_printed{$fname}++;
+	} 
+	print "\n";
+    }
+
+    print STDERR "\n" if $trace;
+
+    unless ($perl && $opt_a) { 
+	print "\n1;\n";
+	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";
+	
+    exit;
+}
+
+########################################################################################
+
+
+sub stab {
+    next unless /:[\$\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;
+
+
+    $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 by 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) x 
+			    ($count ? &scripts2count($count) : 1);
+
+	    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 && $nesting == 1) {
+		$template = &scrunch(&fetch_template($type) x 
+				($count ? &scripts2count($count) : 1));
+		push(@sizeof, int($length/8) .",\t# $fieldname");
+		push(@offsetof, int($offset/8) .",\t# $fieldname");
+		push(@typedef, "'$template', \t# $fieldname");
+		$type =~ s/(struct|union) //;
+		push(@typeof, "'$type" . ($count ? $count : '') .
+		    "',\t# $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+)=)?ar(\d+);//) {
+	($arraytype, $unknown) = ($2, $3); 
+	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); 
+	local($whatis) = $1;
+	if ($whatis =~ /^(\d+)=/) {
+	    $typeno = $1;
+	    &pdecl($whatis);
+	} else {
+	    $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+=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+|\(\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($_) = @_;
+
+    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 eq 'void';
+	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;
+}
diff --git a/gnu/usr.bin/perl/misc/c2ph.1 b/gnu/usr.bin/perl/misc/c2ph.1
new file mode 100644
index 000000000000..0c3eaee7eb3c
--- /dev/null
+++ b/gnu/usr.bin/perl/misc/c2ph.1
@@ -0,0 +1,191 @@
+Article 484 of comp.lang.perl:
+Xref: netlabs comp.lang.perl:484 comp.lang.c:983 alt.sources:134
+Path: netlabs!psinntp!iggy.GW.Vitalink.COM!lll-winken!sun-barr!cronkite.Central.Sun.COM!spdev!texsun!convex!tchrist
+From: tchrist@convex.com (Tom Christiansen)
+Newsgroups: comp.lang.perl,comp.lang.c,alt.sources
+Subject: pstruct -- a C structure formatter; AKA c2ph, a C to perl header translator
+Keywords: C perl tranlator
+Message-ID: <1991Jul25.081021.8104@convex.com>
+Date: 25 Jul 91 08:10:21 GMT
+Sender: usenet@convex.com (news access account)
+Followup-To: comp.lang.perl
+Organization: CONVEX Computer Corporation, Richardson, Tx., USA
+Lines: 1208
+Nntp-Posting-Host: pixel.convex.com
+
+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 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
+
+
diff --git a/gnu/usr.bin/perl/misc/pstruct b/gnu/usr.bin/perl/misc/pstruct
new file mode 100644
index 000000000000..1009d29c5a75
--- /dev/null
+++ b/gnu/usr.bin/perl/misc/pstruct
@@ -0,0 +1,1071 @@
+#!/usr/gnu/bin/perl
+#
+#
+#   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.
+#
+
+$RCSID = '$RCSfile: pstruct,v $$Revision: 1.2 $$Date: 1994/03/05 01:28:22 $';
+
+
+######################################################################
+
+# 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+//; 
+	&stab; 
+    }
+    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};
+	    $build_recursed = 0;
+	    &build_template($name) unless defined $template{&psou($name)} ||
+					$opt_s && !$interested{$name};
+	} 
+	print STDERR "\n\n" if $trace;
+    }
+
+    print STDERR "dumping structs: " if $trace;
+
+
+    foreach $name (sort keys %struct) {
+	next if $opt_s && !$interested{$name};
+	print STDERR "$name " if $trace;
+
+	undef @sizeof;
+	undef @typedef;
+	undef @offsetof;
+	undef @indices;
+	undef @typeof;
+
+	$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 "\$${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";
+
+	    $template_printed{$fname}++;
+	    $size_printed{$fname}++;
+	} 
+	print "\n";
+    }
+
+    print STDERR "\n" if $trace;
+
+    unless ($perl && $opt_a) { 
+	print "\n1;\n";
+	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";
+	
+    exit;
+}
+
+########################################################################################
+
+
+sub stab {
+    next unless /:[\$\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;
+
+
+    $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 by 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) x 
+			    ($count ? &scripts2count($count) : 1);
+
+	    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 && $nesting == 1) {
+		$template = &scrunch(&fetch_template($type) x 
+				($count ? &scripts2count($count) : 1));
+		push(@sizeof, int($length/8) .",\t# $fieldname");
+		push(@offsetof, int($offset/8) .",\t# $fieldname");
+		push(@typedef, "'$template', \t# $fieldname");
+		$type =~ s/(struct|union) //;
+		push(@typeof, "'$type" . ($count ? $count : '') .
+		    "',\t# $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+)=)?ar(\d+);//) {
+	($arraytype, $unknown) = ($2, $3); 
+	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); 
+	local($whatis) = $1;
+	if ($whatis =~ /^(\d+)=/) {
+	    $typeno = $1;
+	    &pdecl($whatis);
+	} else {
+	    $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+=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+|\(\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($_) = @_;
+
+    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 eq 'void';
+	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;
+}
diff --git a/gnu/usr.bin/perl/perl/EXTERN.h b/gnu/usr.bin/perl/perl/EXTERN.h
new file mode 100644
index 000000000000..181d50dd739e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/EXTERN.h
@@ -0,0 +1,26 @@
+/* $RCSfile: EXTERN.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:33 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:33  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  10:10:32  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  00:58:26  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#undef EXT
+#define EXT extern
+
+#undef INIT
+#define INIT(x)
+
+#undef DOINIT
diff --git a/gnu/usr.bin/perl/perl/INTERN.h b/gnu/usr.bin/perl/perl/INTERN.h
new file mode 100644
index 000000000000..21c90265a04b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/INTERN.h
@@ -0,0 +1,26 @@
+/* $RCSfile: INTERN.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:33 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:33  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  10:10:42  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  00:58:35  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#undef EXT
+#define EXT
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT
diff --git a/gnu/usr.bin/perl/perl/Makefile b/gnu/usr.bin/perl/perl/Makefile
new file mode 100644
index 000000000000..244832494a8d
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/Makefile
@@ -0,0 +1,20 @@
+#
+# 
+
+PROG= perl
+
+SRCS+= array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c
+SRCS+= eval.c form.c hash.c malloc.c perl.c perly.c regcomp.c regexec.c
+SRCS+= stab.c str.c toke.c util.c usersub.c
+CFLAGS+= -I${.CURDIR} 
+LDADD= -lm 
+DPADD= ${LIBM} 
+
+.if exists (/usr/lib/libcrypt.a) 
+DPADD+= ${LIBCRYPT}
+LDADD+= -lcrypt
+.else
+SRCS+= crypt.c
+.endif
+
+.include <bsd.prog.mk>
diff --git a/gnu/usr.bin/perl/perl/arg.h b/gnu/usr.bin/perl/perl/arg.h
new file mode 100644
index 000000000000..0538e0891ff6
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/arg.h
@@ -0,0 +1,994 @@
+/* $RCSfile: arg.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:34 $
+ *
+ *    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: arg.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:34  nate
+ * PERL!
+ *
+ * Revision 4.0.1.3  92/06/08  11:44:06  lwall
+ * patch20: O_PIPE conflicted with Atari
+ * patch20: clarified debugging output for literals and double-quoted strings
+ * 
+ * Revision 4.0.1.2  91/11/05  15:51:05  lwall
+ * patch11: added eval {}
+ * patch11: added sort {} LIST
+ * 
+ * Revision 4.0.1.1  91/06/07  10:18:30  lwall
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: new copyright notice
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0  91/03/20  01:03:09  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define O_NULL 0
+#define O_RCAT 1
+#define O_ITEM 2
+#define O_SCALAR 3
+#define O_ITEM2 4
+#define O_ITEM3 5
+#define O_CONCAT 6
+#define O_REPEAT 7
+#define O_MATCH 8
+#define O_NMATCH 9
+#define O_SUBST 10
+#define O_NSUBST 11
+#define O_ASSIGN 12
+#define O_LOCAL 13
+#define O_AASSIGN 14
+#define O_SASSIGN 15
+#define O_CHOP 16
+#define O_DEFINED 17
+#define O_UNDEF 18
+#define O_STUDY 19
+#define O_POW 20
+#define O_MULTIPLY 21
+#define O_DIVIDE 22
+#define O_MODULO 23
+#define O_ADD 24
+#define O_SUBTRACT 25
+#define O_LEFT_SHIFT 26
+#define O_RIGHT_SHIFT 27
+#define O_LT 28
+#define O_GT 29
+#define O_LE 30
+#define O_GE 31
+#define O_EQ 32
+#define O_NE 33
+#define O_NCMP 34
+#define O_BIT_AND 35
+#define O_XOR 36
+#define O_BIT_OR 37
+#define O_AND 38
+#define O_OR 39
+#define O_COND_EXPR 40
+#define O_COMMA 41
+#define O_NEGATE 42
+#define O_NOT 43
+#define O_COMPLEMENT 44
+#define O_SELECT 45
+#define O_WRITE 46
+#define O_DBMOPEN 47
+#define O_DBMCLOSE 48
+#define O_OPEN 49
+#define O_TRANS 50
+#define O_NTRANS 51
+#define O_CLOSE 52
+#define O_EACH 53
+#define O_VALUES 54
+#define O_KEYS 55
+#define O_LARRAY 56
+#define O_ARRAY 57
+#define O_AELEM 58
+#define O_DELETE 59
+#define O_LHASH 60
+#define O_HASH 61
+#define O_HELEM 62
+#define O_LAELEM 63
+#define O_LHELEM 64
+#define O_LSLICE 65
+#define O_ASLICE 66
+#define O_HSLICE 67
+#define O_LASLICE 68
+#define O_LHSLICE 69
+#define O_SPLICE 70
+#define O_PUSH 71
+#define O_POP 72
+#define O_SHIFT 73
+#define O_UNPACK 74
+#define O_SPLIT 75
+#define O_LENGTH 76
+#define O_SPRINTF 77
+#define O_SUBSTR 78
+#define O_PACK 79
+#define O_GREP 80
+#define O_JOIN 81
+#define O_SLT 82
+#define O_SGT 83
+#define O_SLE 84
+#define O_SGE 85
+#define O_SEQ 86
+#define O_SNE 87
+#define O_SCMP 88
+#define O_SUBR 89
+#define O_DBSUBR 90
+#define O_CALLER 91
+#define O_SORT 92
+#define O_REVERSE 93
+#define O_WARN 94
+#define O_DIE 95
+#define O_PRTF 96
+#define O_PRINT 97
+#define O_CHDIR 98
+#define O_EXIT 99
+#define O_RESET 100
+#define O_LIST 101
+#define O_EOF 102
+#define O_GETC 103
+#define O_TELL 104
+#define O_RECV 105
+#define O_READ 106
+#define O_SYSREAD 107
+#define O_SYSWRITE 108
+#define O_SEND 109
+#define O_SEEK 110
+#define O_RETURN 111
+#define O_REDO 112
+#define O_NEXT 113
+#define O_LAST 114
+#define O_DUMP 115
+#define O_GOTO 116
+#define O_INDEX 117
+#define O_RINDEX 118
+#define O_TIME 119
+#define O_TMS 120
+#define O_LOCALTIME 121
+#define O_GMTIME 122
+#define O_TRUNCATE 123
+#define O_LSTAT 124
+#define O_STAT 125
+#define O_CRYPT 126
+#define O_ATAN2 127
+#define O_SIN 128
+#define O_COS 129
+#define O_RAND 130
+#define O_SRAND 131
+#define O_EXP 132
+#define O_LOG 133
+#define O_SQRT 134
+#define O_INT 135
+#define O_ORD 136
+#define O_ALARM 137
+#define O_SLEEP 138
+#define O_RANGE 139
+#define O_F_OR_R 140
+#define O_FLIP 141
+#define O_FLOP 142
+#define O_FORK 143
+#define O_WAIT 144
+#define O_WAITPID 145
+#define O_SYSTEM 146
+#define O_EXEC_OP 147
+#define O_HEX 148
+#define O_OCT 149
+#define O_CHOWN 150
+#define O_KILL 151
+#define O_UNLINK 152
+#define O_CHMOD 153
+#define O_UTIME 154
+#define O_UMASK 155
+#define O_MSGGET 156
+#define O_SHMGET 157
+#define O_SEMGET 158
+#define O_MSGCTL 159
+#define O_SHMCTL 160
+#define O_SEMCTL 161
+#define O_MSGSND 162
+#define O_MSGRCV 163
+#define O_SEMOP 164
+#define O_SHMREAD 165
+#define O_SHMWRITE 166
+#define O_RENAME 167
+#define O_LINK 168
+#define O_MKDIR 169
+#define O_RMDIR 170
+#define O_GETPPID 171
+#define O_GETPGRP 172
+#define O_SETPGRP 173
+#define O_GETPRIORITY 174
+#define O_SETPRIORITY 175
+#define O_CHROOT 176
+#define O_FCNTL 177
+#define O_IOCTL 178
+#define O_FLOCK 179
+#define O_UNSHIFT 180
+#define O_REQUIRE 181
+#define O_DOFILE 182
+#define O_EVAL 183
+#define O_FTRREAD 184
+#define O_FTRWRITE 185
+#define O_FTREXEC 186
+#define O_FTEREAD 187
+#define O_FTEWRITE 188
+#define O_FTEEXEC 189
+#define O_FTIS 190
+#define O_FTEOWNED 191
+#define O_FTROWNED 192
+#define O_FTZERO 193
+#define O_FTSIZE 194
+#define O_FTMTIME 195
+#define O_FTATIME 196
+#define O_FTCTIME 197
+#define O_FTSOCK 198
+#define O_FTCHR 199
+#define O_FTBLK 200
+#define O_FTFILE 201
+#define O_FTDIR 202
+#define O_FTPIPE 203
+#define O_FTLINK 204
+#define O_SYMLINK 205
+#define O_READLINK 206
+#define O_FTSUID 207
+#define O_FTSGID 208
+#define O_FTSVTX 209
+#define O_FTTTY 210
+#define O_FTTEXT 211
+#define O_FTBINARY 212
+#define O_SOCKET 213
+#define O_BIND 214
+#define O_CONNECT 215
+#define O_LISTEN 216
+#define O_ACCEPT 217
+#define O_GHBYNAME 218
+#define O_GHBYADDR 219
+#define O_GHOSTENT 220
+#define O_GNBYNAME 221
+#define O_GNBYADDR 222
+#define O_GNETENT 223
+#define O_GPBYNAME 224
+#define O_GPBYNUMBER 225
+#define O_GPROTOENT 226
+#define O_GSBYNAME 227
+#define O_GSBYPORT 228
+#define O_GSERVENT 229
+#define O_SHOSTENT 230
+#define O_SNETENT 231
+#define O_SPROTOENT 232
+#define O_SSERVENT 233
+#define O_EHOSTENT 234
+#define O_ENETENT 235
+#define O_EPROTOENT 236
+#define O_ESERVENT 237
+#define O_SOCKPAIR 238
+#define O_SHUTDOWN 239
+#define O_GSOCKOPT 240
+#define O_SSOCKOPT 241
+#define O_GETSOCKNAME 242
+#define O_GETPEERNAME 243
+#define O_SSELECT 244
+#define O_FILENO 245
+#define O_BINMODE 246
+#define O_VEC 247
+#define O_GPWNAM 248
+#define O_GPWUID 249
+#define O_GPWENT 250
+#define O_SPWENT 251
+#define O_EPWENT 252
+#define O_GGRNAM 253
+#define O_GGRGID 254
+#define O_GGRENT 255
+#define O_SGRENT 256
+#define O_EGRENT 257
+#define O_GETLOGIN 258
+#define O_OPEN_DIR 259
+#define O_READDIR 260
+#define O_TELLDIR 261
+#define O_SEEKDIR 262
+#define O_REWINDDIR 263
+#define O_CLOSEDIR 264
+#define O_SYSCALL 265
+#define O_PIPE_OP 266
+#define O_TRY 267
+#define O_EVALONCE 268
+#define MAXO 269
+
+#ifndef DOINIT
+extern char *opname[];
+#else
+char *opname[] = {
+    "NULL",
+    "RCAT",
+    "ITEM",
+    "SCALAR",
+    "ITEM2",
+    "ITEM3",
+    "CONCAT",
+    "REPEAT",
+    "MATCH",
+    "NMATCH",
+    "SUBST",
+    "NSUBST",
+    "ASSIGN",
+    "LOCAL",
+    "AASSIGN",
+    "SASSIGN",
+    "CHOP",
+    "DEFINED",
+    "UNDEF",
+    "STUDY",
+    "POW",
+    "MULTIPLY",
+    "DIVIDE",
+    "MODULO",
+    "ADD",
+    "SUBTRACT",
+    "LEFT_SHIFT",
+    "RIGHT_SHIFT",
+    "LT",
+    "GT",
+    "LE",
+    "GE",
+    "EQ",
+    "NE",
+    "NCMP",
+    "BIT_AND",
+    "XOR",
+    "BIT_OR",
+    "AND",
+    "OR",
+    "COND_EXPR",
+    "COMMA",
+    "NEGATE",
+    "NOT",
+    "COMPLEMENT",
+    "SELECT",
+    "WRITE",
+    "DBMOPEN",
+    "DBMCLOSE",
+    "OPEN",
+    "TRANS",
+    "NTRANS",
+    "CLOSE",
+    "EACH",
+    "VALUES",
+    "KEYS",
+    "LARRAY",
+    "ARRAY",
+    "AELEM",
+    "DELETE",
+    "LHASH",
+    "HASH",
+    "HELEM",
+    "LAELEM",
+    "LHELEM",
+    "LSLICE",
+    "ASLICE",
+    "HSLICE",
+    "LASLICE",
+    "LHSLICE",
+    "SPLICE",
+    "PUSH",
+    "POP",
+    "SHIFT",
+    "UNPACK",
+    "SPLIT",
+    "LENGTH",
+    "SPRINTF",
+    "SUBSTR",
+    "PACK",
+    "GREP",
+    "JOIN",
+    "SLT",
+    "SGT",
+    "SLE",
+    "SGE",
+    "SEQ",
+    "SNE",
+    "SCMP",
+    "SUBR",
+    "DBSUBR",
+    "CALLER",
+    "SORT",
+    "REVERSE",
+    "WARN",
+    "DIE",
+    "PRINTF",
+    "PRINT",
+    "CHDIR",
+    "EXIT",
+    "RESET",
+    "LIST",
+    "EOF",
+    "GETC",
+    "TELL",
+    "RECV",
+    "READ",
+    "SYSREAD",
+    "SYSWRITE",
+    "SEND",
+    "SEEK",
+    "RETURN",
+    "REDO",
+    "NEXT",
+    "LAST",
+    "DUMP",
+    "GOTO",/* shudder */
+    "INDEX",
+    "RINDEX",
+    "TIME",
+    "TIMES",
+    "LOCALTIME",
+    "GMTIME",
+    "TRUNCATE",
+    "LSTAT",
+    "STAT",
+    "CRYPT",
+    "ATAN2",
+    "SIN",
+    "COS",
+    "RAND",
+    "SRAND",
+    "EXP",
+    "LOG",
+    "SQRT",
+    "INT",
+    "ORD",
+    "ALARM",
+    "SLEEP",
+    "RANGE",
+    "FLIP_OR_RANGE",
+    "FLIP",
+    "FLOP",
+    "FORK",
+    "WAIT",
+    "WAITPID",
+    "SYSTEM",
+    "EXEC",
+    "HEX",
+    "OCT",
+    "CHOWN",
+    "KILL",
+    "UNLINK",
+    "CHMOD",
+    "UTIME",
+    "UMASK",
+    "MSGGET",
+    "SHMGET",
+    "SEMGET",
+    "MSGCTL",
+    "SHMCTL",
+    "SEMCTL",
+    "MSGSND",
+    "MSGRCV",
+    "SEMOP",
+    "SHMREAD",
+    "SHMWRITE",
+    "RENAME",
+    "LINK",
+    "MKDIR",
+    "RMDIR",
+    "GETPPID",
+    "GETPGRP",
+    "SETPGRP",
+    "GETPRIORITY",
+    "SETPRIORITY",
+    "CHROOT",
+    "FCNTL",
+    "SYSIOCTL",
+    "FLOCK",
+    "UNSHIFT",
+    "REQUIRE",
+    "DOFILE",
+    "EVAL",
+    "FTRREAD",
+    "FTRWRITE",
+    "FTREXEC",
+    "FTEREAD",
+    "FTEWRITE",
+    "FTEEXEC",
+    "FTIS",
+    "FTEOWNED",
+    "FTROWNED",
+    "FTZERO",
+    "FTSIZE",
+    "FTMTIME",
+    "FTATIME",
+    "FTCTIME",
+    "FTSOCK",
+    "FTCHR",
+    "FTBLK",
+    "FTFILE",
+    "FTDIR",
+    "FTPIPE",
+    "FTLINK",
+    "SYMLINK",
+    "READLINK",
+    "FTSUID",
+    "FTSGID",
+    "FTSVTX",
+    "FTTTY",
+    "FTTEXT",
+    "FTBINARY",
+    "SOCKET",
+    "BIND",
+    "CONNECT",
+    "LISTEN",
+    "ACCEPT",
+    "GHBYNAME",
+    "GHBYADDR",
+    "GHOSTENT",
+    "GNBYNAME",
+    "GNBYADDR",
+    "GNETENT",
+    "GPBYNAME",
+    "GPBYNUMBER",
+    "GPROTOENT",
+    "GSBYNAME",
+    "GSBYPORT",
+    "GSERVENT",
+    "SHOSTENT",
+    "SNETENT",
+    "SPROTOENT",
+    "SSERVENT",
+    "EHOSTENT",
+    "ENETENT",
+    "EPROTOENT",
+    "ESERVENT",
+    "SOCKPAIR",
+    "SHUTDOWN",
+    "GSOCKOPT",
+    "SSOCKOPT",
+    "GETSOCKNAME",
+    "GETPEERNAME",
+    "SSELECT",
+    "FILENO",
+    "BINMODE",
+    "VEC",
+    "GPWNAM",
+    "GPWUID",
+    "GPWENT",
+    "SPWENT",
+    "EPWENT",
+    "GGRNAM",
+    "GGRGID",
+    "GGRENT",
+    "SGRENT",
+    "EGRENT",
+    "GETLOGIN",
+    "OPENDIR",
+    "READDIR",
+    "TELLDIR",
+    "SEEKDIR",
+    "REWINDDIR",
+    "CLOSEDIR",
+    "SYSCALL",
+    "PIPE",
+    "TRY",
+    "EVALONCE",
+    "269"
+};
+#endif
+
+#define A_NULL 0
+#define A_EXPR 1
+#define A_CMD 2
+#define A_STAB 3
+#define A_LVAL 4
+#define A_SINGLE 5
+#define A_DOUBLE 6
+#define A_BACKTICK 7
+#define A_READ 8
+#define A_SPAT 9
+#define A_LEXPR 10
+#define A_ARYLEN 11
+#define A_ARYSTAB 12
+#define A_LARYLEN 13
+#define A_GLOB 14
+#define A_WORD 15
+#define A_INDREAD 16
+#define A_LARYSTAB 17
+#define A_STAR 18
+#define A_LSTAR 19
+#define A_WANTARRAY 20
+#define A_LENSTAB 21
+
+#define A_MASK 31
+#define A_DONT 32		/* or this into type to suppress evaluation */
+
+#ifndef DOINIT
+extern char *argname[];
+#else
+char *argname[] = {
+    "A_NULL",
+    "EXPR",
+    "CMD",
+    "STAB",
+    "LVAL",
+    "LITERAL",
+    "DOUBLEQUOTE",
+    "BACKTICK",
+    "READ",
+    "SPAT",
+    "LEXPR",
+    "ARYLEN",
+    "ARYSTAB",
+    "LARYLEN",
+    "GLOB",
+    "WORD",
+    "INDREAD",
+    "LARYSTAB",
+    "STAR",
+    "LSTAR",
+    "WANTARRAY",
+    "LENSTAB",
+    "22"
+};
+#endif
+
+#ifndef DOINIT
+extern bool hoistable[];
+#else
+bool hoistable[] =
+  {0,	/* A_NULL */
+   0,	/* EXPR */
+   1,	/* CMD */
+   1,	/* STAB */
+   0,	/* LVAL */
+   1,	/* SINGLE */
+   0,	/* DOUBLE */
+   0,	/* BACKTICK */
+   0,	/* READ */
+   0,	/* SPAT */
+   0,	/* LEXPR */
+   1,	/* ARYLEN */
+   1,	/* ARYSTAB */
+   0,	/* LARYLEN */
+   0,	/* GLOB */
+   1,	/* WORD */
+   0,	/* INDREAD */
+   0,	/* LARYSTAB */
+   1,	/* STAR */
+   1,	/* LSTAR */
+   1,	/* WANTARRAY */
+   0,	/* LENSTAB */
+   0,	/* 21 */
+};
+#endif
+
+union argptr {
+    ARG		*arg_arg;
+    char	*arg_cval;
+    STAB	*arg_stab;
+    SPAT	*arg_spat;
+    CMD		*arg_cmd;
+    STR		*arg_str;
+    HASH	*arg_hash;
+};
+
+struct arg {
+    union argptr arg_ptr;
+    short	arg_len;
+    unsigned short arg_type;
+    unsigned short arg_flags;
+};
+
+#define AF_ARYOK 1		/* op can handle multiple values here */
+#define AF_POST 2		/* post *crement this item */
+#define AF_PRE 4		/* pre *crement this item */
+#define AF_UP 8			/* increment rather than decrement */
+#define AF_COMMON 16		/* left and right have symbols in common */
+#define AF_DEPR 32		/* an older form of the construct */
+#define AF_LISTISH 64		/* turn into list if important */
+#define AF_LOCAL 128		/* list of local variables */
+
+/*
+ * Most of the ARG pointers are used as pointers to arrays of ARG.  When
+ * so used, the 0th element is special, and represents the operator to
+ * use on the list of arguments following.  The arg_len in the 0th element
+ * gives the maximum argument number, and the arg_str is used to store
+ * the return value in a more-or-less static location.  Sorry it's not
+ * re-entrant (yet), but it sure makes it efficient.  The arg_type of the
+ * 0th element is an operator (O_*) rather than an argument type (A_*).
+ */
+
+#define Nullarg Null(ARG*)
+
+#ifndef DOINIT
+EXT unsigned short opargs[MAXO+1];
+#else
+#define A(e1,e2,e3)        (e1+(e2<<2)+(e3<<4))
+#define A5(e1,e2,e3,e4,e5) (e1+(e2<<2)+(e3<<4)+(e4<<6)+(e5<<8))
+unsigned short opargs[MAXO+1] = {
+	A(0,0,0),	/* NULL */
+	A(1,1,0),	/* RCAT */
+	A(1,0,0),	/* ITEM */
+	A(1,0,0),	/* SCALAR */
+	A(0,0,0),	/* ITEM2 */
+	A(0,0,0),	/* ITEM3 */
+	A(1,1,0),	/* CONCAT */
+	A(3,1,0),	/* REPEAT */
+	A(1,0,0),	/* MATCH */
+	A(1,0,0),	/* NMATCH */
+	A(1,0,0),	/* SUBST */
+	A(1,0,0),	/* NSUBST */
+	A(1,1,0),	/* ASSIGN */
+	A(1,0,0),	/* LOCAL */
+	A(3,3,0),	/* AASSIGN */
+	A(0,0,0),	/* SASSIGN */
+	A(3,0,0),	/* CHOP */
+	A(1,0,0),	/* DEFINED */
+	A(1,0,0),	/* UNDEF */
+	A(1,0,0),	/* STUDY */
+	A(1,1,0),	/* POW */
+	A(1,1,0),	/* MULTIPLY */
+	A(1,1,0),	/* DIVIDE */
+	A(1,1,0),	/* MODULO */
+	A(1,1,0),	/* ADD */
+	A(1,1,0),	/* SUBTRACT */
+	A(1,1,0),	/* LEFT_SHIFT */
+	A(1,1,0),	/* RIGHT_SHIFT */
+	A(1,1,0),	/* LT */
+	A(1,1,0),	/* GT */
+	A(1,1,0),	/* LE */
+	A(1,1,0),	/* GE */
+	A(1,1,0),	/* EQ */
+	A(1,1,0),	/* NE */
+	A(1,1,0),	/* NCMP */
+	A(1,1,0),	/* BIT_AND */
+	A(1,1,0),	/* XOR */
+	A(1,1,0),	/* BIT_OR */
+	A(1,0,0),	/* AND */
+	A(1,0,0),	/* OR */
+	A(1,0,0),	/* COND_EXPR */
+	A(1,1,0),	/* COMMA */
+	A(1,0,0),	/* NEGATE */
+	A(1,0,0),	/* NOT */
+	A(1,0,0),	/* COMPLEMENT */
+	A(1,0,0),	/* SELECT */
+	A(1,0,0),	/* WRITE */
+	A(1,1,1),	/* DBMOPEN */
+	A(1,0,0),	/* DBMCLOSE */
+	A(1,1,0),	/* OPEN */
+	A(1,0,0),	/* TRANS */
+	A(1,0,0),	/* NTRANS */
+	A(1,0,0),	/* CLOSE */
+	A(0,0,0),	/* EACH */
+	A(0,0,0),	/* VALUES */
+	A(0,0,0),	/* KEYS */
+	A(0,0,0),	/* LARRAY */
+	A(0,0,0),	/* ARRAY */
+	A(0,1,0),	/* AELEM */
+	A(0,1,0),	/* DELETE */
+	A(0,0,0),	/* LHASH */
+	A(0,0,0),	/* HASH */
+	A(0,1,0),	/* HELEM */
+	A(0,1,0),	/* LAELEM */
+	A(0,1,0),	/* LHELEM */
+	A(0,3,3),	/* LSLICE */
+	A(0,3,0),	/* ASLICE */
+	A(0,3,0),	/* HSLICE */
+	A(0,3,0),	/* LASLICE */
+	A(0,3,0),	/* LHSLICE */
+	A(0,3,1),	/* SPLICE */
+	A(0,3,0),	/* PUSH */
+	A(0,0,0),	/* POP */
+	A(0,0,0),	/* SHIFT */
+	A(1,1,0),	/* UNPACK */
+	A(1,0,1),	/* SPLIT */
+	A(1,0,0),	/* LENGTH */
+	A(3,0,0),	/* SPRINTF */
+	A(1,1,1),	/* SUBSTR */
+	A(1,3,0),	/* PACK */
+	A(0,3,0),	/* GREP */
+	A(1,3,0),	/* JOIN */
+	A(1,1,0),	/* SLT */
+	A(1,1,0),	/* SGT */
+	A(1,1,0),	/* SLE */
+	A(1,1,0),	/* SGE */
+	A(1,1,0),	/* SEQ */
+	A(1,1,0),	/* SNE */
+	A(1,1,0),	/* SCMP */
+	A(0,3,0),	/* SUBR */
+	A(0,3,0),	/* DBSUBR */
+	A(1,0,0),	/* CALLER */
+	A(1,3,0),	/* SORT */
+	A(0,3,0),	/* REVERSE */
+	A(0,3,0),	/* WARN */
+	A(0,3,0),	/* DIE */
+	A(1,3,0),	/* PRINTF */
+	A(1,3,0),	/* PRINT */
+	A(1,0,0),	/* CHDIR */
+	A(1,0,0),	/* EXIT */
+	A(1,0,0),	/* RESET */
+	A(3,0,0),	/* LIST */
+	A(1,0,0),	/* EOF */
+	A(1,0,0),	/* GETC */
+	A(1,0,0),	/* TELL */
+	A5(1,1,1,1,0),	/* RECV */
+	A(1,1,3),	/* READ */
+	A(1,1,3),	/* SYSREAD */
+	A(1,1,3),	/* SYSWRITE */
+	A(1,1,3),	/* SEND */
+	A(1,1,1),	/* SEEK */
+	A(0,3,0),	/* RETURN */
+	A(0,0,0),	/* REDO */
+	A(0,0,0),	/* NEXT */
+	A(0,0,0),	/* LAST */
+	A(0,0,0),	/* DUMP */
+	A(0,0,0),	/* GOTO */
+	A(1,1,1),	/* INDEX */
+	A(1,1,1),	/* RINDEX */
+	A(0,0,0),	/* TIME */
+	A(0,0,0),	/* TIMES */
+	A(1,0,0),	/* LOCALTIME */
+	A(1,0,0),	/* GMTIME */
+	A(1,1,0),	/* TRUNCATE */
+	A(1,0,0),	/* LSTAT */
+	A(1,0,0),	/* STAT */
+	A(1,1,0),	/* CRYPT */
+	A(1,1,0),	/* ATAN2 */
+	A(1,0,0),	/* SIN */
+	A(1,0,0),	/* COS */
+	A(1,0,0),	/* RAND */
+	A(1,0,0),	/* SRAND */
+	A(1,0,0),	/* EXP */
+	A(1,0,0),	/* LOG */
+	A(1,0,0),	/* SQRT */
+	A(1,0,0),	/* INT */
+	A(1,0,0),	/* ORD */
+	A(1,0,0),	/* ALARM */
+	A(1,0,0),	/* SLEEP */
+	A(1,1,0),	/* RANGE */
+	A(1,0,0),	/* F_OR_R */
+	A(1,0,0),	/* FLIP */
+	A(0,1,0),	/* FLOP */
+	A(0,0,0),	/* FORK */
+	A(0,0,0),	/* WAIT */
+	A(1,1,0),	/* WAITPID */
+	A(1,3,0),	/* SYSTEM */
+	A(1,3,0),	/* EXEC */
+	A(1,0,0),	/* HEX */
+	A(1,0,0),	/* OCT */
+	A(0,3,0),	/* CHOWN */
+	A(0,3,0),	/* KILL */
+	A(0,3,0),	/* UNLINK */
+	A(0,3,0),	/* CHMOD */
+	A(0,3,0),	/* UTIME */
+	A(1,0,0),	/* UMASK */
+	A(1,1,0),	/* MSGGET */
+	A(1,1,1),	/* SHMGET */
+	A(1,1,1),	/* SEMGET */
+	A(1,1,1),	/* MSGCTL */
+	A(1,1,1),	/* SHMCTL */
+	A5(1,1,1,1,0),	/* SEMCTL */
+	A(1,1,1),	/* MSGSND */
+	A5(1,1,1,1,1),	/* MSGRCV */
+	A(1,1,1),	/* SEMOP */
+	A5(1,1,1,1,0),	/* SHMREAD */
+	A5(1,1,1,1,0),	/* SHMWRITE */
+	A(1,1,0),	/* RENAME */
+	A(1,1,0),	/* LINK */
+	A(1,1,0),	/* MKDIR */
+	A(1,0,0),	/* RMDIR */
+	A(0,0,0),	/* GETPPID */
+	A(1,0,0),	/* GETPGRP */
+	A(1,1,0),	/* SETPGRP */
+	A(1,1,0),	/* GETPRIORITY */
+	A(1,1,1),	/* SETPRIORITY */
+	A(1,0,0),	/* CHROOT */
+	A(1,1,1),	/* FCNTL */
+	A(1,1,1),	/* SYSIOCTL */
+	A(1,1,0),	/* FLOCK */
+	A(0,3,0),	/* UNSHIFT */
+	A(1,0,0),	/* REQUIRE */
+	A(1,0,0),	/* DOFILE */
+	A(1,0,0),	/* EVAL */
+	A(1,0,0),	/* FTRREAD */
+	A(1,0,0),	/* FTRWRITE */
+	A(1,0,0),	/* FTREXEC */
+	A(1,0,0),	/* FTEREAD */
+	A(1,0,0),	/* FTEWRITE */
+	A(1,0,0),	/* FTEEXEC */
+	A(1,0,0),	/* FTIS */
+	A(1,0,0),	/* FTEOWNED */
+	A(1,0,0),	/* FTROWNED */
+	A(1,0,0),	/* FTZERO */
+	A(1,0,0),	/* FTSIZE */
+	A(1,0,0),	/* FTMTIME */
+	A(1,0,0),	/* FTATIME */
+	A(1,0,0),	/* FTCTIME */
+	A(1,0,0),	/* FTSOCK */
+	A(1,0,0),	/* FTCHR */
+	A(1,0,0),	/* FTBLK */
+	A(1,0,0),	/* FTFILE */
+	A(1,0,0),	/* FTDIR */
+	A(1,0,0),	/* FTPIPE */
+	A(1,0,0),	/* FTLINK */
+	A(1,1,0),	/* SYMLINK */
+	A(1,0,0),	/* READLINK */
+	A(1,0,0),	/* FTSUID */
+	A(1,0,0),	/* FTSGID */
+	A(1,0,0),	/* FTSVTX */
+	A(1,0,0),	/* FTTTY */
+	A(1,0,0),	/* FTTEXT */
+	A(1,0,0),	/* FTBINARY */
+	A5(1,1,1,1,0),	/* SOCKET */
+	A(1,1,0),	/* BIND */
+	A(1,1,0),	/* CONNECT */
+	A(1,1,0),	/* LISTEN */
+	A(1,1,0),	/* ACCEPT */
+	A(1,0,0),	/* GHBYNAME */
+	A(1,1,0),	/* GHBYADDR */
+	A(0,0,0),	/* GHOSTENT */
+	A(1,0,0),	/* GNBYNAME */
+	A(1,1,0),	/* GNBYADDR */
+	A(0,0,0),	/* GNETENT */
+	A(1,0,0),	/* GPBYNAME */
+	A(1,0,0),	/* GPBYNUMBER */
+	A(0,0,0),	/* GPROTOENT */
+	A(1,1,0),	/* GSBYNAME */
+	A(1,1,0),	/* GSBYPORT */
+	A(0,0,0),	/* GSERVENT */
+	A(1,0,0),	/* SHOSTENT */
+	A(1,0,0),	/* SNETENT */
+	A(1,0,0),	/* SPROTOENT */
+	A(1,0,0),	/* SSERVENT */
+	A(0,0,0),	/* EHOSTENT */
+	A(0,0,0),	/* ENETENT */
+	A(0,0,0),	/* EPROTOENT */
+	A(0,0,0),	/* ESERVENT */
+	A5(1,1,1,1,1),	/* SOCKPAIR */
+	A(1,1,0),	/* SHUTDOWN */
+	A(1,1,1),	/* GSOCKOPT */
+	A5(1,1,1,1,0),	/* SSOCKOPT */
+	A(1,0,0),	/* GETSOCKNAME */
+	A(1,0,0),	/* GETPEERNAME */
+	A5(1,1,1,1,0),	/* SSELECT */
+	A(1,0,0),	/* FILENO */
+	A(1,0,0),	/* BINMODE */
+	A(1,1,1),	/* VEC */
+	A(1,0,0),	/* GPWNAM */
+	A(1,0,0),	/* GPWUID */
+	A(0,0,0),	/* GPWENT */
+	A(0,0,0),	/* SPWENT */
+	A(0,0,0),	/* EPWENT */
+	A(1,0,0),	/* GGRNAM */
+	A(1,0,0),	/* GGRGID */
+	A(0,0,0),	/* GGRENT */
+	A(0,0,0),	/* SGRENT */
+	A(0,0,0),	/* EGRENT */
+	A(0,0,0),	/* GETLOGIN */
+	A(1,1,0),	/* OPENDIR */
+	A(1,0,0),	/* READDIR */
+	A(1,0,0),	/* TELLDIR */
+	A(1,1,0),	/* SEEKDIR */
+	A(1,0,0),	/* REWINDDIR */
+	A(1,0,0),	/* CLOSEDIR */
+	A(1,3,0),	/* SYSCALL */
+	A(1,1,0),	/* PIPE */
+	A(0,0,0),	/* TRY */
+	A(1,0,0),	/* EVALONCE */
+	0
+};
+#undef A
+#undef A5
+#endif
+
+int do_trans();
+int do_split();
+bool do_eof();
+long do_tell();
+bool do_seek();
+int do_tms();
+int do_time();
+int do_stat();
+STR *do_push();
+FILE *nextargv();
+STR *do_fttext();
+int do_slice();
diff --git a/gnu/usr.bin/perl/perl/array.c b/gnu/usr.bin/perl/perl/array.c
new file mode 100644
index 000000000000..445bc60be7dc
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/array.c
@@ -0,0 +1,287 @@
+/* $RCSfile: array.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:34 $
+ *
+ *    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: array.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:34  nate
+ * PERL!
+ *
+ * Revision 4.0.1.3  92/06/08  11:45:05  lwall
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
+ * Revision 4.0.1.2  91/11/05  16:00:14  lwall
+ * patch11: random cleanup
+ * patch11: passing non-existend array elements to subrouting caused core dump
+ * 
+ * Revision 4.0.1.1  91/06/07  10:19:08  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:03:32  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+STR *
+afetch(ar,key,lval)
+register ARRAY *ar;
+int key;
+int lval;
+{
+    STR *str;
+
+    if (key < 0 || key > ar->ary_fill) {
+	if (lval && key >= 0) {
+	    if (ar->ary_flags & ARF_REAL)
+		str = Str_new(5,0);
+	    else
+		str = str_mortal(&str_undef);
+	    (void)astore(ar,key,str);
+	    return str;
+	}
+	else
+	    return &str_undef;
+    }
+    if (!ar->ary_array[key]) {
+	if (lval) {
+	    str = Str_new(6,0);
+	    (void)astore(ar,key,str);
+	    return str;
+	}
+	return &str_undef;
+    }
+    return ar->ary_array[key];
+}
+
+bool
+astore(ar,key,val)
+register ARRAY *ar;
+int key;
+STR *val;
+{
+    int retval;
+
+    if (key < 0)
+	return FALSE;
+    if (key > ar->ary_max) {
+	int newmax;
+
+	if (ar->ary_alloc != ar->ary_array) {
+	    retval = ar->ary_array - ar->ary_alloc;
+	    Move(ar->ary_array, ar->ary_alloc, ar->ary_max+1, STR*);
+	    Zero(ar->ary_alloc+ar->ary_max+1, retval, STR*);
+	    ar->ary_max += retval;
+	    ar->ary_array -= retval;
+	    if (key > ar->ary_max - 10) {
+		newmax = key + ar->ary_max;
+		goto resize;
+	    }
+	}
+	else {
+	    if (ar->ary_alloc) {
+		newmax = key + ar->ary_max / 5;
+	      resize:
+		Renew(ar->ary_alloc,newmax+1, STR*);
+		Zero(&ar->ary_alloc[ar->ary_max+1], newmax - ar->ary_max, STR*);
+	    }
+	    else {
+		newmax = key < 4 ? 4 : key;
+		Newz(2,ar->ary_alloc, newmax+1, STR*);
+	    }
+	    ar->ary_array = ar->ary_alloc;
+	    ar->ary_max = newmax;
+	}
+    }
+    if (ar->ary_flags & ARF_REAL) {
+	if (ar->ary_fill < key) {
+	    while (++ar->ary_fill < key) {
+		if (ar->ary_array[ar->ary_fill] != Nullstr) {
+		    str_free(ar->ary_array[ar->ary_fill]);
+		    ar->ary_array[ar->ary_fill] = Nullstr;
+		}
+	    }
+	}
+	retval = (ar->ary_array[key] != Nullstr);
+	if (retval)
+	    str_free(ar->ary_array[key]);
+    }
+    else
+	retval = 0;
+    ar->ary_array[key] = val;
+    return retval;
+}
+
+ARRAY *
+anew(stab)
+STAB *stab;
+{
+    register ARRAY *ar;
+
+    New(1,ar,1,ARRAY);
+    ar->ary_magic = Str_new(7,0);
+    ar->ary_alloc = ar->ary_array = 0;
+    str_magic(ar->ary_magic, stab, '#', Nullch, 0);
+    ar->ary_max = ar->ary_fill = -1;
+    ar->ary_flags = ARF_REAL;
+    return ar;
+}
+
+ARRAY *
+afake(stab,size,strp)
+STAB *stab;
+register int size;
+register STR **strp;
+{
+    register ARRAY *ar;
+
+    New(3,ar,1,ARRAY);
+    New(4,ar->ary_alloc,size+1,STR*);
+    Copy(strp,ar->ary_alloc,size,STR*);
+    ar->ary_array = ar->ary_alloc;
+    ar->ary_magic = Str_new(8,0);
+    str_magic(ar->ary_magic, stab, '#', Nullch, 0);
+    ar->ary_fill = size - 1;
+    ar->ary_max = size - 1;
+    ar->ary_flags = 0;
+    while (size--) {
+	if (*strp)
+	    (*strp)->str_pok &= ~SP_TEMP;
+	strp++;
+    }
+    return ar;
+}
+
+void
+aclear(ar)
+register ARRAY *ar;
+{
+    register int key;
+
+    if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0)
+	return;
+    /*SUPPRESS 560*/
+    if (key = ar->ary_array - ar->ary_alloc) {
+	ar->ary_max += key;
+	ar->ary_array -= key;
+    }
+    for (key = 0; key <= ar->ary_max; key++)
+	str_free(ar->ary_array[key]);
+    ar->ary_fill = -1;
+    Zero(ar->ary_array, ar->ary_max+1, STR*);
+}
+
+void
+afree(ar)
+register ARRAY *ar;
+{
+    register int key;
+
+    if (!ar)
+	return;
+    /*SUPPRESS 560*/
+    if (key = ar->ary_array - ar->ary_alloc) {
+	ar->ary_max += key;
+	ar->ary_array -= key;
+    }
+    if (ar->ary_flags & ARF_REAL) {
+	for (key = 0; key <= ar->ary_max; key++)
+	    str_free(ar->ary_array[key]);
+    }
+    str_free(ar->ary_magic);
+    Safefree(ar->ary_alloc);
+    Safefree(ar);
+}
+
+bool
+apush(ar,val)
+register ARRAY *ar;
+STR *val;
+{
+    return astore(ar,++(ar->ary_fill),val);
+}
+
+STR *
+apop(ar)
+register ARRAY *ar;
+{
+    STR *retval;
+
+    if (ar->ary_fill < 0)
+	return Nullstr;
+    retval = ar->ary_array[ar->ary_fill];
+    ar->ary_array[ar->ary_fill--] = Nullstr;
+    return retval;
+}
+
+void
+aunshift(ar,num)
+register ARRAY *ar;
+register int num;
+{
+    register int i;
+    register STR **sstr,**dstr;
+
+    if (num <= 0)
+	return;
+    if (ar->ary_array - ar->ary_alloc >= num) {
+	ar->ary_max += num;
+	ar->ary_fill += num;
+	while (num--)
+	    *--ar->ary_array = Nullstr;
+    }
+    else {
+	(void)astore(ar,ar->ary_fill+num,(STR*)0);	/* maybe extend array */
+	dstr = ar->ary_array + ar->ary_fill;
+	sstr = dstr - num;
+#ifdef BUGGY_MSC5
+ # pragma loop_opt(off)	/* don't loop-optimize the following code */
+#endif /* BUGGY_MSC5 */
+	for (i = ar->ary_fill - num; i >= 0; i--) {
+	    *dstr-- = *sstr--;
+#ifdef BUGGY_MSC5
+ # pragma loop_opt()	/* loop-optimization back to command-line setting */
+#endif /* BUGGY_MSC5 */
+	}
+	Zero(ar->ary_array, num, STR*);
+    }
+}
+
+STR *
+ashift(ar)
+register ARRAY *ar;
+{
+    STR *retval;
+
+    if (ar->ary_fill < 0)
+	return Nullstr;
+    retval = *ar->ary_array;
+    *(ar->ary_array++) = Nullstr;
+    ar->ary_max--;
+    ar->ary_fill--;
+    return retval;
+}
+
+int
+alen(ar)
+register ARRAY *ar;
+{
+    return ar->ary_fill;
+}
+
+void
+afill(ar, fill)
+register ARRAY *ar;
+int fill;
+{
+    if (fill < 0)
+	fill = -1;
+    if (fill <= ar->ary_max)
+	ar->ary_fill = fill;
+    else
+	(void)astore(ar,fill,Nullstr);
+}
diff --git a/gnu/usr.bin/perl/perl/array.h b/gnu/usr.bin/perl/perl/array.h
new file mode 100644
index 000000000000..93d4920aedcf
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/array.h
@@ -0,0 +1,45 @@
+/* $RCSfile: array.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:34 $
+ *
+ *    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: array.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:34  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  11:45:57  lwall
+ * patch20: removed implicit int declarations on funcions
+ * 
+ * Revision 4.0.1.1  91/06/07  10:19:20  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:03:44  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+struct atbl {
+    STR	**ary_array;
+    STR **ary_alloc;
+    STR *ary_magic;
+    int ary_max;
+    int ary_fill;
+    char ary_flags;
+};
+
+#define ARF_REAL 1	/* free old entries */
+
+STR *afetch();
+bool astore();
+STR *apop();
+STR *ashift();
+void afree();
+void aclear();
+bool apush();
+int alen();
+ARRAY *anew();
+ARRAY *afake();
+void aunshift();
+void afill();
diff --git a/gnu/usr.bin/perl/perl/cflags b/gnu/usr.bin/perl/perl/cflags
new file mode 100755
index 000000000000..672dfc6d3cfa
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/cflags
@@ -0,0 +1,91 @@
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+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
+
+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 's/\.[oc] / /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
+    array) ;;
+    cmd) ;;
+    cons) ;;
+    consarg) ;;
+    doarg) ;;
+    doio) ;;
+    dolist) ;;
+    dump) ;;
+    eval) ;;
+    form) ;;
+    hash) ;;
+    malloc) ;;
+    perl) ;;
+    perly) ;;
+    regcomp) ;;
+    regexec) ;;
+    stab) ;;
+    str) ;;
+    toke) ;;
+    usersub) ;;
+    util) ;;
+    tarray) ;;
+    tcmd) ;;
+    tcons) ;;
+    tconsarg) ;;
+    tdoarg) ;;
+    tdoio) ;;
+    tdolist) ;;
+    tdump) ;;
+    teval) ;;
+    tform) ;;
+    thash) ;;
+    tmalloc) ;;
+    tperl) ;;
+    tperly) ;;
+    tregcomp) ;;
+    tregexec) ;;
+    tstab) ;;
+    tstr) ;;
+    ttoke) ;;
+    tusersub) ;;
+    tutil) ;;
+    *) ;;
+    esac
+
+    echo "$cc -c $ccflags $optimize $large $split"
+    eval "$also "'"$cc -c $ccflags $optimize $large $split"'
+
+    . ./config.sh
+
+done
diff --git a/gnu/usr.bin/perl/perl/cmd.c b/gnu/usr.bin/perl/perl/cmd.c
new file mode 100644
index 000000000000..1ddbde082a1e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/cmd.c
@@ -0,0 +1,1263 @@
+/* $RCSfile: cmd.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: cmd.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.5  92/06/08  12:00:39  lwall
+ * patch20: the switch optimizer didn't do anything in subroutines
+ * patch20: removed implicit int declarations on funcions
+ * 
+ * Revision 4.0.1.4  91/11/11  16:29:33  lwall
+ * patch19: do {$foo ne "bar";} returned wrong value
+ * patch19: some earlier patches weren't propagated to alternate 286 code
+ * 
+ * Revision 4.0.1.3  91/11/05  16:07:43  lwall
+ * patch11: random cleanup
+ * patch11: "foo\0" eq "foo" was sometimes optimized to true
+ * patch11: foreach on null list could spring memory leak
+ * 
+ * Revision 4.0.1.2  91/06/07  10:26:45  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * 
+ * Revision 4.0.1.1  91/04/11  17:36:16  lwall
+ * patch1: you may now use "die" and "caller" in a signal handler
+ * 
+ * Revision 4.0  91/03/20  01:04:18  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef I_VARARGS
+#  include <varargs.h>
+#endif
+
+static STR strchop;
+
+void grow_dlevel();
+
+/* do longjmps() clobber register variables? */
+
+#if defined(cray) || defined(STANDARD_C)
+#define JMPCLOBBER
+#endif
+
+/* This is the main command loop.  We try to spend as much time in this loop
+ * as possible, so lots of optimizations do their activities in here.  This
+ * means things get a little sloppy.
+ */
+
+int
+cmd_exec(cmdparm,gimme,sp)
+CMD *VOLATILE cmdparm;
+VOLATILE int gimme;
+VOLATILE int sp;
+{
+    register CMD *cmd = cmdparm;
+    SPAT *VOLATILE oldspat;
+    VOLATILE int firstsave = savestack->ary_fill;
+    VOLATILE int oldsave;
+    VOLATILE int aryoptsave;
+#ifdef DEBUGGING
+    VOLATILE int olddlevel;
+    VOLATILE int entdlevel;
+#endif
+    register STR *retstr = &str_undef;
+    register char *tmps;
+    register int cmdflags;
+    register int match;
+    register char *go_to = goto_targ;
+    register int newsp = -2;
+    register STR **st = stack->ary_array;
+    FILE *VOLATILE fp;
+    ARRAY *VOLATILE ar;
+
+    lastsize = 0;
+#ifdef DEBUGGING
+    entdlevel = dlevel;
+#endif
+tail_recursion_entry:
+#ifdef DEBUGGING
+    dlevel = entdlevel;
+    if (debug & 4)
+	deb("mortals = (%d/%d) stack, = (%d/%d)\n",
+	    tmps_max, tmps_base,
+	    savestack->ary_fill, firstsave);
+#endif
+#ifdef TAINT
+    tainted = 0;	/* Each statement is presumed innocent */
+#endif
+    if (cmd == Nullcmd) {
+	if (gimme == G_ARRAY && newsp > -2)
+	    return newsp;
+	else {
+	    st[++sp] = retstr;
+	    return sp;
+	}
+    }
+    cmdflags = cmd->c_flags;	/* hopefully load register */
+    if (go_to) {
+	if (cmd->c_label && strEQ(go_to,cmd->c_label))
+	    goto_targ = go_to = Nullch;		/* here at last */
+	else {
+	    switch (cmd->c_type) {
+	    case C_IF:
+		oldspat = curspat;
+		oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+		olddlevel = dlevel;
+#endif
+		retstr = &str_yes;
+		newsp = -2;
+		if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+		    if (debug) {
+			debname[dlevel] = 't';
+			debdelim[dlevel] = '_';
+			if (++dlevel >= dlmax)
+			    grow_dlevel();
+		    }
+#endif
+		    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+		    st = stack->ary_array;	/* possibly reallocated */
+		    retstr = st[newsp];
+		}
+		if (!goto_targ)
+		    go_to = Nullch;
+		curspat = oldspat;
+		if (savestack->ary_fill > oldsave)
+		    restorelist(oldsave);
+#ifdef DEBUGGING
+		dlevel = olddlevel;
+#endif
+		cmd = cmd->ucmd.ccmd.cc_alt;
+		goto tail_recursion_entry;
+	    case C_ELSE:
+		oldspat = curspat;
+		oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+		olddlevel = dlevel;
+#endif
+		retstr = &str_undef;
+		newsp = -2;
+		if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+		    if (debug) {
+			debname[dlevel] = 'e';
+			debdelim[dlevel] = '_';
+			if (++dlevel >= dlmax)
+			    grow_dlevel();
+		    }
+#endif
+		    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+		    st = stack->ary_array;	/* possibly reallocated */
+		    retstr = st[newsp];
+		}
+		if (!goto_targ)
+		    go_to = Nullch;
+		curspat = oldspat;
+		if (savestack->ary_fill > oldsave)
+		    restorelist(oldsave);
+#ifdef DEBUGGING
+		dlevel = olddlevel;
+#endif
+		break;
+	    case C_BLOCK:
+	    case C_WHILE:
+		if (!(cmdflags & CF_ONCE)) {
+		    cmdflags |= CF_ONCE;
+		    if (++loop_ptr >= loop_max) {
+			loop_max += 128;
+			Renew(loop_stack, loop_max, struct loop);
+		    }
+		    loop_stack[loop_ptr].loop_label = cmd->c_label;
+		    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+		    if (debug & 4) {
+			deb("(Pushing label #%d %s)\n",
+			  loop_ptr, cmd->c_label ? cmd->c_label : "");
+		    }
+#endif
+		}
+#ifdef JMPCLOBBER
+		cmdparm = cmd;
+#endif
+		match = setjmp(loop_stack[loop_ptr].loop_env);
+		if (match) {
+		    st = stack->ary_array;	/* possibly reallocated */
+#ifdef JMPCLOBBER
+		    cmd = cmdparm;
+		    cmdflags = cmd->c_flags|CF_ONCE;
+#endif
+		    if (savestack->ary_fill > oldsave)
+			restorelist(oldsave);
+		    switch (match) {
+		    default:
+			fatal("longjmp returned bad value (%d)",match);
+		    case O_LAST:	/* not done unless go_to found */
+			go_to = Nullch;
+			if (lastretstr) {
+			    retstr = lastretstr;
+			    newsp = -2;
+			}
+			else {
+			    newsp = sp + lastsize;
+			    retstr = st[newsp];
+			}
+#ifdef DEBUGGING
+			olddlevel = dlevel;
+#endif
+			curspat = oldspat;
+			goto next_cmd;
+		    case O_NEXT:	/* not done unless go_to found */
+			go_to = Nullch;
+#ifdef JMPCLOBBER
+			newsp = -2;
+			retstr = &str_undef;
+#endif
+			goto next_iter;
+		    case O_REDO:	/* not done unless go_to found */
+			go_to = Nullch;
+#ifdef JMPCLOBBER
+			newsp = -2;
+			retstr = &str_undef;
+#endif
+			goto doit;
+		    }
+		}
+		oldspat = curspat;
+		oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+		olddlevel = dlevel;
+#endif
+		if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+		    if (debug) {
+			debname[dlevel] = 't';
+			debdelim[dlevel] = '_';
+			if (++dlevel >= dlmax)
+			    grow_dlevel();
+		    }
+#endif
+		    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+		    st = stack->ary_array;	/* possibly reallocated */
+		    if (newsp >= 0)
+			retstr = st[newsp];
+		}
+		if (!goto_targ) {
+		    go_to = Nullch;
+		    goto next_iter;
+		}
+#ifdef DEBUGGING
+		dlevel = olddlevel;
+#endif
+		if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+		    if (debug) {
+			debname[dlevel] = 'a';
+			debdelim[dlevel] = '_';
+			if (++dlevel >= dlmax)
+			    grow_dlevel();
+		    }
+#endif
+		    newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
+		    st = stack->ary_array;	/* possibly reallocated */
+		    if (newsp >= 0)
+			retstr = st[newsp];
+		}
+		if (goto_targ)
+		    break;
+		go_to = Nullch;
+		goto finish_while;
+	    }
+	    cmd = cmd->c_next;
+	    if (cmd && cmd->c_head == cmd)
+					/* reached end of while loop */
+		return sp;		/* targ isn't in this block */
+	    if (cmdflags & CF_ONCE) {
+#ifdef DEBUGGING
+		if (debug & 4) {
+		    tmps = loop_stack[loop_ptr].loop_label;
+		    deb("(Popping label #%d %s)\n",loop_ptr,
+			tmps ? tmps : "" );
+		}
+#endif
+		loop_ptr--;
+	    }
+	    goto tail_recursion_entry;
+	}
+    }
+
+until_loop:
+
+    /* Set line number so run-time errors can be located */
+
+    curcmd = cmd;
+
+#ifdef DEBUGGING
+    if (debug) {
+	if (debug & 2) {
+	    deb("%s	(%lx)	r%lx	t%lx	a%lx	n%lx	cs%lx\n",
+		cmdname[cmd->c_type],cmd,cmd->c_expr,
+		cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt,cmd->c_next,
+		curspat);
+	}
+	debname[dlevel] = cmdname[cmd->c_type][0];
+	debdelim[dlevel] = '!';
+	if (++dlevel >= dlmax)
+	    grow_dlevel();
+    }
+#endif
+
+    /* Here is some common optimization */
+
+    if (cmdflags & CF_COND) {
+	switch (cmdflags & CF_OPTIMIZE) {
+
+	case CFT_FALSE:
+	    retstr = cmd->c_short;
+	    newsp = -2;
+	    match = FALSE;
+	    if (cmdflags & CF_NESURE)
+		goto maybe;
+	    break;
+	case CFT_TRUE:
+	    retstr = cmd->c_short;
+	    newsp = -2;
+	    match = TRUE;
+	    if (cmdflags & CF_EQSURE)
+		goto flipmaybe;
+	    break;
+
+	case CFT_REG:
+	    retstr = STAB_STR(cmd->c_stab);
+	    newsp = -2;
+	    match = str_true(retstr);	/* => retstr = retstr, c2 should fix */
+	    if (cmdflags & (match ? CF_EQSURE : CF_NESURE))
+		goto flipmaybe;
+	    break;
+
+	case CFT_ANCHOR:	/* /^pat/ optimization */
+	    if (multiline) {
+		if (*cmd->c_short->str_ptr && !(cmdflags & CF_EQSURE))
+		    goto scanner;	/* just unanchor it */
+		else
+		    break;		/* must evaluate */
+	    }
+	    match = 0;
+	    goto strop;
+
+	case CFT_STROP:		/* string op optimization */
+	    match = 1;
+	  strop:
+	    retstr = STAB_STR(cmd->c_stab);
+	    newsp = -2;
+#ifndef I286
+	    if (*cmd->c_short->str_ptr == *str_get(retstr) &&
+		    (match ? retstr->str_cur == cmd->c_slen - 1 :
+		    	     retstr->str_cur >= cmd->c_slen) &&
+		    bcmp(cmd->c_short->str_ptr, str_get(retstr),
+		      cmd->c_slen) == 0 ) {
+		if (cmdflags & CF_EQSURE) {
+		    if (sawampersand && (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
+			curspat = Nullspat;
+			if (leftstab)
+			    str_nset(stab_val(leftstab),"",0);
+			if (amperstab)
+			    str_sset(stab_val(amperstab),cmd->c_short);
+			if (rightstab)
+			    str_nset(stab_val(rightstab),
+			      retstr->str_ptr + cmd->c_slen,
+			      retstr->str_cur - cmd->c_slen);
+		    }
+		    if (cmd->c_spat)
+			lastspat = cmd->c_spat;
+		    match = !(cmdflags & CF_FIRSTNEG);
+		    retstr = match ? &str_yes : &str_no;
+		    goto flipmaybe;
+		}
+	    }
+	    else if (cmdflags & CF_NESURE) {
+		match = cmdflags & CF_FIRSTNEG;
+		retstr = match ? &str_yes : &str_no;
+		goto flipmaybe;
+	    }
+#else
+	    {
+		char *zap1, *zap2, zap1c, zap2c;
+		int  zaplen;
+		int lenok;
+
+		zap1 = cmd->c_short->str_ptr;
+		zap2 = str_get(retstr);
+		zap1c = *zap1;
+		zap2c = *zap2;
+		zaplen = cmd->c_slen;
+		if (match)
+		    lenok = (retstr->str_cur == cmd->c_slen - 1);
+		else
+		    lenok = (retstr->str_cur >= cmd->c_slen);
+		if ((zap1c == zap2c) && lenok && (bcmp(zap1, zap2, zaplen) == 0)) {
+		    if (cmdflags & CF_EQSURE) {
+			if (sawampersand &&
+			  (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
+			    curspat = Nullspat;
+			    if (leftstab)
+				str_nset(stab_val(leftstab),"",0);
+			    if (amperstab)
+				str_sset(stab_val(amperstab),cmd->c_short);
+			    if (rightstab)
+				str_nset(stab_val(rightstab),
+					 retstr->str_ptr + cmd->c_slen,
+					 retstr->str_cur - cmd->c_slen);
+			}
+			if (cmd->c_spat)
+			    lastspat = cmd->c_spat;
+		 	match = !(cmdflags & CF_FIRSTNEG);
+			retstr = match ? &str_yes : &str_no;
+		 	goto flipmaybe;
+		    }
+		}
+		else if (cmdflags & CF_NESURE) {
+		    match = cmdflags & CF_FIRSTNEG;
+		    retstr = match ? &str_yes : &str_no;
+		    goto flipmaybe;
+		}
+	    }
+#endif
+	    break;			/* must evaluate */
+
+	case CFT_SCAN:			/* non-anchored search */
+	  scanner:
+	    retstr = STAB_STR(cmd->c_stab);
+	    newsp = -2;
+	    if (retstr->str_pok & SP_STUDIED)
+		if (screamfirst[cmd->c_short->str_rare] >= 0)
+		    tmps = screaminstr(retstr, cmd->c_short);
+		else
+		    tmps = Nullch;
+	    else {
+		tmps = str_get(retstr);		/* make sure it's pok */
+#ifndef lint
+		tmps = fbminstr((unsigned char*)tmps,
+		    (unsigned char*)tmps + retstr->str_cur, cmd->c_short);
+#endif
+	    }
+	    if (tmps) {
+		if (cmdflags & CF_EQSURE) {
+		    ++cmd->c_short->str_u.str_useful;
+		    if (sawampersand) {
+			curspat = Nullspat;
+			if (leftstab)
+			    str_nset(stab_val(leftstab),retstr->str_ptr,
+			      tmps - retstr->str_ptr);
+			if (amperstab)
+			    str_nset(stab_val(amperstab),
+			      tmps, cmd->c_short->str_cur);
+			if (rightstab)
+			    str_nset(stab_val(rightstab),
+			      tmps + cmd->c_short->str_cur,
+			      retstr->str_cur - (tmps - retstr->str_ptr) -
+				cmd->c_short->str_cur);
+		    }
+		    lastspat = cmd->c_spat;
+		    match = !(cmdflags & CF_FIRSTNEG);
+		    retstr = match ? &str_yes : &str_no;
+		    goto flipmaybe;
+		}
+		else
+		    hint = tmps;
+	    }
+	    else {
+		if (cmdflags & CF_NESURE) {
+		    ++cmd->c_short->str_u.str_useful;
+		    match = cmdflags & CF_FIRSTNEG;
+		    retstr = match ? &str_yes : &str_no;
+		    goto flipmaybe;
+		}
+	    }
+	    if (--cmd->c_short->str_u.str_useful < 0) {
+		cmdflags &= ~CF_OPTIMIZE;
+		cmdflags |= CFT_EVAL;	/* never try this optimization again */
+		cmd->c_flags = (cmdflags & ~CF_ONCE);
+	    }
+	    break;			/* must evaluate */
+
+	case CFT_NUMOP:		/* numeric op optimization */
+	    retstr = STAB_STR(cmd->c_stab);
+	    newsp = -2;
+	    switch (cmd->c_slen) {
+	    case O_EQ:
+		if (dowarn) {
+		    if ((!retstr->str_nok && !looks_like_number(retstr)))
+			warn("Possible use of == on string value");
+		}
+		match = (str_gnum(retstr) == cmd->c_short->str_u.str_nval);
+		break;
+	    case O_NE:
+		match = (str_gnum(retstr) != cmd->c_short->str_u.str_nval);
+		break;
+	    case O_LT:
+		match = (str_gnum(retstr) <  cmd->c_short->str_u.str_nval);
+		break;
+	    case O_LE:
+		match = (str_gnum(retstr) <= cmd->c_short->str_u.str_nval);
+		break;
+	    case O_GT:
+		match = (str_gnum(retstr) >  cmd->c_short->str_u.str_nval);
+		break;
+	    case O_GE:
+		match = (str_gnum(retstr) >= cmd->c_short->str_u.str_nval);
+		break;
+	    }
+	    if (match) {
+		if (cmdflags & CF_EQSURE) {
+		    retstr = &str_yes;
+		    goto flipmaybe;
+		}
+	    }
+	    else if (cmdflags & CF_NESURE) {
+		retstr = &str_no;
+		goto flipmaybe;
+	    }
+	    break;			/* must evaluate */
+
+	case CFT_INDGETS:		/* while (<$foo>) */
+	    last_in_stab = stabent(str_get(STAB_STR(cmd->c_stab)),TRUE);
+	    if (!stab_io(last_in_stab))
+		stab_io(last_in_stab) = stio_new();
+	    goto dogets;
+	case CFT_GETS:			/* really a while (<file>) */
+	    last_in_stab = cmd->c_stab;
+	  dogets:
+	    fp = stab_io(last_in_stab)->ifp;
+	    retstr = stab_val(defstab);
+	    newsp = -2;
+	  keepgoing:
+	    if (fp && str_gets(retstr, fp, 0)) {
+		if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
+		    match = FALSE;
+		else
+		    match = TRUE;
+		stab_io(last_in_stab)->lines++;
+	    }
+	    else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
+		if (!fp)
+		    goto doeval;	/* first time through */
+		fp = nextargv(last_in_stab);
+		if (fp)
+		    goto keepgoing;
+		(void)do_close(last_in_stab,FALSE);
+		stab_io(last_in_stab)->flags |= IOF_START;
+		retstr = &str_undef;
+		match = FALSE;
+	    }
+	    else {
+		retstr = &str_undef;
+		match = FALSE;
+	    }
+	    goto flipmaybe;
+	case CFT_EVAL:
+	    break;
+	case CFT_UNFLIP:
+	    while (tmps_max > tmps_base) {	/* clean up after last eval */
+		str_free(tmps_list[tmps_max]);
+		tmps_list[tmps_max--] = Nullstr;
+	    }
+	    newsp = eval(cmd->c_expr,gimme && (cmdflags & CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	    match = str_true(retstr);
+	    if (cmd->c_expr->arg_type == O_FLIP)	/* undid itself? */
+		cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
+	    goto maybe;
+	case CFT_CHOP:
+	    retstr = stab_val(cmd->c_stab);
+	    newsp = -2;
+	    match = (retstr->str_cur != 0);
+	    tmps = str_get(retstr);
+	    tmps += retstr->str_cur - match;
+	    str_nset(&strchop,tmps,match);
+	    *tmps = '\0';
+	    retstr->str_nok = 0;
+	    retstr->str_cur = tmps - retstr->str_ptr;
+	    STABSET(retstr);
+	    retstr = &strchop;
+	    goto flipmaybe;
+	case CFT_ARRAY:
+	    match = cmd->c_short->str_u.str_useful; /* just to get register */
+
+	    if (match < 0) {		/* first time through here? */
+		ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
+		aryoptsave = savestack->ary_fill;
+		savesptr(&stab_val(cmd->c_stab));
+		savelong(&cmd->c_short->str_u.str_useful);
+	    }
+	    else {
+		ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
+		if (cmd->c_type != C_WHILE && savestack->ary_fill > firstsave)
+		    restorelist(firstsave);
+	    }
+
+	    if (match >= ar->ary_fill) {	/* we're in LAST, probably */
+		if (match < 0 &&		/* er, probably not... */
+		  savestack->ary_fill > aryoptsave)
+		    restorelist(aryoptsave);
+		retstr = &str_undef;
+		cmd->c_short->str_u.str_useful = -1;	/* actually redundant */
+		match = FALSE;
+	    }
+	    else {
+		match++;
+		if (!(retstr = ar->ary_array[match]))
+		    retstr = afetch(ar,match,TRUE);
+		stab_val(cmd->c_stab) = retstr;
+		cmd->c_short->str_u.str_useful = match;
+		match = TRUE;
+	    }
+	    newsp = -2;
+	    goto maybe;
+	case CFT_D1:
+	    break;
+	case CFT_D0:
+	    if (DBsingle->str_u.str_nval != 0)
+		break;
+	    if (DBsignal->str_u.str_nval != 0)
+		break;
+	    if (DBtrace->str_u.str_nval != 0)
+		break;
+	    goto next_cmd;
+	}
+
+    /* we have tried to make this normal case as abnormal as possible */
+
+    doeval:
+	if (gimme == G_ARRAY) {
+	    lastretstr = Nullstr;
+	    lastspbase = sp;
+	    lastsize = newsp - sp;
+	    if (lastsize < 0)
+		lastsize = 0;
+	}
+	else
+	    lastretstr = retstr;
+	while (tmps_max > tmps_base) {	/* clean up after last eval */
+	    str_free(tmps_list[tmps_max]);
+	    tmps_list[tmps_max--] = Nullstr;
+	}
+	newsp = eval(cmd->c_expr,
+	  gimme && (cmdflags & CF_TERM) && cmd->c_type == C_EXPR &&
+		!cmd->ucmd.acmd.ac_expr,
+	  sp);
+	st = stack->ary_array;	/* possibly reallocated */
+	retstr = st[newsp];
+	if (newsp > sp && retstr)
+	    match = str_true(retstr);
+	else
+	    match = FALSE;
+	goto maybe;
+
+    /* if flipflop was true, flop it */
+
+    flipmaybe:
+	if (match && cmdflags & CF_FLIP) {
+	    while (tmps_max > tmps_base) {	/* clean up after last eval */
+		str_free(tmps_list[tmps_max]);
+		tmps_list[tmps_max--] = Nullstr;
+	    }
+	    if (cmd->c_expr->arg_type == O_FLOP) {	/* currently toggled? */
+		newsp = eval(cmd->c_expr,G_SCALAR,sp);/*let eval undo it*/
+		cmdflags = copyopt(cmd,cmd->c_expr[3].arg_ptr.arg_cmd);
+	    }
+	    else {
+		newsp = eval(cmd->c_expr,G_SCALAR,sp);/* let eval do it */
+		if (cmd->c_expr->arg_type == O_FLOP)	/* still toggled? */
+		    cmdflags = copyopt(cmd,cmd->c_expr[4].arg_ptr.arg_cmd);
+	    }
+	}
+	else if (cmdflags & CF_FLIP) {
+	    if (cmd->c_expr->arg_type == O_FLOP) {	/* currently toggled? */
+		match = TRUE;				/* force on */
+	    }
+	}
+
+    /* at this point, match says whether our expression was true */
+
+    maybe:
+	if (cmdflags & CF_INVERT)
+	    match = !match;
+	if (!match)
+	    goto next_cmd;
+    }
+#ifdef TAINT
+    tainted = 0;	/* modifier doesn't affect regular expression */
+#endif
+
+    /* now to do the actual command, if any */
+
+    switch (cmd->c_type) {
+    case C_NULL:
+	fatal("panic: cmd_exec");
+    case C_EXPR:			/* evaluated for side effects */
+	if (cmd->ucmd.acmd.ac_expr) {	/* more to do? */
+	    if (gimme == G_ARRAY) {
+		lastretstr = Nullstr;
+		lastspbase = sp;
+		lastsize = newsp - sp;
+		if (lastsize < 0)
+		    lastsize = 0;
+	    }
+	    else
+		lastretstr = retstr;
+	    while (tmps_max > tmps_base) {	/* clean up after last eval */
+		str_free(tmps_list[tmps_max]);
+		tmps_list[tmps_max--] = Nullstr;
+	    }
+	    newsp = eval(cmd->ucmd.acmd.ac_expr,gimme && (cmdflags&CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	}
+	break;
+    case C_NSWITCH:
+	{
+	    double value = str_gnum(STAB_STR(cmd->c_stab));
+
+	    match = (int)value;
+	    if (value < 0.0) {
+		if (((double)match) > value)
+		    --match;		/* was fractional--truncate other way */
+	    }
+	}
+	goto doswitch;
+    case C_CSWITCH:
+	if (multiline) {
+	    cmd = cmd->c_next;			/* can't assume anything */
+	    goto tail_recursion_entry;
+	}
+	match = *(str_get(STAB_STR(cmd->c_stab))) & 255;
+      doswitch:
+	match -= cmd->ucmd.scmd.sc_offset;
+	if (match < 0)
+	    match = 0;
+	else if (match > cmd->ucmd.scmd.sc_max)
+	    match = cmd->ucmd.scmd.sc_max;
+	cmd = cmd->ucmd.scmd.sc_next[match];
+	goto tail_recursion_entry;
+    case C_NEXT:
+	cmd = cmd->ucmd.ccmd.cc_alt;
+	goto tail_recursion_entry;
+    case C_ELSIF:
+	fatal("panic: ELSIF");
+    case C_IF:
+	oldspat = curspat;
+	oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+	olddlevel = dlevel;
+#endif
+	retstr = &str_yes;
+	newsp = -2;
+	if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+	    if (debug) {
+		debname[dlevel] = 't';
+		debdelim[dlevel] = '_';
+		if (++dlevel >= dlmax)
+		    grow_dlevel();
+	    }
+#endif
+	    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	}
+	curspat = oldspat;
+	if (savestack->ary_fill > oldsave)
+	    restorelist(oldsave);
+#ifdef DEBUGGING
+	dlevel = olddlevel;
+#endif
+	cmd = cmd->ucmd.ccmd.cc_alt;
+	goto tail_recursion_entry;
+    case C_ELSE:
+	oldspat = curspat;
+	oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+	olddlevel = dlevel;
+#endif
+	retstr = &str_undef;
+	newsp = -2;
+	if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+	    if (debug) {
+		debname[dlevel] = 'e';
+		debdelim[dlevel] = '_';
+		if (++dlevel >= dlmax)
+		    grow_dlevel();
+	    }
+#endif
+	    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	}
+	curspat = oldspat;
+	if (savestack->ary_fill > oldsave)
+	    restorelist(oldsave);
+#ifdef DEBUGGING
+	dlevel = olddlevel;
+#endif
+	break;
+    case C_BLOCK:
+    case C_WHILE:
+	if (!(cmdflags & CF_ONCE)) {	/* first time through here? */
+	    cmdflags |= CF_ONCE;
+	    if (++loop_ptr >= loop_max) {
+		loop_max += 128;
+		Renew(loop_stack, loop_max, struct loop);
+	    }
+	    loop_stack[loop_ptr].loop_label = cmd->c_label;
+	    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+	    if (debug & 4) {
+		deb("(Pushing label #%d %s)\n",
+		  loop_ptr, cmd->c_label ? cmd->c_label : "");
+	    }
+#endif
+	}
+#ifdef JMPCLOBBER
+	cmdparm = cmd;
+#endif
+	match = setjmp(loop_stack[loop_ptr].loop_env);
+	if (match) {
+	    st = stack->ary_array;	/* possibly reallocated */
+#ifdef JMPCLOBBER
+	    cmd = cmdparm;
+	    cmdflags = cmd->c_flags|CF_ONCE;
+	    go_to = goto_targ;
+#endif
+	    if (savestack->ary_fill > oldsave)
+		restorelist(oldsave);
+	    switch (match) {
+	    default:
+		fatal("longjmp returned bad value (%d)",match);
+	    case O_LAST:
+		if (lastretstr) {
+		    retstr = lastretstr;
+		    newsp = -2;
+		}
+		else {
+		    newsp = sp + lastsize;
+		    retstr = st[newsp];
+		}
+		curspat = oldspat;
+		goto next_cmd;
+	    case O_NEXT:
+#ifdef JMPCLOBBER
+		newsp = -2;
+		retstr = &str_undef;
+#endif
+		goto next_iter;
+	    case O_REDO:
+#ifdef DEBUGGING
+		dlevel = olddlevel;
+#endif
+#ifdef JMPCLOBBER
+		newsp = -2;
+		retstr = &str_undef;
+#endif
+		goto doit;
+	    }
+	}
+	oldspat = curspat;
+	oldsave = savestack->ary_fill;
+#ifdef DEBUGGING
+	olddlevel = dlevel;
+#endif
+    doit:
+	if (cmd->ucmd.ccmd.cc_true) {
+#ifdef DEBUGGING
+	    if (debug) {
+		debname[dlevel] = 't';
+		debdelim[dlevel] = '_';
+		if (++dlevel >= dlmax)
+		    grow_dlevel();
+	    }
+#endif
+	    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	}
+	/* actually, this spot is rarely reached anymore since the above
+	 * cmd_exec() returns through longjmp().  Hooray for structure.
+	 */
+      next_iter:
+#ifdef DEBUGGING
+	dlevel = olddlevel;
+#endif
+	if (cmd->ucmd.ccmd.cc_alt) {
+#ifdef DEBUGGING
+	    if (debug) {
+		debname[dlevel] = 'a';
+		debdelim[dlevel] = '_';
+		if (++dlevel >= dlmax)
+		    grow_dlevel();
+	    }
+#endif
+	    newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    retstr = st[newsp];
+	}
+      finish_while:
+	curspat = oldspat;
+	if (savestack->ary_fill > oldsave) {
+	    if (cmdflags & CF_TERM) {
+		for (match = sp + 1; match <= newsp; match++)
+		    st[match] = str_mortal(st[match]);
+		retstr = st[newsp];
+	    }
+	    restorelist(oldsave);
+	}
+#ifdef DEBUGGING
+	dlevel = olddlevel - 1;
+#endif
+	if (cmd->c_type != C_BLOCK)
+	    goto until_loop;	/* go back and evaluate conditional again */
+    }
+    if (cmdflags & CF_LOOP) {
+	cmdflags |= CF_COND;		/* now test the condition */
+#ifdef DEBUGGING
+	dlevel = entdlevel;
+#endif
+	goto until_loop;
+    }
+  next_cmd:
+    if (cmdflags & CF_ONCE) {
+#ifdef DEBUGGING
+	if (debug & 4) {
+	    tmps = loop_stack[loop_ptr].loop_label;
+	    deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : "");
+	}
+#endif
+	loop_ptr--;
+	if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY &&
+	  savestack->ary_fill > aryoptsave)
+	    restorelist(aryoptsave);
+    }
+    cmd = cmd->c_next;
+    goto tail_recursion_entry;
+}
+
+#ifdef DEBUGGING
+#  ifndef I_VARARGS
+/*VARARGS1*/
+void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
+char *pat;
+{
+    register int i;
+
+    fprintf(stderr,"%-4ld",(long)curcmd->c_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
+/*VARARGS1*/
+void deb(va_alist)
+va_dcl
+{
+    va_list args;
+    char *pat;
+    register int i;
+
+    va_start(args);
+    fprintf(stderr,"%-4ld",(long)curcmd->c_line);
+    for (i=0; i<dlevel; i++)
+	fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
+
+    pat = va_arg(args, char *);
+    (void) vfprintf(stderr,pat,args);
+    va_end( args );
+}
+#  endif
+#endif
+
+int
+copyopt(cmd,which)
+register CMD *cmd;
+register CMD *which;
+{
+    cmd->c_flags &= CF_ONCE|CF_COND|CF_LOOP;
+    cmd->c_flags |= which->c_flags;
+    cmd->c_short = which->c_short;
+    cmd->c_slen = which->c_slen;
+    cmd->c_stab = which->c_stab;
+    return cmd->c_flags;
+}
+
+ARRAY *
+saveary(stab)
+STAB *stab;
+{
+    register STR *str;
+
+    str = Str_new(10,0);
+    str->str_state = SS_SARY;
+    str->str_u.str_stab = stab;
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_ptr = Nullch;
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)stab_array(stab);
+    (void)apush(savestack,str); /* save array ptr */
+    stab_xarray(stab) = Null(ARRAY*);
+    return stab_xarray(aadd(stab));
+}
+
+HASH *
+savehash(stab)
+STAB *stab;
+{
+    register STR *str;
+
+    str = Str_new(11,0);
+    str->str_state = SS_SHASH;
+    str->str_u.str_stab = stab;
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_ptr = Nullch;
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)stab_hash(stab);
+    (void)apush(savestack,str); /* save hash ptr */
+    stab_xhash(stab) = Null(HASH*);
+    return stab_xhash(hadd(stab));
+}
+
+void
+saveitem(item)
+register STR *item;
+{
+    register STR *str;
+
+    (void)apush(savestack,item);		/* remember the pointer */
+    str = Str_new(12,0);
+    str_sset(str,item);
+    (void)apush(savestack,str);			/* remember the value */
+}
+
+void
+saveint(intp)
+int *intp;
+{
+    register STR *str;
+
+    str = Str_new(13,0);
+    str->str_state = SS_SINT;
+    str->str_u.str_useful = (long)*intp;	/* remember value */
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)intp;		/* remember pointer */
+    (void)apush(savestack,str);
+}
+
+void
+savelong(longp)
+long *longp;
+{
+    register STR *str;
+
+    str = Str_new(14,0);
+    str->str_state = SS_SLONG;
+    str->str_u.str_useful = *longp;		/* remember value */
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)longp;		/* remember pointer */
+    (void)apush(savestack,str);
+}
+
+void
+savesptr(sptr)
+STR **sptr;
+{
+    register STR *str;
+
+    str = Str_new(15,0);
+    str->str_state = SS_SSTRP;
+    str->str_magic = *sptr;		/* remember value */
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)sptr;		/* remember pointer */
+    (void)apush(savestack,str);
+}
+
+void
+savenostab(stab)
+STAB *stab;
+{
+    register STR *str;
+
+    str = Str_new(16,0);
+    str->str_state = SS_SNSTAB;
+    str->str_magic = (STR*)stab;	/* remember which stab to free */
+    (void)apush(savestack,str);
+}
+
+void
+savehptr(hptr)
+HASH **hptr;
+{
+    register STR *str;
+
+    str = Str_new(17,0);
+    str->str_state = SS_SHPTR;
+    str->str_u.str_hash = *hptr;	/* remember value */
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)hptr;		/* remember pointer */
+    (void)apush(savestack,str);
+}
+
+void
+saveaptr(aptr)
+ARRAY **aptr;
+{
+    register STR *str;
+
+    str = Str_new(17,0);
+    str->str_state = SS_SAPTR;
+    str->str_u.str_array = *aptr;	/* remember value */
+    if (str->str_ptr) {
+	Safefree(str->str_ptr);
+	str->str_len = 0;
+    }
+    str->str_ptr = (char*)aptr;		/* remember pointer */
+    (void)apush(savestack,str);
+}
+
+void
+savelist(sarg,maxsarg)
+register STR **sarg;
+int maxsarg;
+{
+    register STR *str;
+    register int i;
+
+    for (i = 1; i <= maxsarg; i++) {
+	(void)apush(savestack,sarg[i]);		/* remember the pointer */
+	str = Str_new(18,0);
+	str_sset(str,sarg[i]);
+	(void)apush(savestack,str);			/* remember the value */
+	sarg[i]->str_u.str_useful = -1;
+    }
+}
+
+void
+restorelist(base)
+int base;
+{
+    register STR *str;
+    register STR *value;
+    register STAB *stab;
+
+    if (base < -1)
+	fatal("panic: corrupt saved stack index");
+    while (savestack->ary_fill > base) {
+	value = apop(savestack);
+	switch (value->str_state) {
+	case SS_NORM:				/* normal string */
+	case SS_INCR:
+	    str = apop(savestack);
+	    str_replace(str,value);
+	    STABSET(str);
+	    break;
+	case SS_SARY:				/* array reference */
+	    stab = value->str_u.str_stab;
+	    afree(stab_xarray(stab));
+	    stab_xarray(stab) = (ARRAY*)value->str_ptr;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SHASH:				/* hash reference */
+	    stab = value->str_u.str_stab;
+	    (void)hfree(stab_xhash(stab), FALSE);
+	    stab_xhash(stab) = (HASH*)value->str_ptr;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SINT:				/* int reference */
+	    *((int*)value->str_ptr) = (int)value->str_u.str_useful;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SLONG:				/* long reference */
+	    *((long*)value->str_ptr) = value->str_u.str_useful;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SSTRP:				/* STR* reference */
+	    *((STR**)value->str_ptr) = value->str_magic;
+	    value->str_magic = Nullstr;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SHPTR:				/* HASH* reference */
+	    *((HASH**)value->str_ptr) = value->str_u.str_hash;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SAPTR:				/* ARRAY* reference */
+	    *((ARRAY**)value->str_ptr) = value->str_u.str_array;
+	    value->str_ptr = Nullch;
+	    str_free(value);
+	    break;
+	case SS_SNSTAB:
+	    stab = (STAB*)value->str_magic;
+	    value->str_magic = Nullstr;
+	    (void)stab_clear(stab);
+	    str_free(value);
+	    break;
+	case SS_SCSV:				/* callsave structure */
+	    {
+		CSV *csv = (CSV*) value->str_ptr;
+
+		curcmd = csv->curcmd;
+		curcsv = csv->curcsv;
+		csv->sub->depth = csv->depth;
+		if (csv->hasargs) {		/* put back old @_ */
+		    afree(csv->argarray);
+		    stab_xarray(defstab) = csv->savearray;
+		}
+		str_free(value);
+	    }
+	    break;
+	default:
+	    fatal("panic: restorelist inconsistency");
+	}
+    }
+}
+
+#ifdef DEBUGGING
+void
+grow_dlevel()
+{
+    dlmax += 128;
+    Renew(debname, dlmax, char);
+    Renew(debdelim, dlmax, char);
+}
+#endif
diff --git a/gnu/usr.bin/perl/perl/cmd.h b/gnu/usr.bin/perl/perl/cmd.h
new file mode 100644
index 000000000000..76ef5c8b58d9
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/cmd.h
@@ -0,0 +1,179 @@
+/* $RCSfile: cmd.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: cmd.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  12:01:02  lwall
+ * patch20: removed implicit int declarations on funcions
+ * 
+ * Revision 4.0.1.1  91/06/07  10:28:50  lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * 
+ * Revision 4.0  91/03/20  01:04:34  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define C_NULL 0
+#define C_IF 1
+#define C_ELSE 2
+#define C_WHILE 3
+#define C_BLOCK 4
+#define C_EXPR 5
+#define C_NEXT 6
+#define C_ELSIF 7	/* temporary--turns into an IF + ELSE */
+#define C_CSWITCH 8	/* created by switch optimization in block_head() */
+#define C_NSWITCH 9	/* likewise */
+
+#ifdef DEBUGGING
+#ifndef DOINIT
+extern char *cmdname[];
+#else
+char *cmdname[] = {
+    "NULL",
+    "IF",
+    "ELSE",
+    "WHILE",
+    "BLOCK",
+    "EXPR",
+    "NEXT",
+    "ELSIF",
+    "CSWITCH",
+    "NSWITCH",
+    "10"
+};
+#endif
+#endif /* DEBUGGING */
+
+#define CF_OPTIMIZE 077	/* type of optimization */
+#define CF_FIRSTNEG 0100/* conditional is ($register NE 'string') */
+#define CF_NESURE 0200	/* if short doesn't match we're sure */
+#define CF_EQSURE 0400	/* if short does match we're sure */
+#define CF_COND	01000	/* test c_expr as conditional first, if not null. */
+			/* Set for everything except do {} while currently */
+#define CF_LOOP 02000	/* loop on the c_expr conditional (loop modifiers) */
+#define CF_INVERT 04000	/* it's an "unless" or an "until" */
+#define CF_ONCE 010000	/* we've already pushed the label on the stack */
+#define CF_FLIP 020000	/* on a match do flipflop */
+#define CF_TERM 040000	/* value of this cmd might be returned */
+#define CF_DBSUB 0100000 /* this is an inserted cmd for debugging */
+
+#define CFT_FALSE 0	/* c_expr is always false */
+#define CFT_TRUE 1	/* c_expr is always true */
+#define CFT_REG 2	/* c_expr is a simple register */
+#define CFT_ANCHOR 3	/* c_expr is an anchored search /^.../ */
+#define CFT_STROP 4	/* c_expr is a string comparison */
+#define CFT_SCAN 5	/* c_expr is an unanchored search /.../ */
+#define CFT_GETS 6	/* c_expr is <filehandle> */
+#define CFT_EVAL 7	/* c_expr is not optimized, so call eval() */
+#define CFT_UNFLIP 8	/* 2nd half of range not optimized */
+#define CFT_CHOP 9	/* c_expr is a chop on a register */
+#define CFT_ARRAY 10	/* this is a foreach loop */
+#define CFT_INDGETS 11	/* c_expr is <$variable> */
+#define CFT_NUMOP 12	/* c_expr is a numeric comparison */
+#define CFT_CCLASS 13	/* c_expr must start with one of these characters */
+#define CFT_D0 14	/* no special breakpoint at this line */
+#define CFT_D1 15	/* possible special breakpoint at this line */
+
+#ifdef DEBUGGING
+#ifndef DOINIT
+extern char *cmdopt[];
+#else
+char *cmdopt[] = {
+    "FALSE",
+    "TRUE",
+    "REG",
+    "ANCHOR",
+    "STROP",
+    "SCAN",
+    "GETS",
+    "EVAL",
+    "UNFLIP",
+    "CHOP",
+    "ARRAY",
+    "INDGETS",
+    "NUMOP",
+    "CCLASS",
+    "14"
+};
+#endif
+#endif /* DEBUGGING */
+
+struct acmd {
+    STAB	*ac_stab;	/* a symbol table entry */
+    ARG		*ac_expr;	/* any associated expression */
+};
+
+struct ccmd {
+    CMD		*cc_true;	/* normal code to do on if and while */
+    CMD		*cc_alt;	/* else cmd ptr or continue code */
+};
+
+struct scmd {
+    CMD		**sc_next;	/* array of pointers to commands */
+    short	sc_offset;	/* first value - 1 */
+    short	sc_max;		/* last value + 1 */
+};
+
+struct cmd {
+    CMD		*c_next;	/* the next command at this level */
+    ARG		*c_expr;	/* conditional expression */
+    CMD		*c_head;	/* head of this command list */
+    STR		*c_short;	/* string to match as shortcut */
+    STAB	*c_stab;	/* a symbol table entry, mostly for fp */
+    SPAT	*c_spat;	/* pattern used by optimization */
+    char	*c_label;	/* label for this construct */
+    union ucmd {
+	struct acmd acmd;	/* normal command */
+	struct ccmd ccmd;	/* compound command */
+	struct scmd scmd;	/* switch command */
+    } ucmd;
+    short	c_slen;		/* len of c_short, if not null */
+    VOLATILE short c_flags;	/* optimization flags--see above */
+    HASH	*c_stash;	/* package line was compiled in */
+    STAB	*c_filestab;	/* file the following line # is from */
+    line_t      c_line;         /* line # of this command */
+    char	c_type;		/* what this command does */
+};
+
+#define Nullcmd Null(CMD*)
+#define Nullcsv Null(CSV*)
+
+EXT CMD * VOLATILE main_root INIT(Nullcmd);
+EXT CMD * VOLATILE eval_root INIT(Nullcmd);
+
+EXT CMD compiling;
+EXT CMD * VOLATILE curcmd INIT(&compiling);
+EXT CSV * VOLATILE curcsv INIT(Nullcsv);
+
+struct callsave {
+    SUBR *sub;
+    STAB *stab;
+    CSV *curcsv;
+    CMD *curcmd;
+    ARRAY *savearray;
+    ARRAY *argarray;
+    long depth;
+    int wantarray;
+    char hasargs;
+};
+
+struct compcmd {
+    CMD *comp_true;
+    CMD *comp_alt;
+};
+
+void opt_arg();
+ARG* evalstatic();
+int cmd_exec();
+#ifdef DEBUGGING
+void deb();
+#endif
+int copyopt();
diff --git a/gnu/usr.bin/perl/perl/config.H b/gnu/usr.bin/perl/perl/config.H
new file mode 100644
index 000000000000..21f635f82a94
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/config.H
@@ -0,0 +1,892 @@
+#ifndef config_h
+#define config_h
+/* config.h
+ * 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.
+ */
+ /*SUPPRESS 460*/
+
+
+/* EUNICE
+ *	This symbol, if defined, indicates that the program is being compiled
+ *	under the EUNICE package under VMS.  The program will need to handle
+ *	things like files that don't go away the first time you unlink them,
+ *	due to version numbering.  It will also need to compensate for lack
+ *	of a respectable link() command.
+ */
+/* VMS
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+/*#undef	EUNICE		/**/
+/*#undef	VMS		/**/
+
+/* LOC_SED
+ *     This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED "/bin/sed"             /**/
+
+/* ALIGN_BYTES
+ *	This symbol contains the number of bytes required to align a double.
+ *	Usual values are 2, 4, and 8.
+ */
+#define ALIGN_BYTES 8		/**/
+
+/* BIN
+ *	This symbol holds the name of the directory in which the user wants
+ *	to keep publicly executable images for the package in question.  It
+ *	is most often a local directory such as /usr/local/bin.
+ */
+#define BIN "/usr/local/bin"             /**/
+
+/* BYTEORDER
+ *	This symbol contains an encoding of the order of bytes in a long.
+ *	Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412...
+ */
+#define BYTEORDER 0x4321		/**/
+
+/* 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".
+ */
+/* 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 "/usr/lib/cpp"
+#define CPPMINUS ""
+
+/* HAS_BCMP
+ *	This symbol, if defined, indicates that the bcmp routine is available
+ *	to compare blocks of memory.  If undefined, use memcmp.  If that's
+ *	not available, roll your own.
+ */
+#define	HAS_BCMP		/**/
+
+/* HAS_BCOPY
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy blocks of memory.  Otherwise you should probably use memcpy().
+ *	If neither is defined, roll your own.
+ */
+/* SAFE_BCOPY
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping copy blocks of bcopy.  Otherwise you
+ *	should probably use memmove() or memcpy().  If neither is defined,
+ *	roll your own.
+ */
+#define	HAS_BCOPY		/**/
+#define	SAFE_BCOPY		/**/
+
+/* HAS_BZERO
+ *	This symbol, if defined, indicates that the bzero routine is available
+ *	to zero blocks of memory.  Otherwise you should probably use memset()
+ *	or roll your own.
+ */
+#define	HAS_BZERO		/**/
+
+/* CASTNEGFLOAT
+ *	This symbol, if defined, indicates that this C compiler knows how to
+ *	cast negative or large floating point 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:
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ */
+#define	CASTNEGFLOAT	/**/
+#define	CASTFLAGS 0	/**/
+
+/* CHARSPRINTF
+ *	This symbol is defined if this system declares "char *sprintf()" in
+ *	stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
+ *	is up to the package author to declare sprintf correctly based on the
+ *	symbol.
+ */
+#define	CHARSPRINTF 	/**/
+
+/* 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		/**/
+
+/* HAS_CRYPT
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
+ */
+#define	HAS_CRYPT		/**/
+
+/* CSH
+ *	This symbol, if defined, indicates that the C-shell exists.
+ *	If defined, contains the full pathname of csh.
+ */
+#define CSH "/bin/csh"		/**/
+
+/* 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 DOSUID		/**/
+
+/* HAS_DUP2
+ *	This symbol, if defined, indicates that the dup2 routine is available
+ *	to dup file descriptors.  Otherwise you should use dup().
+ */
+#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		/**/
+
+/* 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_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_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.
+ */
+/*#undef	HAS_GETPGRP2		/**/
+
+/* HAS_GETPRIORITY
+ *	This symbol, if defined, indicates that the getpriority() routine is
+ *	available to get a process's priority.
+ */
+#define	HAS_GETPRIORITY		/**/
+
+/* HAS_HTONS
+ *	This symbol, if defined, indicates that the htons routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_HTONL
+ *	This symbol, if defined, indicates that the htonl routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_NTOHS
+ *	This symbol, if defined, indicates that the ntohs routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_NTOHL
+ *	This symbol, if defined, indicates that the ntohl routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+#define	HAS_HTONS	/**/
+#define	HAS_HTONL	/**/
+#define	HAS_NTOHS	/**/
+#define	HAS_NTOHL	/**/
+
+/* index
+ *	This preprocessor symbol is defined, along with rindex, if the system
+ *	uses the strchr and strrchr routines instead.
+ */
+/* rindex
+ *	This preprocessor symbol is defined, along with index, if the system
+ *	uses the strchr and strrchr routines instead.
+ */
+/*#undef	index strchr	/* cultural */
+/*#undef	rindex strrchr	/*  differences? */
+
+/* HAS_ISASCII
+ *	This symbol, if defined, indicates that the isascii routine is available
+ *	to test characters for asciiness.
+ */
+#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_LSTAT
+ *	This symbol, if defined, indicates that the lstat() routine is
+ *	available to stat symbolic links.
+ */
+#define	HAS_LSTAT		/**/
+
+/* HAS_MEMCMP
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	to compare blocks of memory.  If undefined, roll your own.
+ */
+#define	HAS_MEMCMP		/**/
+
+/* HAS_MEMCPY
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy blocks of memory.  Otherwise you should probably use bcopy().
+ *	If neither is defined, roll your own.
+ */
+/* SAFE_MEMCPY
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping copy blocks of memory.  Otherwise you
+ *	should probably use memmove() or bcopy().  If neither is defined,
+ *	roll your own.
+ */
+#define	HAS_MEMCPY		/**/
+/*#undef	SAFE_MEMCPY		/**/
+
+/* HAS_MEMMOVE
+ *	This symbol, if defined, indicates that the memmove routine is available
+ *	to move potentially overlapping blocks of memory.  Otherwise you
+ *	should use bcopy() or roll your own.
+ */
+/*#undef	HAS_MEMMOVE		/**/
+
+/* HAS_MEMSET
+ *	This symbol, if defined, indicates that the memset routine is available
+ *	to set a block of memory to a character.  If undefined, roll your own.
+ */
+#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.
+ */
+#define	HAS_MSG		/**/
+
+/* HAS_MSGCTL
+ *	This symbol, if defined, indicates that the msgctl() routine is
+ *	available to control message passing.
+ */
+#define	HAS_MSGCTL		/**/
+
+/* HAS_MSGGET
+ *	This symbol, if defined, indicates that the msgget() routine is
+ *	available to get messages.
+ */
+#define	HAS_MSGGET		/**/
+
+/* HAS_MSGRCV
+ *	This symbol, if defined, indicates that the msgrcv() routine is
+ *	available to receive messages.
+ */
+#define	HAS_MSGRCV		/**/
+
+/* HAS_MSGSND
+ *	This symbol, if defined, indicates that the msgsnd() routine is
+ *	available to send messages.
+ */
+#define	HAS_MSGSND		/**/
+
+/* HAS_NDBM
+ *	This symbol, if defined, indicates that ndbm.h exists and should
+ *	be included.
+ */
+#define	HAS_NDBM		/**/
+
+/* HAS_ODBM
+ *	This symbol, if defined, indicates that dbm.h exists and should
+ *	be included.
+ */
+#define	HAS_ODBM		/**/
+
+/* HAS_OPEN3
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+#define	HAS_OPEN3		/**/
+
+/* HAS_READDIR
+ *	This symbol, if defined, indicates that the readdir routine is available
+ *	from the C library to read directories.
+ */
+#define	HAS_READDIR		/**/
+
+/* 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_REWINDDIR
+ *	This symbol, if defined, indicates that the rewindir routine is
+ *	available to rewind directories.
+ */
+#define	HAS_REWINDDIR		/**/
+
+/* 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_SEEKDIR
+ *	This symbol, if defined, indicates that the seekdir routine is
+ *	available to seek into directories.
+ */
+#define	HAS_SEEKDIR		/**/
+
+/* HAS_SELECT
+ *	This symbol, if defined, indicates that the select() subroutine
+ *	exists.
+ */
+#define	HAS_SELECT	/**/
+
+/* HAS_SEM
+ *	This symbol, if defined, indicates that the entire sem*(2) library is
+ *	supported.
+ */
+#define	HAS_SEM		/**/
+
+/* HAS_SEMCTL
+ *	This symbol, if defined, indicates that the semctl() routine is
+ *	available to control semaphores.
+ */
+#define	HAS_SEMCTL		/**/
+
+/* HAS_SEMGET
+ *	This symbol, if defined, indicates that the semget() routine is
+ *	available to get semaphores ids.
+ */
+#define	HAS_SEMGET		/**/
+
+/* HAS_SEMOP
+ *	This symbol, if defined, indicates that the semop() routine is
+ *	available to perform semaphore operations.
+ */
+#define	HAS_SEMOP		/**/
+
+/* 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_SETPGRP
+ *	This symbol, if defined, indicates that the setpgrp() routine is
+ *	available to set the current process group.
+ */
+#define	HAS_SETPGRP		/**/
+
+/* 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.
+ */
+#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 program.
+ */
+/* HAS_SETRESGID
+ *	This symbol, if defined, indicates that the setresgid routine is
+ *	available to change the real, effective and saved gid of the current
+ *	program.
+ */
+#define	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 program.
+ */
+/* HAS_SETRESUID
+ *	This symbol, if defined, indicates that the setresuid routine is
+ *	available to change the real, effective and saved uid of the current
+ *	program.
+ */
+#define	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.
+ */
+#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_SHM
+ *	This symbol, if defined, indicates that the entire shm*(2) library is
+ *	supported.
+ */
+#define	HAS_SHM		/**/
+
+/* HAS_SHMAT
+ *	This symbol, if defined, indicates that the shmat() routine is
+ *	available to attach a shared memory segment.
+ */
+/* VOID_SHMAT
+ *	This symbol, if defined, indicates that the shmat() routine
+ *	returns a pointer of type void*.
+ */
+#define	HAS_SHMAT		/**/
+
+/*#undef	VOIDSHMAT		/**/
+
+/* HAS_SHMCTL
+ *	This symbol, if defined, indicates that the shmctl() routine is
+ *	available to control a shared memory segment.
+ */
+#define	HAS_SHMCTL		/**/
+
+/* HAS_SHMDT
+ *	This symbol, if defined, indicates that the shmdt() routine is
+ *	available to detach a shared memory segment.
+ */
+#define	HAS_SHMDT		/**/
+
+/* HAS_SHMGET
+ *	This symbol, if defined, indicates that the shmget() routine is
+ *	available to get a shared memory segment id.
+ */
+#define	HAS_SHMGET		/**/
+
+/* 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.
+ */
+/* OLDSOCKET
+ *	This symbol, if defined, indicates that the 4.1c BSD socket interface
+ *	is supported instead of the 4.2/4.3 BSD socket interface.
+ */
+#define	HAS_SOCKET		/**/
+
+#define	HAS_SOCKETPAIR	/**/
+
+/*#undef	OLDSOCKET	/**/
+
+/* STATBLOCKS
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_blksize and st_blocks.
+ */
+#define	STATBLOCKS 	/**/
+
+/* STDSTDIO
+ *	This symbol is defined if this system has a FILE structure declaring
+ *	_ptr and _cnt in stdio.h.
+ */
+#define	STDSTDIO 	/**/
+
+/* STRUCTCOPY
+ *	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	STRUCTCOPY	/**/
+
+/* HAS_STRERROR
+ *	This symbol, if defined, indicates that the strerror() routine is
+ *	available to translate error numbers to strings.
+ */
+/*#undef	HAS_STRERROR		/**/
+
+/* 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_TELLDIR
+ *	This symbol, if defined, indicates that the telldir routine is
+ *	available to tell your location in directories.
+ */
+#define	HAS_TELLDIR		/**/
+
+/* HAS_TRUNCATE
+ *	This symbol, if defined, indicates that the truncate routine is
+ *	available to truncate files.
+ */
+#define	HAS_TRUNCATE		/**/
+
+/* HAS_VFORK
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+#define	HAS_VFORK	/**/
+
+/* VOIDSIG
+ *	This symbol is defined if this system declares "void (*signal())()" in
+ *	signal.h.  The old way was to declare it as "int (*signal())()".  It
+ *	is up to the package author to declare things correctly based on the
+ *	symbol.
+ */
+/* TO_SIGNAL
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return "type" of a signal handler.  Thus, one can declare
+ *	a signal handler using "TO_SIGNAL (*handler())()", and define the
+ *	handler using "TO_SIGNAL handler(sig)".
+ */
+#define	VOIDSIG 	/**/
+#define	TO_SIGNAL	int 	/**/
+
+/* HASVOLATILE
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+/*#undef	HASVOLATILE	/**/
+
+/* 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().
+ */
+/* CHARVSPRINTF
+ *	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	CHARVSPRINTF 	/**/
+
+/* HAS_WAIT4
+ *	This symbol, if defined, indicates that wait4() exists.
+ */
+#define	HAS_WAIT4	/**/
+
+/* HAS_WAITPID
+ *	This symbol, if defined, indicates that waitpid() exists.
+ */
+#define	HAS_WAITPID	/**/
+
+/* GIDTYPE
+ *	This symbol has a value like gid_t, int, ushort, or whatever type is
+ *	used to declare group ids in the kernel.
+ */
+#define GIDTYPE gid_t		/**/
+
+/* GROUPSTYPE
+ *	This symbol has a value like gid_t, int, ushort, or whatever type is
+ *	used in the return value of getgroups().
+ */
+#define GROUPSTYPE int		/**/
+
+/* I_FCNTL
+ *	This manifest constant tells the C program to include <fcntl.h>.
+ */
+/*#undef	I_FCNTL	/**/
+
+/* I_GDBM
+ *	This symbol, if defined, indicates that gdbm.h exists and should
+ *	be included.
+ */
+/*#undef	I_GDBM		/**/
+
+/* I_GRP
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include grp.h.
+ */
+#define	I_GRP		/**/
+
+/* I_NETINET_IN
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include netinet/in.h.
+ */
+/* I_SYS_IN
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include sys/in.h.
+ */
+#define	I_NETINET_IN		/**/
+/*#undef	I_SYS_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		/**/
+/*#undef	PWQUOTA		/**/
+#define	PWAGE		/**/
+/*#undef	PWCHANGE	/**/
+/*#undef	PWCLASS		/**/
+/*#undef	PWEXPIRE	/**/
+#define	PWCOMMENT	/**/
+
+/* I_SYS_FILE
+ *	This manifest constant tells the C program to include <sys/file.h>.
+ */
+#define	I_SYS_FILE	/**/
+
+/* I_SYSIOCTL
+ *	This symbol, if defined, indicates that sys/ioctl.h exists and should
+ *	be included.
+ */
+#define	I_SYSIOCTL		/**/
+
+/* I_TIME
+ *	This symbol is defined if the program should include <time.h>.
+ */
+/* I_SYS_TIME
+ *	This symbol is defined if the program should include <sys/time.h>.
+ */
+/* SYSTIMEKERNEL
+ *	This symbol is defined if the program should include <sys/time.h>
+ *	with KERNEL defined.
+ */
+/* I_SYS_SELECT
+ *	This symbol is defined if the program should include <sys/select.h>.
+ */
+/*#undef	I_TIME	 	/**/
+#define	I_SYS_TIME 	/**/
+/*#undef	SYSTIMEKERNEL 	/**/
+/*#undef	I_SYS_SELECT 	/**/
+
+/* I_UTIME
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include utime.h.
+ */
+#define	I_UTIME		/**/
+
+/* I_VARARGS
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include varargs.h.
+ */
+#define	I_VARARGS		/**/
+
+/* I_VFORK
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include vfork.h.
+ */
+#define	I_VFORK		/**/
+
+/* INTSIZE
+ *	This symbol contains the size of an int, so that the C preprocessor
+ *	can make decisions based on it.
+ */
+#define INTSIZE 4		/**/
+
+/* I_DIRENT
+ *	This symbol, if defined, indicates that the program should use the
+ *	P1003-style directory routines, and include <dirent.h>.
+ */
+/* I_SYS_DIR
+ *	This symbol, if defined, indicates that the program should use the
+ *	directory functions by including <sys/dir.h>.
+ */
+/* I_NDIR
+ *	This symbol, if defined, indicates that the program should include the
+ *	system's version of ndir.h, rather than the one with this package.
+ */
+/* I_SYS_NDIR
+ *	This symbol, if defined, indicates that the program should include the
+ *	system's version of sys/ndir.h, rather than the one with this package.
+ */
+/* I_MY_DIR
+ *	This symbol, if defined, indicates that the program should compile
+ *	the ndir.c code provided with the package.
+ */
+/* 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.
+ */
+#define	I_DIRENT	/**/
+/*#undef	I_SYS_DIR	/**/
+/*#undef	I_NDIR		/**/
+/*#undef	I_SYS_NDIR	/**/
+/*#undef	I_MY_DIR	/**/
+/*#undef	DIRNAMLEN	/**/
+
+/* MYMALLOC
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+/* MALLOCPTRTYPE
+ *	This symbol defines the kind of ptr returned by malloc and realloc.
+ */
+#define MYMALLOC			/**/
+
+#define MALLOCPTRTYPE char         /**/
+
+
+/* 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		/**/
+
+/* SCRIPTDIR
+ *	This symbol holds the name of the directory in which the user wants
+ *	to keep publicly executable scripts for the package in question.  It
+ *	is often a directory that is mounted across diverse architectures.
+ */
+#define SCRIPTDIR "/usr/local/bin"             /**/
+
+/* SIG_NAME
+ *	This symbol contains an list of signal names in order.
+ */
+#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2"		/**/
+
+/* 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	/**/
+
+/* UIDTYPE
+ *	This symbol has a value like uid_t, int, ushort, or whatever type is
+ *	used to declare user ids in the kernel.
+ */
+#define UIDTYPE uid_t		/**/
+
+/* VOIDHAVE
+ *	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
+ *
+ *	The package designer should define VOIDWANT to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDWANT before
+ *	including config.h, or by defining voidwant in Myinit.U.  If the level
+ *	of void support necessary is not present, config.h defines void to "int",
+ *	VOID to the empty string, and VOIDP to "char *".
+ */
+/* void
+ *	This symbol is used for void casts.  On implementations which support
+ *	void appropriately, its value is "void".  Otherwise, its value maps
+ *	to "int".
+ */
+/* VOID
+ *	This symbol's value is "void" if the implementation supports void
+ *	appropriately.  Otherwise, its value is the empty string.  The primary
+ *	use of this symbol is in specifying void parameter lists for function
+ *	prototypes.
+ */
+/* VOIDP
+ *	This symbol is used for casting generic pointers.  On implementations
+ *	which support void appropriately, its value is "void *".  Otherwise,
+ *	its value is "char *".
+ */
+#ifndef VOIDWANT
+#define VOIDWANT 7
+#endif
+#define VOIDHAVE 7
+#if (VOIDHAVE & VOIDWANT) != VOIDWANT
+#define void int		/* is void to be avoided? */
+#define VOID
+#define VOIDP (char *)
+#define M_VOID		/* Xenix strikes again */
+#else
+#define VOID void
+#define VOIDP (void *)
+#endif
+
+/* PRIVLIB
+ *	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 "/usr/local/lib/perl"		/**/
+
+#endif
diff --git a/gnu/usr.bin/perl/perl/config.h b/gnu/usr.bin/perl/perl/config.h
new file mode 100644
index 000000000000..43cc08fac2e2
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/config.h
@@ -0,0 +1,892 @@
+#ifndef config_h
+#define config_h
+/* config.h
+ * 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.
+ */
+ /*SUPPRESS 460*/
+
+
+/* EUNICE
+ *	This symbol, if defined, indicates that the program is being compiled
+ *	under the EUNICE package under VMS.  The program will need to handle
+ *	things like files that don't go away the first time you unlink them,
+ *	due to version numbering.  It will also need to compensate for lack
+ *	of a respectable link() command.
+ */
+/* VMS
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+/*#undef	EUNICE		/**/
+/*#undef	VMS		/**/
+
+/* LOC_SED
+ *     This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED "/usr/bin/sed"             /**/
+
+/* ALIGN_BYTES
+ *	This symbol contains the number of bytes required to align a double.
+ *	Usual values are 2, 4, and 8.
+ */
+#define ALIGN_BYTES 4		/**/
+
+/* BIN
+ *	This symbol holds the name of the directory in which the user wants
+ *	to keep publicly executable images for the package in question.  It
+ *	is most often a local directory such as /usr/local/bin.
+ */
+#define BIN "/usr/local/bin"             /**/
+
+/* BYTEORDER
+ *	This symbol contains an encoding of the order of bytes in a long.
+ *	Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412...
+ */
+#define BYTEORDER 0x1234		/**/
+
+/* 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".
+ */
+/* 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_BCMP
+ *	This symbol, if defined, indicates that the bcmp routine is available
+ *	to compare blocks of memory.  If undefined, use memcmp.  If that's
+ *	not available, roll your own.
+ */
+#define	HAS_BCMP		/**/
+
+/* HAS_BCOPY
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy blocks of memory.  Otherwise you should probably use memcpy().
+ *	If neither is defined, roll your own.
+ */
+/* SAFE_BCOPY
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping copy blocks of bcopy.  Otherwise you
+ *	should probably use memmove() or memcpy().  If neither is defined,
+ *	roll your own.
+ */
+#define	HAS_BCOPY		/**/
+#define	SAFE_BCOPY		/**/
+
+/* HAS_BZERO
+ *	This symbol, if defined, indicates that the bzero routine is available
+ *	to zero blocks of memory.  Otherwise you should probably use memset()
+ *	or roll your own.
+ */
+#define	HAS_BZERO		/**/
+
+/* CASTNEGFLOAT
+ *	This symbol, if defined, indicates that this C compiler knows how to
+ *	cast negative or large floating point 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:
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ */
+#define	CASTNEGFLOAT	/**/
+#define	CASTFLAGS 0	/**/
+
+/* CHARSPRINTF
+ *	This symbol is defined if this system declares "char *sprintf()" in
+ *	stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
+ *	is up to the package author to declare sprintf correctly based on the
+ *	symbol.
+ */
+/*#undef	CHARSPRINTF 	/**/
+
+/* 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		/**/
+
+/* HAS_CRYPT
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
+ */
+#define	HAS_CRYPT		/**/
+
+/* CSH
+ *	This symbol, if defined, indicates that the C-shell exists.
+ *	If defined, contains the full pathname of csh.
+ */
+#define CSH "/bin/csh"		/**/
+
+/* 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 DOSUID		/**/
+
+/* HAS_DUP2
+ *	This symbol, if defined, indicates that the dup2 routine is available
+ *	to dup file descriptors.  Otherwise you should use dup().
+ */
+#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		/**/
+
+/* 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_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.
+ */
+/*#undef	HAS_GETHOSTENT		/**/
+
+/* 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.
+ */
+/*#undef	HAS_GETPGRP2		/**/
+
+/* HAS_GETPRIORITY
+ *	This symbol, if defined, indicates that the getpriority() routine is
+ *	available to get a process's priority.
+ */
+#define	HAS_GETPRIORITY		/**/
+
+/* HAS_HTONS
+ *	This symbol, if defined, indicates that the htons routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_HTONL
+ *	This symbol, if defined, indicates that the htonl routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_NTOHS
+ *	This symbol, if defined, indicates that the ntohs routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+/* HAS_NTOHL
+ *	This symbol, if defined, indicates that the ntohl routine (and friends)
+ *	are available to do network order byte swapping.
+ */
+#define	HAS_HTONS	/**/
+#define	HAS_HTONL	/**/
+#define	HAS_NTOHS	/**/
+#define	HAS_NTOHL	/**/
+
+/* index
+ *	This preprocessor symbol is defined, along with rindex, if the system
+ *	uses the strchr and strrchr routines instead.
+ */
+/* rindex
+ *	This preprocessor symbol is defined, along with index, if the system
+ *	uses the strchr and strrchr routines instead.
+ */
+/*#undef	index strchr	/* cultural */
+/*#undef	rindex strrchr	/*  differences? */
+
+/* HAS_ISASCII
+ *	This symbol, if defined, indicates that the isascii routine is available
+ *	to test characters for asciiness.
+ */
+#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_LSTAT
+ *	This symbol, if defined, indicates that the lstat() routine is
+ *	available to stat symbolic links.
+ */
+#define	HAS_LSTAT		/**/
+
+/* HAS_MEMCMP
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	to compare blocks of memory.  If undefined, roll your own.
+ */
+#define	HAS_MEMCMP		/**/
+
+/* HAS_MEMCPY
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy blocks of memory.  Otherwise you should probably use bcopy().
+ *	If neither is defined, roll your own.
+ */
+/* SAFE_MEMCPY
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping copy blocks of memory.  Otherwise you
+ *	should probably use memmove() or bcopy().  If neither is defined,
+ *	roll your own.
+ */
+#define	HAS_MEMCPY		/**/
+#define	SAFE_MEMCPY		/**/
+
+/* HAS_MEMMOVE
+ *	This symbol, if defined, indicates that the memmove routine is available
+ *	to move potentially overlapping blocks of memory.  Otherwise you
+ *	should use bcopy() or roll your own.
+ */
+#define	HAS_MEMMOVE		/**/
+
+/* HAS_MEMSET
+ *	This symbol, if defined, indicates that the memset routine is available
+ *	to set a block of memory to a character.  If undefined, roll your own.
+ */
+#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.
+ */
+/*#undef	HAS_MSG		/**/
+
+/* HAS_MSGCTL
+ *	This symbol, if defined, indicates that the msgctl() routine is
+ *	available to control message passing.
+ */
+/*#undef	HAS_MSGCTL		/**/
+
+/* HAS_MSGGET
+ *	This symbol, if defined, indicates that the msgget() routine is
+ *	available to get messages.
+ */
+/*#undef	HAS_MSGGET		/**/
+
+/* HAS_MSGRCV
+ *	This symbol, if defined, indicates that the msgrcv() routine is
+ *	available to receive messages.
+ */
+/*#undef	HAS_MSGRCV		/**/
+
+/* HAS_MSGSND
+ *	This symbol, if defined, indicates that the msgsnd() routine is
+ *	available to send messages.
+ */
+/*#undef	HAS_MSGSND		/**/
+
+/* HAS_NDBM
+ *	This symbol, if defined, indicates that ndbm.h exists and should
+ *	be included.
+ */
+#define	HAS_NDBM		/**/
+
+/* HAS_ODBM
+ *	This symbol, if defined, indicates that dbm.h exists and should
+ *	be included.
+ */
+/*#undef	HAS_ODBM		/**/
+
+/* HAS_OPEN3
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+#define	HAS_OPEN3		/**/
+
+/* HAS_READDIR
+ *	This symbol, if defined, indicates that the readdir routine is available
+ *	from the C library to read directories.
+ */
+#define	HAS_READDIR		/**/
+
+/* 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_REWINDDIR
+ *	This symbol, if defined, indicates that the rewindir routine is
+ *	available to rewind directories.
+ */
+#define	HAS_REWINDDIR		/**/
+
+/* 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_SEEKDIR
+ *	This symbol, if defined, indicates that the seekdir routine is
+ *	available to seek into directories.
+ */
+#define	HAS_SEEKDIR		/**/
+
+/* HAS_SELECT
+ *	This symbol, if defined, indicates that the select() subroutine
+ *	exists.
+ */
+#define	HAS_SELECT	/**/
+
+/* HAS_SEM
+ *	This symbol, if defined, indicates that the entire sem*(2) library is
+ *	supported.
+ */
+/*#undef	HAS_SEM		/**/
+
+/* HAS_SEMCTL
+ *	This symbol, if defined, indicates that the semctl() routine is
+ *	available to control semaphores.
+ */
+/*#undef	HAS_SEMCTL		/**/
+
+/* HAS_SEMGET
+ *	This symbol, if defined, indicates that the semget() routine is
+ *	available to get semaphores ids.
+ */
+/*#undef	HAS_SEMGET		/**/
+
+/* HAS_SEMOP
+ *	This symbol, if defined, indicates that the semop() routine is
+ *	available to perform semaphore operations.
+ */
+/*#undef	HAS_SEMOP		/**/
+
+/* 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_SETPGRP
+ *	This symbol, if defined, indicates that the setpgrp() routine is
+ *	available to set the current process group.
+ */
+#define	HAS_SETPGRP		/**/
+
+/* 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.
+ */
+#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 program.
+ */
+/* HAS_SETRESGID
+ *	This symbol, if defined, indicates that the setresgid routine is
+ *	available to change the real, effective and saved gid of the current
+ *	program.
+ */
+#define	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 program.
+ */
+/* HAS_SETRESUID
+ *	This symbol, if defined, indicates that the setresuid routine is
+ *	available to change the real, effective and saved uid of the current
+ *	program.
+ */
+#define	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.
+ */
+#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_SHM
+ *	This symbol, if defined, indicates that the entire shm*(2) library is
+ *	supported.
+ */
+/*#undef	HAS_SHM		/**/
+
+/* HAS_SHMAT
+ *	This symbol, if defined, indicates that the shmat() routine is
+ *	available to attach a shared memory segment.
+ */
+/* VOID_SHMAT
+ *	This symbol, if defined, indicates that the shmat() routine
+ *	returns a pointer of type void*.
+ */
+/*#undef	HAS_SHMAT		/**/
+
+/*#undef	VOIDSHMAT		/**/
+
+/* HAS_SHMCTL
+ *	This symbol, if defined, indicates that the shmctl() routine is
+ *	available to control a shared memory segment.
+ */
+/*#undef	HAS_SHMCTL		/**/
+
+/* HAS_SHMDT
+ *	This symbol, if defined, indicates that the shmdt() routine is
+ *	available to detach a shared memory segment.
+ */
+/*#undef	HAS_SHMDT		/**/
+
+/* HAS_SHMGET
+ *	This symbol, if defined, indicates that the shmget() routine is
+ *	available to get a shared memory segment id.
+ */
+/*#undef	HAS_SHMGET		/**/
+
+/* 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.
+ */
+/* OLDSOCKET
+ *	This symbol, if defined, indicates that the 4.1c BSD socket interface
+ *	is supported instead of the 4.2/4.3 BSD socket interface.
+ */
+#define	HAS_SOCKET		/**/
+
+#define	HAS_SOCKETPAIR	/**/
+
+/*#undef	OLDSOCKET	/**/
+
+/* STATBLOCKS
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_blksize and st_blocks.
+ */
+#define	STATBLOCKS 	/**/
+
+/* STDSTDIO
+ *	This symbol is defined if this system has a FILE structure declaring
+ *	_ptr and _cnt in stdio.h.
+ */
+/*#undef	STDSTDIO 	/**/
+
+/* STRUCTCOPY
+ *	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	STRUCTCOPY	/**/
+
+/* HAS_STRERROR
+ *	This symbol, if defined, indicates that the strerror() routine is
+ *	available to translate error numbers to strings.
+ */
+#define	HAS_STRERROR		/**/
+
+/* 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_TELLDIR
+ *	This symbol, if defined, indicates that the telldir routine is
+ *	available to tell your location in directories.
+ */
+#define	HAS_TELLDIR		/**/
+
+/* HAS_TRUNCATE
+ *	This symbol, if defined, indicates that the truncate routine is
+ *	available to truncate files.
+ */
+#define	HAS_TRUNCATE		/**/
+
+/* HAS_VFORK
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+#define	HAS_VFORK	/**/
+
+/* VOIDSIG
+ *	This symbol is defined if this system declares "void (*signal())()" in
+ *	signal.h.  The old way was to declare it as "int (*signal())()".  It
+ *	is up to the package author to declare things correctly based on the
+ *	symbol.
+ */
+/* TO_SIGNAL
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return "type" of a signal handler.  Thus, one can declare
+ *	a signal handler using "TO_SIGNAL (*handler())()", and define the
+ *	handler using "TO_SIGNAL handler(sig)".
+ */
+#define	VOIDSIG 	/**/
+#define	TO_SIGNAL	int 	/**/
+
+/* HASVOLATILE
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+
+/* 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().
+ */
+/* CHARVSPRINTF
+ *	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	CHARVSPRINTF 	/**/
+
+/* HAS_WAIT4
+ *	This symbol, if defined, indicates that wait4() exists.
+ */
+#define	HAS_WAIT4	/**/
+
+/* HAS_WAITPID
+ *	This symbol, if defined, indicates that waitpid() exists.
+ */
+#define	HAS_WAITPID	/**/
+
+/* GIDTYPE
+ *	This symbol has a value like gid_t, int, ushort, or whatever type is
+ *	used to declare group ids in the kernel.
+ */
+#define GIDTYPE gid_t		/**/
+
+/* GROUPSTYPE
+ *	This symbol has a value like gid_t, int, ushort, or whatever type is
+ *	used in the return value of getgroups().
+ */
+#define GROUPSTYPE int		/**/
+
+/* I_FCNTL
+ *	This manifest constant tells the C program to include <fcntl.h>.
+ */
+/*#undef	I_FCNTL	/**/
+
+/* I_GDBM
+ *	This symbol, if defined, indicates that gdbm.h exists and should
+ *	be included.
+ */
+/*#undef	I_GDBM		/**/
+
+/* I_GRP
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include grp.h.
+ */
+#define	I_GRP		/**/
+
+/* I_NETINET_IN
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include netinet/in.h.
+ */
+/* I_SYS_IN
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include sys/in.h.
+ */
+#define	I_NETINET_IN		/**/
+/*#undef	I_SYS_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		/**/
+/*#undef	PWQUOTA		/**/
+/*#undef	PWAGE		/**/
+#define	PWCHANGE	/**/
+#define	PWCLASS		/**/
+#define	PWEXPIRE	/**/
+/*#undef	PWCOMMENT	/**/
+
+/* I_SYS_FILE
+ *	This manifest constant tells the C program to include <sys/file.h>.
+ */
+#define	I_SYS_FILE	/**/
+
+/* I_SYSIOCTL
+ *	This symbol, if defined, indicates that sys/ioctl.h exists and should
+ *	be included.
+ */
+#define	I_SYSIOCTL		/**/
+
+/* I_TIME
+ *	This symbol is defined if the program should include <time.h>.
+ */
+/* I_SYS_TIME
+ *	This symbol is defined if the program should include <sys/time.h>.
+ */
+/* SYSTIMEKERNEL
+ *	This symbol is defined if the program should include <sys/time.h>
+ *	with KERNEL defined.
+ */
+/* I_SYS_SELECT
+ *	This symbol is defined if the program should include <sys/select.h>.
+ */
+/*#undef	I_TIME	 	/**/
+#define	I_SYS_TIME 	/**/
+/*#undef	SYSTIMEKERNEL 	/**/
+/*#undef	I_SYS_SELECT 	/**/
+
+/* I_UTIME
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include utime.h.
+ */
+#define	I_UTIME		/**/
+
+/* I_VARARGS
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include varargs.h.
+ */
+#define	I_VARARGS		/**/
+
+/* I_VFORK
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include vfork.h.
+ */
+/*#undef	I_VFORK		/**/
+
+/* INTSIZE
+ *	This symbol contains the size of an int, so that the C preprocessor
+ *	can make decisions based on it.
+ */
+#define INTSIZE 4		/**/
+
+/* I_DIRENT
+ *	This symbol, if defined, indicates that the program should use the
+ *	P1003-style directory routines, and include <dirent.h>.
+ */
+/* I_SYS_DIR
+ *	This symbol, if defined, indicates that the program should use the
+ *	directory functions by including <sys/dir.h>.
+ */
+/* I_NDIR
+ *	This symbol, if defined, indicates that the program should include the
+ *	system's version of ndir.h, rather than the one with this package.
+ */
+/* I_SYS_NDIR
+ *	This symbol, if defined, indicates that the program should include the
+ *	system's version of sys/ndir.h, rather than the one with this package.
+ */
+/* I_MY_DIR
+ *	This symbol, if defined, indicates that the program should compile
+ *	the ndir.c code provided with the package.
+ */
+/* 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.
+ */
+#define	I_DIRENT	/**/
+/*#undef	I_SYS_DIR	/**/
+/*#undef	I_NDIR		/**/
+/*#undef	I_SYS_NDIR	/**/
+/*#undef	I_MY_DIR	/**/
+/*#undef	DIRNAMLEN	/**/
+
+/* MYMALLOC
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+/* MALLOCPTRTYPE
+ *	This symbol defines the kind of ptr returned by malloc and realloc.
+ */
+#define MYMALLOC			/**/
+
+#define MALLOCPTRTYPE void         /**/
+
+
+/* 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		/**/
+
+/* SCRIPTDIR
+ *	This symbol holds the name of the directory in which the user wants
+ *	to keep publicly executable scripts for the package in question.  It
+ *	is often a directory that is mounted across diverse architectures.
+ */
+#define SCRIPTDIR "/usr/local/bin"             /**/
+
+/* SIG_NAME
+ *	This symbol contains an list of signal names in order.
+ */
+#define 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"		/**/
+
+/* 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	/**/
+
+/* UIDTYPE
+ *	This symbol has a value like uid_t, int, ushort, or whatever type is
+ *	used to declare user ids in the kernel.
+ */
+#define UIDTYPE uid_t		/**/
+
+/* VOIDHAVE
+ *	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
+ *
+ *	The package designer should define VOIDWANT to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDWANT before
+ *	including config.h, or by defining voidwant in Myinit.U.  If the level
+ *	of void support necessary is not present, config.h defines void to "int",
+ *	VOID to the empty string, and VOIDP to "char *".
+ */
+/* void
+ *	This symbol is used for void casts.  On implementations which support
+ *	void appropriately, its value is "void".  Otherwise, its value maps
+ *	to "int".
+ */
+/* VOID
+ *	This symbol's value is "void" if the implementation supports void
+ *	appropriately.  Otherwise, its value is the empty string.  The primary
+ *	use of this symbol is in specifying void parameter lists for function
+ *	prototypes.
+ */
+/* VOIDP
+ *	This symbol is used for casting generic pointers.  On implementations
+ *	which support void appropriately, its value is "void *".  Otherwise,
+ *	its value is "char *".
+ */
+#ifndef VOIDWANT
+#define VOIDWANT 7
+#endif
+#define VOIDHAVE 7
+#if (VOIDHAVE & VOIDWANT) != VOIDWANT
+#define void int		/* is void to be avoided? */
+#define VOID
+#define VOIDP (char *)
+#define M_VOID		/* Xenix strikes again */
+#else
+#define VOID void
+#define VOIDP (void *)
+#endif
+
+/* PRIVLIB
+ *	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 "/usr/local/lib/perl"		/**/
+
+#endif
diff --git a/gnu/usr.bin/perl/perl/config.sh b/gnu/usr.bin/perl/perl/config.sh
new file mode 100644
index 000000000000..0baad6b9925c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/config.sh
@@ -0,0 +1,268 @@
+#!/bin/sh
+# config.sh
+# This file was produced by running the Configure script.
+d_eunice='undef'
+define='define'
+eunicefix=':'
+loclist='
+cat
+cp
+echo
+expr
+grep
+mkdir
+mv
+rm
+sed
+sort
+tr
+uniq
+'
+expr='/bin/expr'
+sed='/usr/bin/sed'
+echo='/bin/echo'
+cat='/bin/cat'
+rm='/bin/rm'
+mv='/bin/mv'
+cp='/bin/cp'
+tail=''
+tr='/usr/bin/tr'
+mkdir='/bin/mkdir'
+sort='/usr/bin/sort'
+uniq='/usr/bin/uniq'
+grep='/usr/bin/grep'
+trylist='
+Mcc
+bison
+cpp
+csh
+egrep
+line
+nroff
+perl
+test
+uname
+yacc
+'
+test='test'
+inews=''
+egrep='/usr/bin/egrep'
+more=''
+pg=''
+Mcc='Mcc'
+vi=''
+mailx=''
+mail=''
+cpp='/usr/bin/cpp'
+perl='perl'
+emacs=''
+ls=''
+rmail=''
+sendmail=''
+shar=''
+smail=''
+tbl=''
+troff=''
+nroff='/usr/bin/nroff'
+uname='uname'
+uuname=''
+line='line'
+chgrp=''
+chmod=''
+lint=''
+sleep=''
+pr=''
+tar=''
+ln=''
+lpr=''
+lp=''
+touch=''
+make=''
+date=''
+csh='/bin/csh'
+bash=''
+ksh=''
+lex=''
+flex=''
+bison='bison'
+Log='$Log'
+Header='$Header'
+Id='$Id'
+lastuname='uname: not found'
+alignbytes='4'
+bin='/usr/gnu/bin'
+installbin='/usr/gnu/bin'
+byteorder='1234'
+contains='grep'
+cppstdin='/usr/bin/cpp'
+cppminus=''
+d_bcmp='define'
+d_bcopy='define'
+d_safebcpy='define'
+d_bzero='define'
+d_castneg='define'
+castflags='0'
+d_charsprf='undef'
+d_chsize='undef'
+d_crypt='define'
+cryptlib='-lcrypt'
+d_csh='define'
+d_dosuid='define'
+d_dup2='define'
+d_fchmod='define'
+d_fchown='define'
+d_fcntl='define'
+d_flexfnam='define'
+d_flock='define'
+d_getgrps='define'
+d_gethent='undef'
+d_getpgrp='define'
+d_getpgrp2='undef'
+d_getprior='define'
+d_htonl='define'
+d_index='undef'
+d_isascii='undef'
+d_killpg='define'
+d_lstat='define'
+d_memcmp='define'
+d_memcpy='define'
+d_safemcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_msg='define'
+d_msgctl='define'
+d_msgget='define'
+d_msgrcv='define'
+d_msgsnd='define'
+d_ndbm='define'
+d_odbm='undef'
+d_open3='define'
+d_readdir='define'
+d_rename='define'
+d_rewindir='define'
+d_rmdir='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_setpgrp='define'
+d_setpgrp2='undef'
+d_setprior='define'
+d_setregid='define'
+d_setresgid='undef'
+d_setreuid='define'
+d_setresuid='undef'
+d_setrgid='define'
+d_setruid='define'
+d_shm='define'
+d_shmat='define'
+d_voidshmat='define'
+d_shmctl='define'
+d_shmdt='define'
+d_shmget='define'
+d_socket='define'
+d_sockpair='define'
+d_oldsock='undef'
+socketlib=''
+d_statblks='define'
+d_stdstdio='undef'
+d_strctcpy='define'
+d_strerror='define'
+d_symlink='define'
+d_syscall='define'
+d_telldir='define'
+d_truncate='define'
+d_vfork='define'
+d_voidsig='define'
+d_tosignal='int'
+d_volatile='define'
+d_vprintf='define'
+d_charvspr='undef'
+d_wait4='define'
+d_waitpid='define'
+gidtype='gid_t'
+groupstype='int'
+i_fcntl='undef'
+i_gdbm='undef'
+i_grp='define'
+i_niin='define'
+i_sysin='undef'
+i_pwd='define'
+d_pwquota='undef'
+d_pwage='undef'
+d_pwchange='define'
+d_pwclass='define'
+d_pwexpire='define'
+d_pwcomment='undef'
+i_sys_file='define'
+i_sysioctl='define'
+i_time='undef'
+i_sys_time='define'
+i_sys_select='undef'
+d_systimekernel='undef'
+i_utime='define'
+i_varargs='define'
+i_vfork='undef'
+intsize='4'
+libc='/usr/lib/libc.so.1.0'
+nm_opts=''
+libndir=''
+i_my_dir='undef'
+i_ndir='undef'
+i_sys_ndir='undef'
+i_dirent='define'
+i_sys_dir='undef'
+d_dirnamlen='define'
+ndirc=''
+ndiro=''
+mallocsrc='malloc.c'
+mallocobj='malloc.o'
+d_mymalloc='define'
+mallocptrtype='void'
+mansrc='/usr/gnu/man/man1'
+manext='1'
+models='none'
+split=''
+small=''
+medium=''
+large=''
+huge=''
+optimize='-O'
+ccflags=''
+cppflags=''
+ldflags=''
+cc='cc'
+nativegcc=''
+libs='-lm'
+n='-n'
+c=''
+package='perl'
+randbits='31'
+scriptdir='/usr/gnu/bin'
+installscr='/usr/gnu/bin'
+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'
+spitshell='cat'
+shsharp='true'
+sharpbang='#!'
+startsh='#!/bin/sh'
+stdchar='char'
+uidtype='uid_t'
+usrinclude='/usr/include'
+inclPath=''
+void=''
+voidhave='7'
+voidwant='7'
+w_localtim='1'
+w_s_timevl='1'
+w_s_tm='1'
+yacc='/usr/bin/yacc'
+lib=''
+privlib='/usr/gnu/lib/perl'
+installprivlib='/usr/gnu/lib/perl'
+PATCHLEVEL=36
+CONFIG=true
diff --git a/gnu/usr.bin/perl/perl/cons.c b/gnu/usr.bin/perl/perl/cons.c
new file mode 100644
index 000000000000..c926f7a86c96
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/cons.c
@@ -0,0 +1,1450 @@
+/* $RCSfile: cons.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: cons.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  1993/02/05  19:30:15  lwall
+ * patch36: fixed various little coredump bugs
+ *
+ * Revision 4.0.1.3  92/06/08  12:18:35  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: deleted some minor memory leaks
+ * patch20: fixed double debug break in foreach with implicit array assignment
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: debugger sometimes displayed wrong source line
+ * patch20: various error messages have been clarified
+ * patch20: an eval block containing a null block or statement could dump core
+ * 
+ * Revision 4.0.1.2  91/11/05  16:15:13  lwall
+ * patch11: debugger got confused over nested subroutine definitions
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.1  91/06/07  10:31:15  lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * 
+ * Revision 4.0  91/03/20  01:05:51  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+extern char *tokename[];
+extern int yychar;
+
+static int cmd_tosave();
+static int arg_tosave();
+static int spat_tosave();
+static void make_cswitch();
+static void make_nswitch();
+
+static bool saw_return;
+
+SUBR *
+make_sub(name,cmd)
+char *name;
+CMD *cmd;
+{
+    register SUBR *sub;
+    STAB *stab = stabent(name,TRUE);
+
+    if (sub = stab_sub(stab)) {
+	if (dowarn) {
+	    CMD *oldcurcmd = curcmd;
+
+	    if (cmd)
+		curcmd = cmd;
+	    warn("Subroutine %s redefined",name);
+	    curcmd = oldcurcmd;
+	}
+	if (!sub->usersub && sub->cmd) {
+	    cmd_free(sub->cmd);
+	    sub->cmd = Nullcmd;
+	    afree(sub->tosave);
+	}
+	Safefree(sub);
+    }
+    Newz(101,sub,1,SUBR);
+    stab_sub(stab) = sub;
+    sub->filestab = curcmd->c_filestab;
+    saw_return = FALSE;
+    tosave = anew(Nullstab);
+    tosave->ary_fill = 0;	/* make 1 based */
+    (void)cmd_tosave(cmd,FALSE);	/* this builds the tosave array */
+    sub->tosave = tosave;
+    if (saw_return) {
+	struct compcmd mycompblock;
+
+	mycompblock.comp_true = cmd;
+	mycompblock.comp_alt = Nullcmd;
+	cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,0,
+	    Nullarg,mycompblock));
+	saw_return = FALSE;
+	cmd->c_flags |= CF_TERM;
+	cmd->c_head = cmd;
+    }
+    sub->cmd = cmd;
+    if (perldb) {
+	STR *str;
+	STR *tmpstr = str_mortal(&str_undef);
+
+	sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, subline);
+	str = str_make(buf,0);
+	str_cat(str,"-");
+	sprintf(buf,"%ld",(long)curcmd->c_line);
+	str_cat(str,buf);
+	stab_efullname(tmpstr,stab);
+	hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
+    }
+    Safefree(name);
+    return sub;
+}
+
+SUBR *
+make_usub(name, ix, subaddr, filename)
+char *name;
+int ix;
+int (*subaddr)();
+char *filename;
+{
+    register SUBR *sub;
+    STAB *stab = stabent(name,allstabs);
+
+    if (!stab)				/* unused function */
+	return Null(SUBR*);
+    if (sub = stab_sub(stab)) {
+	if (dowarn)
+	    warn("Subroutine %s redefined",name);
+	if (!sub->usersub && sub->cmd) {
+	    cmd_free(sub->cmd);
+	    sub->cmd = Nullcmd;
+	    afree(sub->tosave);
+	}
+	Safefree(sub);
+    }
+    Newz(101,sub,1,SUBR);
+    stab_sub(stab) = sub;
+    sub->filestab = fstab(filename);
+    sub->usersub = subaddr;
+    sub->userindex = ix;
+    return sub;
+}
+
+void
+make_form(stab,fcmd)
+STAB *stab;
+FCMD *fcmd;
+{
+    if (stab_form(stab)) {
+	FCMD *tmpfcmd;
+	FCMD *nextfcmd;
+
+	for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
+	    nextfcmd = tmpfcmd->f_next;
+	    if (tmpfcmd->f_expr)
+		arg_free(tmpfcmd->f_expr);
+	    if (tmpfcmd->f_unparsed)
+		str_free(tmpfcmd->f_unparsed);
+	    if (tmpfcmd->f_pre)
+		Safefree(tmpfcmd->f_pre);
+	    Safefree(tmpfcmd);
+	}
+    }
+    stab_form(stab) = fcmd;
+}
+
+CMD *
+block_head(tail)
+register CMD *tail;
+{
+    CMD *head;
+    register int opt;
+    register int last_opt = 0;
+    register STAB *last_stab = Nullstab;
+    register int count = 0;
+    register CMD *switchbeg = Nullcmd;
+
+    if (tail == Nullcmd) {
+	return tail;
+    }
+    head = tail->c_head;
+
+    for (tail = head; tail; tail = tail->c_next) {
+
+	/* save one measly dereference at runtime */
+	if (tail->c_type == C_IF) {
+	    if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
+		tail->c_flags |= CF_TERM;
+	}
+	else if (tail->c_type == C_EXPR) {
+	    ARG *arg;
+
+	    if (tail->ucmd.acmd.ac_expr)
+		arg = tail->ucmd.acmd.ac_expr;
+	    else
+		arg = tail->c_expr;
+	    if (arg) {
+		if (arg->arg_type == O_RETURN)
+		    tail->c_flags |= CF_TERM;
+		else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
+		    tail->c_flags |= CF_TERM;
+	    }
+	}
+	if (!tail->c_next)
+	    tail->c_flags |= CF_TERM;
+
+	if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
+	    opt_arg(tail,1, tail->c_type == C_EXPR);
+
+	/* now do a little optimization on case-ish structures */
+	switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
+	case CFT_ANCHOR:
+	case CFT_STROP:
+	    opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
+	    break;
+	case CFT_CCLASS:
+	    opt = CFT_STROP;
+	    break;
+	case CFT_NUMOP:
+	    opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
+	    if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
+		opt = 0;
+	    break;
+	default:
+	    opt = 0;
+	}
+	if (opt && opt == last_opt && tail->c_stab == last_stab)
+	    count++;
+	else {
+	    if (count >= 3) {		/* is this the breakeven point? */
+		if (last_opt == CFT_NUMOP)
+		    make_nswitch(switchbeg,count);
+		else
+		    make_cswitch(switchbeg,count);
+	    }
+	    if (opt) {
+		count = 1;
+		switchbeg = tail;
+	    }
+	    else
+		count = 0;
+	}
+	last_opt = opt;
+	last_stab = tail->c_stab;
+    }
+    if (count >= 3) {		/* is this the breakeven point? */
+	if (last_opt == CFT_NUMOP)
+	    make_nswitch(switchbeg,count);
+	else
+	    make_cswitch(switchbeg,count);
+    }
+    return head;
+}
+
+/* We've spotted a sequence of CMDs that all test the value of the same
+ * spat.  Thus we can insert a SWITCH in front and jump directly
+ * to the correct one.
+ */
+static void
+make_cswitch(head,count)
+register CMD *head;
+int count;
+{
+    register CMD *cur;
+    register CMD **loc;
+    register int i;
+    register int min = 255;
+    register int max = 0;
+
+    /* make a new head in the exact same spot */
+    New(102,cur, 1, CMD);
+    StructCopy(head,cur,CMD);
+    Zero(head,1,CMD);
+    head->c_head = cur->c_head;
+    head->c_type = C_CSWITCH;
+    head->c_next = cur;		/* insert new cmd at front of list */
+    head->c_stab = cur->c_stab;
+
+    Newz(103,loc,258,CMD*);
+    loc++;				/* lie a little */
+    while (count--) {
+	if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
+	    for (i = 0; i <= 255; i++) {
+		if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
+		    loc[i] = cur;
+		    if (i < min)
+			min = i;
+		    if (i > max)
+			max = i;
+		}
+	    }
+	}
+	else {
+	    i = *cur->c_short->str_ptr & 255;
+	    if (!loc[i]) {
+		loc[i] = cur;
+		if (i < min)
+		    min = i;
+		if (i > max)
+		    max = i;
+	    }
+	}
+	cur = cur->c_next;
+    }
+    max++;
+    if (min > 0)
+	Move(&loc[min],&loc[0], max - min, CMD*);
+    loc--;
+    min--;
+    max -= min;
+    for (i = 0; i <= max; i++)
+	if (!loc[i])
+	    loc[i] = cur;
+    Renew(loc,max+1,CMD*);	/* chop it down to size */
+    head->ucmd.scmd.sc_offset = min;
+    head->ucmd.scmd.sc_max = max;
+    head->ucmd.scmd.sc_next = loc;
+}
+
+static void
+make_nswitch(head,count)
+register CMD *head;
+int count;
+{
+    register CMD *cur = head;
+    register CMD **loc;
+    register int i;
+    register int min = 32767;
+    register int max = -32768;
+    int origcount = count;
+    double value;		/* or your money back! */
+    short changed;		/* so triple your money back! */
+
+    while (count--) {
+	i = (int)str_gnum(cur->c_short);
+	value = (double)i;
+	if (value != cur->c_short->str_u.str_nval)
+	    return;		/* fractional values--just forget it */
+	changed = i;
+	if (changed != i)
+	    return;		/* too big for a short */
+	if (cur->c_slen == O_LE)
+	    i++;
+	else if (cur->c_slen == O_GE)	/* we only do < or > here */
+	    i--;
+	if (i < min)
+	    min = i;
+	if (i > max)
+	    max = i;
+	cur = cur->c_next;
+    }
+    count = origcount;
+    if (max - min > count * 2 + 10)		/* too sparse? */
+	return;
+
+    /* now make a new head in the exact same spot */
+    New(104,cur, 1, CMD);
+    StructCopy(head,cur,CMD);
+    Zero(head,1,CMD);
+    head->c_head = cur->c_head;
+    head->c_type = C_NSWITCH;
+    head->c_next = cur;		/* insert new cmd at front of list */
+    head->c_stab = cur->c_stab;
+
+    Newz(105,loc, max - min + 3, CMD*);
+    loc++;
+    max -= min;
+    max++;
+    while (count--) {
+	i = (int)str_gnum(cur->c_short);
+	i -= min;
+	switch(cur->c_slen) {
+	case O_LE:
+	    i++;
+	case O_LT:
+	    for (i--; i >= -1; i--)
+		if (!loc[i])
+		    loc[i] = cur;
+	    break;
+	case O_GE:
+	    i--;
+	case O_GT:
+	    for (i++; i <= max; i++)
+		if (!loc[i])
+		    loc[i] = cur;
+	    break;
+	case O_EQ:
+	    if (!loc[i])
+		loc[i] = cur;
+	    break;
+	}
+	cur = cur->c_next;
+    }
+    loc--;
+    min--;
+    max++;
+    for (i = 0; i <= max; i++)
+	if (!loc[i])
+	    loc[i] = cur;
+    head->ucmd.scmd.sc_offset = min;
+    head->ucmd.scmd.sc_max = max;
+    head->ucmd.scmd.sc_next = loc;
+}
+
+CMD *
+append_line(head,tail)
+register CMD *head;
+register CMD *tail;
+{
+    if (tail == Nullcmd)
+	return head;
+    if (!tail->c_head)			/* make sure tail is well formed */
+	tail->c_head = tail;
+    if (head != Nullcmd) {
+	tail = tail->c_head;		/* get to start of tail list */
+	if (!head->c_head)
+	    head->c_head = head;	/* start a new head list */
+	while (head->c_next) {
+	    head->c_next->c_head = head->c_head;
+	    head = head->c_next;	/* get to end of head list */
+	}
+	head->c_next = tail;		/* link to end of old list */
+	tail->c_head = head->c_head;	/* propagate head pointer */
+    }
+    while (tail->c_next) {
+	tail->c_next->c_head = tail->c_head;
+	tail = tail->c_next;
+    }
+    return tail;
+}
+
+CMD *
+dodb(cur)
+CMD *cur;
+{
+    register CMD *cmd;
+    register CMD *head = cur->c_head;
+    STR *str;
+
+    if (!head)
+	head = cur;
+    if (!head->c_line)
+	return cur;
+    str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
+    if (str == &str_undef || str->str_nok)
+	return cur;
+    str->str_u.str_nval = (double)head->c_line;
+    str->str_nok = 1;
+    Newz(106,cmd,1,CMD);
+    str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
+    str->str_magic->str_u.str_cmd = cmd;
+    cmd->c_type = C_EXPR;
+    cmd->ucmd.acmd.ac_stab = Nullstab;
+    cmd->ucmd.acmd.ac_expr = Nullarg;
+    cmd->c_expr = make_op(O_SUBR, 2,
+	stab2arg(A_WORD,DBstab),
+	Nullarg,
+	Nullarg);
+    /*SUPPRESS 53*/
+    cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
+    cmd->c_line = head->c_line;
+    cmd->c_label = head->c_label;
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    return append_line(cmd, cur);
+}
+
+CMD *
+make_acmd(type,stab,cond,arg)
+int type;
+STAB *stab;
+ARG *cond;
+ARG *arg;
+{
+    register CMD *cmd;
+
+    Newz(107,cmd,1,CMD);
+    cmd->c_type = type;
+    cmd->ucmd.acmd.ac_stab = stab;
+    cmd->ucmd.acmd.ac_expr = arg;
+    cmd->c_expr = cond;
+    if (cond)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    if (perldb)
+	cmd = dodb(cmd);
+    return cmd;
+}
+
+CMD *
+make_ccmd(type,debuggable,arg,cblock)
+int type;
+int debuggable;
+ARG *arg;
+struct compcmd cblock;
+{
+    register CMD *cmd;
+
+    Newz(108,cmd, 1, CMD);
+    cmd->c_type = type;
+    cmd->c_expr = arg;
+    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
+    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
+    if (arg)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    if (perldb && debuggable)
+	cmd = dodb(cmd);
+    return cmd;
+}
+
+CMD *
+make_icmd(type,arg,cblock)
+int type;
+ARG *arg;
+struct compcmd cblock;
+{
+    register CMD *cmd;
+    register CMD *alt;
+    register CMD *cur;
+    register CMD *head;
+    struct compcmd ncblock;
+
+    Newz(109,cmd, 1, CMD);
+    head = cmd;
+    cmd->c_type = type;
+    cmd->c_expr = arg;
+    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
+    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
+    if (arg)
+	cmd->c_flags |= CF_COND;
+    if (cmdline == NOLINE)
+	cmd->c_line = curcmd->c_line;
+    else {
+	cmd->c_line = cmdline;
+	cmdline = NOLINE;
+    }
+    cmd->c_filestab = curcmd->c_filestab;
+    cmd->c_stash = curstash;
+    cur = cmd;
+    alt = cblock.comp_alt;
+    while (alt && alt->c_type == C_ELSIF) {
+	cur = alt;
+	alt = alt->ucmd.ccmd.cc_alt;
+    }
+    if (alt) {			/* a real life ELSE at the end? */
+	ncblock.comp_true = alt;
+	ncblock.comp_alt = Nullcmd;
+	alt = append_line(cur,make_ccmd(C_ELSE,1,Nullarg,ncblock));
+	cur->ucmd.ccmd.cc_alt = alt;
+    }
+    else
+	alt = cur;		/* no ELSE, so cur is proxy ELSE */
+
+    cur = cmd;
+    while (cmd) {		/* now point everyone at the ELSE */
+	cur = cmd;
+	cmd = cur->ucmd.ccmd.cc_alt;
+	cur->c_head = head;
+	if (cur->c_type == C_ELSIF)
+	    cur->c_type = C_IF;
+	if (cur->c_type == C_IF)
+	    cur->ucmd.ccmd.cc_alt = alt;
+	if (cur == alt)
+	    break;
+	cur->c_next = cmd;
+    }
+    if (perldb)
+	cur = dodb(cur);
+    return cur;
+}
+
+void
+opt_arg(cmd,fliporflop,acmd)
+register CMD *cmd;
+int fliporflop;
+int acmd;
+{
+    register ARG *arg;
+    int opt = CFT_EVAL;
+    int sure = 0;
+    ARG *arg2;
+    int context = 0;	/* 0 = normal, 1 = before &&, 2 = before || */
+    int flp = fliporflop;
+
+    if (!cmd)
+	return;
+    if (!(arg = cmd->c_expr)) {
+	cmd->c_flags &= ~CF_COND;
+	return;
+    }
+
+    /* Can we turn && and || into if and unless? */
+
+    if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
+      (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
+	dehoist(arg,1);
+	arg[2].arg_type &= A_MASK;	/* don't suppress eval */
+	dehoist(arg,2);
+	cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
+	cmd->c_expr = arg[1].arg_ptr.arg_arg;
+	if (arg->arg_type == O_OR)
+	    cmd->c_flags ^= CF_INVERT;		/* || is like unless */
+	arg->arg_len = 0;
+	free_arg(arg);
+	arg = cmd->c_expr;
+    }
+
+    /* Turn "if (!expr)" into "unless (expr)" */
+
+    if (!(cmd->c_flags & CF_TERM)) {		/* unless return value wanted */
+	while (arg->arg_type == O_NOT) {
+	    dehoist(arg,1);
+	    cmd->c_flags ^= CF_INVERT;		/* flip sense of cmd */
+	    cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
+	    free_arg(arg);
+	    arg = cmd->c_expr;			/* here we go again */
+	}
+    }
+
+    if (!arg->arg_len) {		/* sanity check */
+	cmd->c_flags |= opt;
+	return;
+    }
+
+    /* for "cond .. cond" we set up for the initial check */
+
+    if (arg->arg_type == O_FLIP)
+	context |= 4;
+
+    /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
+
+  morecontext:
+    if (arg->arg_type == O_AND)
+	context |= 1;
+    else if (arg->arg_type == O_OR)
+	context |= 2;
+    if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
+	arg = arg[flp].arg_ptr.arg_arg;
+	flp = 1;
+	if (arg->arg_type == O_AND || arg->arg_type == O_OR)
+	    goto morecontext;
+    }
+    if ((context & 3) == 3)
+	return;
+
+    if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
+	cmd->c_flags |= opt;
+	if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
+	  && cmd->c_expr->arg_type == O_ITEM) {
+	    arg[flp].arg_flags &= ~AF_POST;	/* prefer ++$foo to $foo++ */
+	    arg[flp].arg_flags |= AF_PRE;	/*  if value not wanted */
+	}
+	return;				/* side effect, can't optimize */
+    }
+
+    if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
+      arg->arg_type == O_AND || arg->arg_type == O_OR) {
+	if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
+	    opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
+	    cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
+	    goto literal;
+	}
+	else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
+	  (arg[flp].arg_type & A_MASK) == A_LVAL) {
+	    cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
+	    if (!context)
+		arg[flp].arg_ptr.arg_stab = Nullstab;
+	    opt = CFT_REG;
+	  literal:
+	    if (!context) {	/* no && or ||? */
+		arg_free(arg);
+		cmd->c_expr = Nullarg;
+	    }
+	    if (!(context & 1))
+		cmd->c_flags |= CF_EQSURE;
+	    if (!(context & 2))
+		cmd->c_flags |= CF_NESURE;
+	}
+    }
+    else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
+	     arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
+	if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
+		(arg[2].arg_type & A_MASK) == A_SPAT &&
+		arg[2].arg_ptr.arg_spat->spat_short &&
+		(arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
+		 (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
+	    cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+	    cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
+	    cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
+	    if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
+		!(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
+		(arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
+		sure |= CF_EQSURE;		/* (SUBST must be forced even */
+						/* if we know it will work.) */
+	    if (arg->arg_type != O_SUBST) {
+		str_free(arg[2].arg_ptr.arg_spat->spat_short);
+		arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
+		arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
+	    }
+	    sure |= CF_NESURE;		/* normally only sure if it fails */
+	    if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
+		cmd->c_flags |= CF_FIRSTNEG;
+	    if (context & 1) {		/* only sure if thing is false */
+		if (cmd->c_flags & CF_FIRSTNEG)
+		    sure &= ~CF_NESURE;
+		else
+		    sure &= ~CF_EQSURE;
+	    }
+	    else if (context & 2) {	/* only sure if thing is true */
+		if (cmd->c_flags & CF_FIRSTNEG)
+		    sure &= ~CF_EQSURE;
+		else
+		    sure &= ~CF_NESURE;
+	    }
+	    if (sure & (CF_EQSURE|CF_NESURE)) {	/* if we know anything*/
+		if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
+		    opt = CFT_SCAN;
+		else
+		    opt = CFT_ANCHOR;
+		if (sure == (CF_EQSURE|CF_NESURE)	/* really sure? */
+		    && arg->arg_type == O_MATCH
+		    && context & 4
+		    && fliporflop == 1) {
+		    spat_free(arg[2].arg_ptr.arg_spat);
+		    arg[2].arg_ptr.arg_spat = Nullspat;	/* don't do twice */
+		}
+		else
+		    cmd->c_spat = arg[2].arg_ptr.arg_spat;
+		cmd->c_flags |= sure;
+	    }
+	}
+    }
+    else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
+	     arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
+	if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
+	    if (arg[2].arg_type == A_SINGLE) {
+		/*SUPPRESS 594*/
+		char *junk = str_get(arg[2].arg_ptr.arg_str);
+
+		cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+		cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
+		cmd->c_slen  = cmd->c_short->str_cur+1;
+		switch (arg->arg_type) {
+		case O_SLT: case O_SGT:
+		    sure |= CF_EQSURE;
+		    cmd->c_flags |= CF_FIRSTNEG;
+		    break;
+		case O_SNE:
+		    cmd->c_flags |= CF_FIRSTNEG;
+		    /* FALL THROUGH */
+		case O_SEQ:
+		    sure |= CF_NESURE|CF_EQSURE;
+		    break;
+		}
+		if (context & 1) {	/* only sure if thing is false */
+		    if (cmd->c_flags & CF_FIRSTNEG)
+			sure &= ~CF_NESURE;
+		    else
+			sure &= ~CF_EQSURE;
+		}
+		else if (context & 2) { /* only sure if thing is true */
+		    if (cmd->c_flags & CF_FIRSTNEG)
+			sure &= ~CF_EQSURE;
+		    else
+			sure &= ~CF_NESURE;
+		}
+		if (sure & (CF_EQSURE|CF_NESURE)) {
+		    opt = CFT_STROP;
+		    cmd->c_flags |= sure;
+		}
+	    }
+	}
+    }
+    else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
+	     arg->arg_type == O_LE || arg->arg_type == O_GE ||
+	     arg->arg_type == O_LT || arg->arg_type == O_GT) {
+	if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
+	    if (arg[2].arg_type == A_SINGLE) {
+		cmd->c_stab  = arg[1].arg_ptr.arg_stab;
+		if (dowarn) {
+		    STR *str = arg[2].arg_ptr.arg_str;
+
+		    if ((!str->str_nok && !looks_like_number(str)))
+			warn("Possible use of == on string value");
+		}
+		cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
+		cmd->c_slen = arg->arg_type;
+		sure |= CF_NESURE|CF_EQSURE;
+		if (context & 1) {	/* only sure if thing is false */
+		    sure &= ~CF_EQSURE;
+		}
+		else if (context & 2) { /* only sure if thing is true */
+		    sure &= ~CF_NESURE;
+		}
+		if (sure & (CF_EQSURE|CF_NESURE)) {
+		    opt = CFT_NUMOP;
+		    cmd->c_flags |= sure;
+		}
+	    }
+	}
+    }
+    else if (arg->arg_type == O_ASSIGN &&
+	     (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
+	     arg[1].arg_ptr.arg_stab == defstab &&
+	     arg[2].arg_type == A_EXPR ) {
+	arg2 = arg[2].arg_ptr.arg_arg;
+	if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
+	    opt = CFT_GETS;
+	    cmd->c_stab = arg2[1].arg_ptr.arg_stab;
+	    if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
+		free_arg(arg2);
+		arg[2].arg_ptr.arg_arg = Nullarg;
+		free_arg(arg);
+		cmd->c_expr = Nullarg;
+	    }
+	}
+    }
+    else if (arg->arg_type == O_CHOP &&
+	     (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
+	opt = CFT_CHOP;
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	free_arg(arg);
+	cmd->c_expr = Nullarg;
+    }
+    if (context & 4)
+	opt |= CF_FLIP;
+    cmd->c_flags |= opt;
+
+    if (cmd->c_flags & CF_FLIP) {
+	if (fliporflop == 1) {
+	    arg = cmd->c_expr;	/* get back to O_FLIP arg */
+	    New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
+	    Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
+	    New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
+	    Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
+	    opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
+	    arg->arg_len = 2;		/* this is a lie */
+	}
+	else {
+	    if ((opt & CF_OPTIMIZE) == CFT_EVAL)
+		cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
+	}
+    }
+}
+
+CMD *
+add_label(lbl,cmd)
+char *lbl;
+register CMD *cmd;
+{
+    if (cmd)
+	cmd->c_label = lbl;
+    return cmd;
+}
+
+CMD *
+addcond(cmd, arg)
+register CMD *cmd;
+register ARG *arg;
+{
+    cmd->c_expr = arg;
+    cmd->c_flags |= CF_COND;
+    return cmd;
+}
+
+CMD *
+addloop(cmd, arg)
+register CMD *cmd;
+register ARG *arg;
+{
+    void while_io();
+
+    cmd->c_expr = arg;
+    cmd->c_flags |= CF_COND|CF_LOOP;
+
+    if (!(cmd->c_flags & CF_INVERT))
+	while_io(cmd);		/* add $_ =, if necessary */
+
+    if (cmd->c_type == C_BLOCK)
+	cmd->c_flags &= ~CF_COND;
+    else {
+	arg = cmd->ucmd.acmd.ac_expr;
+	if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
+	    cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
+	if (arg && (arg->arg_flags & AF_DEPR) &&
+	  (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
+	    cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
+    }
+    return cmd;
+}
+
+CMD *
+invert(cmd)
+CMD *cmd;
+{
+    register CMD *targ = cmd;
+    if (targ->c_head)
+	targ = targ->c_head;
+    if (targ->c_flags & CF_DBSUB)
+	targ = targ->c_next;
+    targ->c_flags ^= CF_INVERT;
+    return cmd;
+}
+
+void
+cpy7bit(d,s,l)
+register char *d;
+register char *s;
+register int l;
+{
+    while (l--)
+	*d++ = *s++ & 127;
+    *d = '\0';
+}
+
+int
+yyerror(s)
+char *s;
+{
+    char tmpbuf[258];
+    char tmp2buf[258];
+    char *tname = tmpbuf;
+
+    if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+      oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
+	while (isSPACE(*oldoldbufptr))
+	    oldoldbufptr++;
+	cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
+	sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
+    }
+    else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
+      oldbufptr != bufptr) {
+	while (isSPACE(*oldbufptr))
+	    oldbufptr++;
+	cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
+	sprintf(tname,"next token \"%s\"",tmp2buf);
+    }
+    else if (yychar > 256)
+	tname = "next token ???";
+    else if (!yychar)
+	(void)strcpy(tname,"at EOF");
+    else if (yychar < 32)
+	(void)sprintf(tname,"next char ^%c",yychar+64);
+    else if (yychar == 127)
+	(void)strcpy(tname,"at EOF");
+    else
+	(void)sprintf(tname,"next char %c",yychar);
+    (void)sprintf(buf, "%s in file %s at line %d, %s\n",
+      s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
+    if (curcmd->c_line == multi_end && multi_start < multi_end)
+	sprintf(buf+strlen(buf),
+	  "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
+	  multi_open,multi_close,multi_start);
+    if (in_eval)
+	str_cat(stab_val(stabent("@",TRUE)),buf);
+    else
+	fputs(buf,stderr);
+    if (++error_count >= 10)
+	fatal("%s has too many errors.\n",
+	stab_val(curcmd->c_filestab)->str_ptr);
+}
+
+void
+while_io(cmd)
+register CMD *cmd;
+{
+    register ARG *arg = cmd->c_expr;
+    STAB *asgnstab;
+
+    /* hoist "while (<channel>)" up into command block */
+
+    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+	cmd->c_flags |= CFT_GETS;	/* and set it to do the input */
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
+	    cmd->c_expr = l(make_op(O_ASSIGN, 2,	/* fake up "$_ =" */
+	       stab2arg(A_LVAL,defstab), arg, Nullarg));
+	}
+	else {
+	    free_arg(arg);
+	    cmd->c_expr = Nullarg;
+	}
+    }
+    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+	cmd->c_flags |= CFT_INDGETS;	/* and set it to do the input */
+	cmd->c_stab = arg[1].arg_ptr.arg_stab;
+	free_arg(arg);
+	cmd->c_expr = Nullarg;
+    }
+    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
+	if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
+	    asgnstab = cmd->c_stab;
+	else
+	    asgnstab = defstab;
+	cmd->c_expr = l(make_op(O_ASSIGN, 2,	/* fake up "$foo =" */
+	   stab2arg(A_LVAL,asgnstab), arg, Nullarg));
+	cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+    }
+}
+
+CMD *
+wopt(cmd)
+register CMD *cmd;
+{
+    register CMD *tail;
+    CMD *newtail;
+    register int i;
+
+    if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
+	opt_arg(cmd,1, cmd->c_type == C_EXPR);
+
+    while_io(cmd);		/* add $_ =, if necessary */
+
+    /* First find the end of the true list */
+
+    tail = cmd->ucmd.ccmd.cc_true;
+    if (tail == Nullcmd)
+	return cmd;
+    New(112,newtail, 1, CMD);	/* guaranteed continue */
+    for (;;) {
+	/* optimize "next" to point directly to continue block */
+	if (tail->c_type == C_EXPR &&
+	    tail->ucmd.acmd.ac_expr &&
+	    tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
+	    (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
+	     (cmd->c_label &&
+	      strEQ(cmd->c_label,
+		    tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
+	{
+	    arg_free(tail->ucmd.acmd.ac_expr);
+	    tail->ucmd.acmd.ac_expr = Nullarg;
+	    tail->c_type = C_NEXT;
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
+		tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
+	    else
+		tail->ucmd.ccmd.cc_alt = newtail;
+	    tail->ucmd.ccmd.cc_true = Nullcmd;
+	}
+	else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
+		tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
+	    else
+		tail->ucmd.ccmd.cc_alt = newtail;
+	}
+	else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
+	    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
+	    }
+	    else {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = newtail;
+	    }
+	}
+
+	if (!tail->c_next)
+	    break;
+	tail = tail->c_next;
+    }
+
+    /* if there's a continue block, link it to true block and find end */
+
+    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
+	tail->c_next = cmd->ucmd.ccmd.cc_alt;
+	tail = tail->c_next;
+	for (;;) {
+	    /* optimize "next" to point directly to continue block */
+	    if (tail->c_type == C_EXPR &&
+		tail->ucmd.acmd.ac_expr &&
+		tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
+		(tail->ucmd.acmd.ac_expr->arg_len == 0 ||
+		 (cmd->c_label &&
+		  strEQ(cmd->c_label,
+			tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
+	    {
+		arg_free(tail->ucmd.acmd.ac_expr);
+		tail->ucmd.acmd.ac_expr = Nullarg;
+		tail->c_type = C_NEXT;
+		tail->ucmd.ccmd.cc_alt = newtail;
+		tail->ucmd.ccmd.cc_true = Nullcmd;
+	    }
+	    else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
+		tail->ucmd.ccmd.cc_alt = newtail;
+	    }
+	    else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
+		for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
+		    if (!tail->ucmd.scmd.sc_next[i])
+			tail->ucmd.scmd.sc_next[i] = newtail;
+	    }
+
+	    if (!tail->c_next)
+		break;
+	    tail = tail->c_next;
+	}
+	/*SUPPRESS 530*/
+	for ( ; tail->c_next; tail = tail->c_next) ;
+    }
+
+    /* Here's the real trick: link the end of the list back to the beginning,
+     * inserting a "last" block to break out of the loop.  This saves one or
+     * two procedure calls every time through the loop, because of how cmd_exec
+     * does tail recursion.
+     */
+
+    tail->c_next = newtail;
+    tail = newtail;
+    if (!cmd->ucmd.ccmd.cc_alt)
+	cmd->ucmd.ccmd.cc_alt = tail;	/* every loop has a continue now */
+
+#ifndef lint
+    Copy((char *)cmd, (char *)tail, 1, CMD);
+#endif
+    tail->c_type = C_EXPR;
+    tail->c_flags ^= CF_INVERT;		/* turn into "last unless" */
+    tail->c_next = tail->ucmd.ccmd.cc_true;	/* loop directly back to top */
+    tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
+    tail->ucmd.acmd.ac_stab = Nullstab;
+    return cmd;
+}
+
+CMD *
+over(eachstab,cmd)
+STAB *eachstab;
+register CMD *cmd;
+{
+    /* hoist "for $foo (@bar)" up into command block */
+
+    cmd->c_flags &= ~CF_OPTIMIZE;	/* clear optimization type */
+    cmd->c_flags |= CFT_ARRAY;		/* and set it to do the iteration */
+    cmd->c_stab = eachstab;
+    cmd->c_short = Str_new(23,0);	/* just to save a field in struct cmd */
+    cmd->c_short->str_u.str_useful = -1;
+
+    return cmd;
+}
+
+void
+cmd_free(cmd)
+register CMD *cmd;
+{
+    register CMD *tofree;
+    register CMD *head = cmd;
+
+    if (!cmd)
+	return;
+    if (cmd->c_head != cmd)
+	warn("Malformed cmd links\n");
+    while (cmd) {
+	if (cmd->c_type != C_WHILE) {	/* WHILE block is duplicated */
+	    if (cmd->c_label) {
+		Safefree(cmd->c_label);
+		cmd->c_label = Nullch;
+	    }
+	    if (cmd->c_short) {
+		str_free(cmd->c_short);
+		cmd->c_short = Nullstr;
+	    }
+	    if (cmd->c_expr) {
+		arg_free(cmd->c_expr);
+		cmd->c_expr = Nullarg;
+	    }
+	}
+	switch (cmd->c_type) {
+	case C_WHILE:
+	case C_BLOCK:
+	case C_ELSE:
+	case C_IF:
+	    if (cmd->ucmd.ccmd.cc_true) {
+		cmd_free(cmd->ucmd.ccmd.cc_true);
+		cmd->ucmd.ccmd.cc_true = Nullcmd;
+	    }
+	    break;
+	case C_EXPR:
+	    if (cmd->ucmd.acmd.ac_expr) {
+		arg_free(cmd->ucmd.acmd.ac_expr);
+		cmd->ucmd.acmd.ac_expr = Nullarg;
+	    }
+	    break;
+	}
+	tofree = cmd;
+	cmd = cmd->c_next;
+	if (tofree != head)		/* to get Saber to shut up */
+	    Safefree(tofree);
+	if (cmd && cmd == head)		/* reached end of while loop */
+	    break;
+    }
+    Safefree(head);
+}
+
+void
+arg_free(arg)
+register ARG *arg;
+{
+    register int i;
+
+    if (!arg)
+	return;
+    for (i = 1; i <= arg->arg_len; i++) {
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    if (arg->arg_type == O_TRANS) {
+		Safefree(arg[i].arg_ptr.arg_cval);
+		arg[i].arg_ptr.arg_cval = Nullch;
+	    }
+	    break;
+	case A_LEXPR:
+	    if (arg->arg_type == O_AASSIGN &&
+	      arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
+		char *name = 
+		  stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
+
+		if (strnEQ("_GEN_",name, 5))	/* array for foreach */
+		    hdelete(defstash,name,strlen(name));
+	    }
+	    /* FALL THROUGH */
+	case A_EXPR:
+	    arg_free(arg[i].arg_ptr.arg_arg);
+	    arg[i].arg_ptr.arg_arg = Nullarg;
+	    break;
+	case A_CMD:
+	    cmd_free(arg[i].arg_ptr.arg_cmd);
+	    arg[i].arg_ptr.arg_cmd = Nullcmd;
+	    break;
+	case A_WORD:
+	case A_STAB:
+	case A_LVAL:
+	case A_READ:
+	case A_GLOB:
+	case A_ARYLEN:
+	case A_LARYLEN:
+	case A_ARYSTAB:
+	case A_LARYSTAB:
+	    break;
+	case A_SINGLE:
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    str_free(arg[i].arg_ptr.arg_str);
+	    arg[i].arg_ptr.arg_str = Nullstr;
+	    break;
+	case A_SPAT:
+	    spat_free(arg[i].arg_ptr.arg_spat);
+	    arg[i].arg_ptr.arg_spat = Nullspat;
+	    break;
+	}
+    }
+    free_arg(arg);
+}
+
+void
+spat_free(spat)
+register SPAT *spat;
+{
+    register SPAT *sp;
+    HENT *entry;
+
+    if (!spat)
+	return;
+    if (spat->spat_runtime) {
+	arg_free(spat->spat_runtime);
+	spat->spat_runtime = Nullarg;
+    }
+    if (spat->spat_repl) {
+	arg_free(spat->spat_repl);
+	spat->spat_repl = Nullarg;
+    }
+    if (spat->spat_short) {
+	str_free(spat->spat_short);
+	spat->spat_short = Nullstr;
+    }
+    if (spat->spat_regexp) {
+	regfree(spat->spat_regexp);
+	spat->spat_regexp = Null(REGEXP*);
+    }
+
+    /* now unlink from spat list */
+
+    for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
+	register HASH *stash;
+	STAB *stab = (STAB*)entry->hent_val;
+
+	if (!stab)
+	    continue;
+	stash = stab_hash(stab);
+	if (!stash || stash->tbl_spatroot == Null(SPAT*))
+	    continue;
+	if (stash->tbl_spatroot == spat)
+	    stash->tbl_spatroot = spat->spat_next;
+	else {
+	    for (sp = stash->tbl_spatroot;
+	      sp && sp->spat_next != spat;
+	      sp = sp->spat_next)
+		/*SUPPRESS 530*/
+		;
+	    if (sp)
+		sp->spat_next = spat->spat_next;
+	}
+    }
+    Safefree(spat);
+}
+
+/* Recursively descend a command sequence and push the address of any string
+ * that needs saving on recursion onto the tosave array.
+ */
+
+static int
+cmd_tosave(cmd,willsave)
+register CMD *cmd;
+int willsave;				/* willsave passes down the tree */
+{
+    register CMD *head = cmd;
+    int shouldsave = FALSE;		/* shouldsave passes up the tree */
+    int tmpsave;
+    register CMD *lastcmd = Nullcmd;
+
+    while (cmd) {
+	if (cmd->c_expr)
+	    shouldsave |= arg_tosave(cmd->c_expr,willsave);
+	switch (cmd->c_type) {
+	case C_WHILE:
+	    if (cmd->ucmd.ccmd.cc_true) {
+		tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
+
+		/* Here we check to see if the temporary array generated for
+		 * a foreach needs to be localized because of recursion.
+		 */
+		if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
+		    if (lastcmd &&
+		      lastcmd->c_type == C_EXPR &&
+		      lastcmd->c_expr) {
+			ARG *arg = lastcmd->c_expr;
+
+			if (arg->arg_type == O_ASSIGN &&
+			    arg[1].arg_type == A_LEXPR &&
+			    arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
+			    strnEQ("_GEN_",
+			      stab_name(
+				arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
+			      5)) {	/* array generated for foreach */
+			    (void)localize(arg);
+			}
+		    }
+
+		    /* in any event, save the iterator */
+
+		    if (cmd->c_short)  /* Better safe than sorry */
+			(void)apush(tosave,cmd->c_short);
+		}
+		shouldsave |= tmpsave;
+	    }
+	    break;
+	case C_BLOCK:
+	case C_ELSE:
+	case C_IF:
+	    if (cmd->ucmd.ccmd.cc_true)
+		shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
+	    break;
+	case C_EXPR:
+	    if (cmd->ucmd.acmd.ac_expr)
+		shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
+	    break;
+	}
+	lastcmd = cmd;
+	cmd = cmd->c_next;
+	if (cmd && cmd == head)		/* reached end of while loop */
+	    break;
+    }
+    return shouldsave;
+}
+
+static int
+arg_tosave(arg,willsave)
+register ARG *arg;
+int willsave;
+{
+    register int i;
+    int shouldsave = FALSE;
+
+    for (i = arg->arg_len; i >= 1; i--) {
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    break;
+	case A_LEXPR:
+	case A_EXPR:
+	    shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
+	    break;
+	case A_CMD:
+	    shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
+	    break;
+	case A_WORD:
+	case A_STAB:
+	case A_LVAL:
+	case A_READ:
+	case A_GLOB:
+	case A_ARYLEN:
+	case A_SINGLE:
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    break;
+	case A_SPAT:
+	    shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
+	    break;
+	}
+    }
+    switch (arg->arg_type) {
+    case O_RETURN:
+	saw_return = TRUE;
+	break;
+    case O_EVAL:
+    case O_SUBR:
+	shouldsave = TRUE;
+	break;
+    }
+    if (willsave && arg->arg_ptr.arg_str)
+	(void)apush(tosave,arg->arg_ptr.arg_str);
+    return shouldsave;
+}
+
+static int
+spat_tosave(spat)
+register SPAT *spat;
+{
+    int shouldsave = FALSE;
+
+    if (spat->spat_runtime)
+	shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
+    if (spat->spat_repl) {
+	shouldsave |= arg_tosave(spat->spat_repl,FALSE);
+    }
+
+    return shouldsave;
+}
+
diff --git a/gnu/usr.bin/perl/perl/consarg.c b/gnu/usr.bin/perl/perl/consarg.c
new file mode 100644
index 000000000000..2c28afb6efa4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/consarg.c
@@ -0,0 +1,1292 @@
+/* $RCSfile: consarg.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: consarg.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  12:26:27  lwall
+ * patch20: new warning for use of x with non-numeric right operand
+ * patch20: modulus with highest bit in left operand set didn't always work
+ * patch20: illegal lvalue message could be followed by core dump
+ * patch20: deleted some minor memory leaks
+ * 
+ * Revision 4.0.1.3  91/11/05  16:21:16  lwall
+ * patch11: random cleanup
+ * patch11: added eval {}
+ * patch11: added sort {} LIST
+ * patch11: "foo" x -1 dumped core
+ * patch11: substr() and vec() weren't allowed in an lvalue list
+ * 
+ * Revision 4.0.1.2  91/06/07  10:33:12  lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * 
+ * Revision 4.0.1.1  91/04/11  17:38:34  lwall
+ * patch1: fixed "Bad free" error
+ * 
+ * Revision 4.0  91/03/20  01:06:15  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+static int nothing_in_common();
+static int arg_common();
+static int spat_common();
+
+ARG *
+make_split(stab,arg,limarg)
+register STAB *stab;
+register ARG *arg;
+ARG *limarg;
+{
+    register SPAT *spat;
+
+    if (arg->arg_type != O_MATCH) {
+	Newz(201,spat,1,SPAT);
+	spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
+	curstash->tbl_spatroot = spat;
+
+	spat->spat_runtime = arg;
+	arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
+    }
+    Renew(arg,4,ARG);
+    arg->arg_len = 3;
+    if (limarg) {
+	if (limarg->arg_type == O_ITEM) {
+	    Copy(limarg+1,arg+3,1,ARG);
+	    limarg[1].arg_type = A_NULL;
+	    arg_free(limarg);
+	}
+	else {
+	    arg[3].arg_flags = 0;
+	    arg[3].arg_len = 0;
+	    arg[3].arg_type = A_EXPR;
+	    arg[3].arg_ptr.arg_arg = limarg;
+	}
+    }
+    else {
+	arg[3].arg_flags = 0;
+	arg[3].arg_len = 0;
+	arg[3].arg_type = A_NULL;
+	arg[3].arg_ptr.arg_arg = Nullarg;
+    }
+    arg->arg_type = O_SPLIT;
+    spat = arg[2].arg_ptr.arg_spat;
+    spat->spat_repl = stab2arg(A_STAB,aadd(stab));
+    if (spat->spat_short) {	/* exact match can bypass regexec() */
+	if (!((spat->spat_flags & SPAT_SCANFIRST) &&
+	    (spat->spat_flags & SPAT_ALL) )) {
+	    str_free(spat->spat_short);
+	    spat->spat_short = Nullstr;
+	}
+    }
+    return arg;
+}
+
+ARG *
+mod_match(type,left,pat)
+register ARG *left;
+register ARG *pat;
+{
+
+    register SPAT *spat;
+    register ARG *newarg;
+
+    if (!pat)
+	return Nullarg;
+
+    if ((pat->arg_type == O_MATCH ||
+	 pat->arg_type == O_SUBST ||
+	 pat->arg_type == O_TRANS ||
+	 pat->arg_type == O_SPLIT
+	) &&
+	pat[1].arg_ptr.arg_stab == defstab ) {
+	switch (pat->arg_type) {
+	case O_MATCH:
+	    newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
+		pat->arg_len,
+		left,Nullarg,Nullarg);
+	    break;
+	case O_SUBST:
+	    newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
+		pat->arg_len,
+		left,Nullarg,Nullarg));
+	    break;
+	case O_TRANS:
+	    newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
+		pat->arg_len,
+		left,Nullarg,Nullarg));
+	    break;
+	case O_SPLIT:
+	    newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
+		pat->arg_len,
+		left,Nullarg,Nullarg);
+	    break;
+	}
+	if (pat->arg_len >= 2) {
+	    newarg[2].arg_type = pat[2].arg_type;
+	    newarg[2].arg_ptr = pat[2].arg_ptr;
+	    newarg[2].arg_len = pat[2].arg_len;
+	    newarg[2].arg_flags = pat[2].arg_flags;
+	    if (pat->arg_len >= 3) {
+		newarg[3].arg_type = pat[3].arg_type;
+		newarg[3].arg_ptr = pat[3].arg_ptr;
+		newarg[3].arg_len = pat[3].arg_len;
+		newarg[3].arg_flags = pat[3].arg_flags;
+	    }
+	}
+	free_arg(pat);
+    }
+    else {
+	Newz(202,spat,1,SPAT);
+	spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
+	curstash->tbl_spatroot = spat;
+
+	spat->spat_runtime = pat;
+	newarg = make_op(type,2,left,Nullarg,Nullarg);
+	newarg[2].arg_type = A_SPAT | A_DONT;
+	newarg[2].arg_ptr.arg_spat = spat;
+    }
+
+    return newarg;
+}
+
+ARG *
+make_op(type,newlen,arg1,arg2,arg3)
+int type;
+int newlen;
+ARG *arg1;
+ARG *arg2;
+ARG *arg3;
+{
+    register ARG *arg;
+    register ARG *chld;
+    register unsigned doarg;
+    register int i;
+    extern ARG *arg4;	/* should be normal arguments, really */
+    extern ARG *arg5;
+
+    arg = op_new(newlen);
+    arg->arg_type = type;
+    /*SUPPRESS 560*/
+    if (chld = arg1) {
+	if (chld->arg_type == O_ITEM &&
+	    (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
+	     (i == A_LEXPR &&
+	      (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
+	       chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
+	       chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
+	{
+	    arg[1].arg_type = chld[1].arg_type;
+	    arg[1].arg_ptr = chld[1].arg_ptr;
+	    arg[1].arg_flags |= chld[1].arg_flags;
+	    arg[1].arg_len = chld[1].arg_len;
+	    free_arg(chld);
+	}
+	else {
+	    arg[1].arg_type = A_EXPR;
+	    arg[1].arg_ptr.arg_arg = chld;
+	}
+    }
+    /*SUPPRESS 560*/
+    if (chld = arg2) {
+	if (chld->arg_type == O_ITEM && 
+	    (hoistable[chld[1].arg_type&A_MASK] || 
+	     (type == O_ASSIGN && 
+	      ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
+		||
+	       (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
+		||
+	       (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
+	      ) ) ) ) {
+	    arg[2].arg_type = chld[1].arg_type;
+	    arg[2].arg_ptr = chld[1].arg_ptr;
+	    arg[2].arg_len = chld[1].arg_len;
+	    free_arg(chld);
+	}
+	else {
+	    arg[2].arg_type = A_EXPR;
+	    arg[2].arg_ptr.arg_arg = chld;
+	}
+    }
+    /*SUPPRESS 560*/
+    if (chld = arg3) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
+	    arg[3].arg_type = chld[1].arg_type;
+	    arg[3].arg_ptr = chld[1].arg_ptr;
+	    arg[3].arg_len = chld[1].arg_len;
+	    free_arg(chld);
+	}
+	else {
+	    arg[3].arg_type = A_EXPR;
+	    arg[3].arg_ptr.arg_arg = chld;
+	}
+    }
+    if (newlen >= 4 && (chld = arg4)) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
+	    arg[4].arg_type = chld[1].arg_type;
+	    arg[4].arg_ptr = chld[1].arg_ptr;
+	    arg[4].arg_len = chld[1].arg_len;
+	    free_arg(chld);
+	}
+	else {
+	    arg[4].arg_type = A_EXPR;
+	    arg[4].arg_ptr.arg_arg = chld;
+	}
+    }
+    if (newlen >= 5 && (chld = arg5)) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
+	    arg[5].arg_type = chld[1].arg_type;
+	    arg[5].arg_ptr = chld[1].arg_ptr;
+	    arg[5].arg_len = chld[1].arg_len;
+	    free_arg(chld);
+	}
+	else {
+	    arg[5].arg_type = A_EXPR;
+	    arg[5].arg_ptr.arg_arg = chld;
+	}
+    }
+    doarg = opargs[type];
+    for (i = 1; i <= newlen; ++i) {
+	if (!(doarg & 1))
+	    arg[i].arg_type |= A_DONT;
+	if (doarg & 2)
+	    arg[i].arg_flags |= AF_ARYOK;
+	doarg >>= 2;
+    }
+#ifdef DEBUGGING
+    if (debug & 16) {
+	fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
+	if (arg1)
+	    fprintf(stderr,",%s=%lx",
+		argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
+	if (arg2)
+	    fprintf(stderr,",%s=%lx",
+		argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
+	if (arg3)
+	    fprintf(stderr,",%s=%lx",
+		argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
+	if (newlen >= 4)
+	    fprintf(stderr,",%s=%lx",
+		argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
+	if (newlen >= 5)
+	    fprintf(stderr,",%s=%lx",
+		argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
+	fprintf(stderr,")\n");
+    }
+#endif
+    arg = evalstatic(arg);	/* see if we can consolidate anything */
+    return arg;
+}
+
+ARG *
+evalstatic(arg)
+register ARG *arg;
+{
+    static STR *str = Nullstr;
+    register STR *s1;
+    register STR *s2;
+    double value;		/* must not be register */
+    register char *tmps;
+    int i;
+    unsigned long tmplong;
+    long tmp2;
+    double exp(), log(), sqrt(), modf();
+    char *crypt();
+    double sin(), cos(), atan2(), pow();
+
+    if (!arg || !arg->arg_len)
+	return arg;
+
+    if (!str)
+	str = Str_new(20,0);
+
+    if (arg[1].arg_type == A_SINGLE)
+	s1 = arg[1].arg_ptr.arg_str;
+    else
+	s1 = Nullstr;
+    if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
+	s2 = arg[2].arg_ptr.arg_str;
+    else
+	s2 = Nullstr;
+
+#define CHECK1 if (!s1) return arg
+#define CHECK2 if (!s2) return arg
+#define CHECK12 if (!s1 || !s2) return arg
+
+    switch (arg->arg_type) {
+    default:
+	return arg;
+    case O_SORT:
+	if (arg[1].arg_type == A_CMD)
+	    arg[1].arg_type |= A_DONT;
+	return arg;
+    case O_EVAL:
+	if (arg[1].arg_type == A_CMD) {
+	    arg->arg_type = O_TRY;
+	    arg[1].arg_type |= A_DONT;
+	    return arg;
+	}
+	CHECK1;
+	arg->arg_type = O_EVALONCE;
+	return arg;
+    case O_AELEM:
+	CHECK2;
+	i = (int)str_gnum(s2);
+	if (i < 32767 && i >= 0) {
+	    arg->arg_type = O_ITEM;
+	    arg->arg_len = 1;
+	    arg[1].arg_type = A_ARYSTAB;	/* $abc[123] is hoistable now */
+	    arg[1].arg_len = i;
+	    str_free(s2);
+	    Renew(arg, 2, ARG);
+	}
+	return arg;
+    case O_CONCAT:
+	CHECK12;
+	str_sset(str,s1);
+	str_scat(str,s2);
+	break;
+    case O_REPEAT:
+	CHECK2;
+	if (dowarn && !s2->str_nok && !looks_like_number(s2))
+	    warn("Right operand of x is not numeric");
+	CHECK1;
+	i = (int)str_gnum(s2);
+	tmps = str_get(s1);
+	str_nset(str,"",0);
+	if (i > 0) {
+	    STR_GROW(str, i * s1->str_cur + 1);
+	    repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
+	    str->str_cur = i * s1->str_cur;
+	    str->str_ptr[str->str_cur] = '\0';
+	}
+	break;
+    case O_MULTIPLY:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value * str_gnum(s2));
+	break;
+    case O_DIVIDE:
+	CHECK12;
+	value = str_gnum(s2);
+	if (value == 0.0)
+	    yyerror("Illegal division by constant zero");
+	else
+#ifdef SLOPPYDIVIDE
+	/* insure that 20./5. == 4. */
+	{
+	    double x;
+	    int    k;
+	    x =  str_gnum(s1);
+	    if ((double)(int)x     == x &&
+		(double)(int)value == value &&
+		(k = (int)x/(int)value)*(int)value == (int)x) {
+		value = k;
+	    } else {
+		value = x/value;
+	    }
+	    str_numset(str,value);
+	}
+#else
+	str_numset(str,str_gnum(s1) / value);
+#endif
+	break;
+    case O_MODULO:
+	CHECK12;
+	tmplong = (unsigned long)str_gnum(s2);
+	if (tmplong == 0L) {
+	    yyerror("Illegal modulus of constant zero");
+	    return arg;
+	}
+	value = str_gnum(s1);
+#ifndef lint
+	if (value >= 0.0)
+	    str_numset(str,(double)(((unsigned long)value) % tmplong));
+	else {
+	    tmp2 = (long)value;
+	    str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
+	}
+#else
+	tmp2 = tmp2;
+#endif
+	break;
+    case O_ADD:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value + str_gnum(s2));
+	break;
+    case O_SUBTRACT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value - str_gnum(s2));
+	break;
+    case O_LEFT_SHIFT:
+	CHECK12;
+	value = str_gnum(s1);
+	i = (int)str_gnum(s2);
+#ifndef lint
+	str_numset(str,(double)(((long)value) << i));
+#endif
+	break;
+    case O_RIGHT_SHIFT:
+	CHECK12;
+	value = str_gnum(s1);
+	i = (int)str_gnum(s2);
+#ifndef lint
+	str_numset(str,(double)(((long)value) >> i));
+#endif
+	break;
+    case O_LT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_GT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_LE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_GE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_EQ:
+	CHECK12;
+	if (dowarn) {
+	    if ((!s1->str_nok && !looks_like_number(s1)) ||
+		(!s2->str_nok && !looks_like_number(s2)) )
+		warn("Possible use of == on string value");
+	}
+	value = str_gnum(s1);
+	str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_NE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_NCMP:
+	CHECK12;
+	value = str_gnum(s1);
+	value -= str_gnum(s2);
+	if (value > 0.0)
+	    value = 1.0;
+	else if (value < 0.0)
+	    value = -1.0;
+	str_numset(str,value);
+	break;
+    case O_BIT_AND:
+	CHECK12;
+	value = str_gnum(s1);
+#ifndef lint
+	str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
+#endif
+	break;
+    case O_XOR:
+	CHECK12;
+	value = str_gnum(s1);
+#ifndef lint
+	str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
+#endif
+	break;
+    case O_BIT_OR:
+	CHECK12;
+	value = str_gnum(s1);
+#ifndef lint
+	str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
+#endif
+	break;
+    case O_AND:
+	CHECK12;
+	if (str_true(s1))
+	    str_sset(str,s2);
+	else
+	    str_sset(str,s1);
+	break;
+    case O_OR:
+	CHECK12;
+	if (str_true(s1))
+	    str_sset(str,s1);
+	else
+	    str_sset(str,s2);
+	break;
+    case O_COND_EXPR:
+	CHECK12;
+	if ((arg[3].arg_type & A_MASK) != A_SINGLE)
+	    return arg;
+	if (str_true(s1))
+	    str_sset(str,s2);
+	else
+	    str_sset(str,arg[3].arg_ptr.arg_str);
+	str_free(arg[3].arg_ptr.arg_str);
+	Renew(arg, 3, ARG);
+	break;
+    case O_NEGATE:
+	CHECK1;
+	str_numset(str,(double)(-str_gnum(s1)));
+	break;
+    case O_NOT:
+	CHECK1;
+#ifdef NOTNOT
+	{ char xxx = str_true(s1); str_numset(str,(double)!xxx); }
+#else
+	str_numset(str,(double)(!str_true(s1)));
+#endif
+	break;
+    case O_COMPLEMENT:
+	CHECK1;
+#ifndef lint
+	str_numset(str,(double)(~U_L(str_gnum(s1))));
+#endif
+	break;
+    case O_SIN:
+	CHECK1;
+	str_numset(str,sin(str_gnum(s1)));
+	break;
+    case O_COS:
+	CHECK1;
+	str_numset(str,cos(str_gnum(s1)));
+	break;
+    case O_ATAN2:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,atan2(value, str_gnum(s2)));
+	break;
+    case O_POW:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,pow(value, str_gnum(s2)));
+	break;
+    case O_LENGTH:
+	if (arg[1].arg_type == A_STAB) {
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_LENSTAB;
+	    return arg;
+	}
+	CHECK1;
+	str_numset(str, (double)str_len(s1));
+	break;
+    case O_SLT:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) < 0));
+	break;
+    case O_SGT:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) > 0));
+	break;
+    case O_SLE:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) <= 0));
+	break;
+    case O_SGE:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) >= 0));
+	break;
+    case O_SEQ:
+	CHECK12;
+	str_numset(str,(double)(str_eq(s1,s2)));
+	break;
+    case O_SNE:
+	CHECK12;
+	str_numset(str,(double)(!str_eq(s1,s2)));
+	break;
+    case O_SCMP:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2)));
+	break;
+    case O_CRYPT:
+	CHECK12;
+#ifdef HAS_CRYPT
+	tmps = str_get(s1);
+	str_set(str,crypt(tmps,str_get(s2)));
+#else
+	yyerror(
+	"The crypt() function is unimplemented due to excessive paranoia.");
+#endif
+	break;
+    case O_EXP:
+	CHECK1;
+	str_numset(str,exp(str_gnum(s1)));
+	break;
+    case O_LOG:
+	CHECK1;
+	str_numset(str,log(str_gnum(s1)));
+	break;
+    case O_SQRT:
+	CHECK1;
+	str_numset(str,sqrt(str_gnum(s1)));
+	break;
+    case O_INT:
+	CHECK1;
+	value = str_gnum(s1);
+	if (value >= 0.0)
+	    (void)modf(value,&value);
+	else {
+	    (void)modf(-value,&value);
+	    value = -value;
+	}
+	str_numset(str,value);
+	break;
+    case O_ORD:
+	CHECK1;
+#ifndef I286
+	str_numset(str,(double)(*str_get(s1)));
+#else
+	{
+	    int  zapc;
+	    char *zaps;
+
+	    zaps = str_get(s1);
+	    zapc = (int) *zaps;
+	    str_numset(str,(double)(zapc));
+	}
+#endif
+	break;
+    }
+    arg->arg_type = O_ITEM;	/* note arg1 type is already SINGLE */
+    str_free(s1);
+    arg[1].arg_ptr.arg_str = str;
+    if (s2) {
+	str_free(s2);
+	arg[2].arg_ptr.arg_str = Nullstr;
+	arg[2].arg_type = A_NULL;
+    }
+    str = Nullstr;
+
+    return arg;
+}
+
+ARG *
+l(arg)
+register ARG *arg;
+{
+    register int i;
+    register ARG *arg1;
+    register ARG *arg2;
+    SPAT *spat;
+    int arghog = 0;
+
+    i = arg[1].arg_type & A_MASK;
+
+    arg->arg_flags |= AF_COMMON;	/* assume something in common */
+					/* which forces us to copy things */
+
+    if (i == A_ARYLEN) {
+	arg[1].arg_type = A_LARYLEN;
+	return arg;
+    }
+    if (i == A_ARYSTAB) {
+	arg[1].arg_type = A_LARYSTAB;
+	return arg;
+    }
+
+    /* see if it's an array reference */
+
+    if (i == A_EXPR || i == A_LEXPR) {
+	arg1 = arg[1].arg_ptr.arg_arg;
+
+	if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
+						/* assign to list */
+	    if (arg->arg_len > 1) {
+		dehoist(arg,2);
+		arg2 = arg[2].arg_ptr.arg_arg;
+		if (nothing_in_common(arg1,arg2))
+		    arg->arg_flags &= ~AF_COMMON;
+		if (arg->arg_type == O_ASSIGN) {
+		    if (arg1->arg_flags & AF_LOCAL)
+			arg->arg_flags |= AF_LOCAL;
+		    arg[1].arg_flags |= AF_ARYOK;
+		    arg[2].arg_flags |= AF_ARYOK;
+		}
+	    }
+	    else if (arg->arg_type != O_CHOP)
+		arg->arg_type = O_ASSIGN;	/* possible local(); */
+	    for (i = arg1->arg_len; i >= 1; i--) {
+		switch (arg1[i].arg_type) {
+		case A_STAR: case A_LSTAR:
+		    arg1[i].arg_type = A_LSTAR;
+		    break;
+		case A_STAB: case A_LVAL:
+		    arg1[i].arg_type = A_LVAL;
+		    break;
+		case A_ARYLEN: case A_LARYLEN:
+		    arg1[i].arg_type = A_LARYLEN;
+		    break;
+		case A_ARYSTAB: case A_LARYSTAB:
+		    arg1[i].arg_type = A_LARYSTAB;
+		    break;
+		case A_EXPR: case A_LEXPR:
+		    arg1[i].arg_type = A_LEXPR;
+		    switch(arg1[i].arg_ptr.arg_arg->arg_type) {
+		    case O_ARRAY: case O_LARRAY:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
+			arghog = 1;
+			break;
+		    case O_AELEM: case O_LAELEM:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
+			break;
+		    case O_HASH: case O_LHASH:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
+			arghog = 1;
+			break;
+		    case O_HELEM: case O_LHELEM:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
+			break;
+		    case O_ASLICE: case O_LASLICE:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
+			break;
+		    case O_HSLICE: case O_LHSLICE:
+			arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
+			break;
+		    case O_SUBSTR: case O_VEC:
+			(void)l(arg1[i].arg_ptr.arg_arg);
+			Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1,
+			  struct lstring, STR);
+			    /* grow string struct to hold an lstring struct */
+			break;
+		    default:
+			goto ill_item;
+		    }
+		    break;
+		default:
+		  ill_item:
+		    (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
+		      argname[arg1[i].arg_type&A_MASK]);
+		    yyerror(tokenbuf);
+		}
+	    }
+	    if (arg->arg_len > 1) {
+		if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
+		    arg2[3].arg_type = A_SINGLE;
+		    arg2[3].arg_ptr.arg_str =
+		      str_nmake((double)arg1->arg_len + 1); /* limit split len*/
+		}
+	    }
+	}
+	else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
+	    if (arg->arg_type == O_DEFINED)
+		arg1->arg_type = O_AELEM;
+	    else
+		arg1->arg_type = O_LAELEM;
+	else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
+	    arg1->arg_type = O_LARRAY;
+	    if (arg->arg_len > 1) {
+		dehoist(arg,2);
+		arg2 = arg[2].arg_ptr.arg_arg;
+		if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
+		    spat = arg2[2].arg_ptr.arg_spat;
+		    if (!(spat->spat_flags & SPAT_ONCE) &&
+		      nothing_in_common(arg1,spat->spat_repl)) {
+			spat->spat_repl[1].arg_ptr.arg_stab =
+			    arg1[1].arg_ptr.arg_stab;
+			arg1[1].arg_ptr.arg_stab = Nullstab;
+			spat->spat_flags |= SPAT_ONCE;
+			arg_free(arg1);	/* recursive */
+			arg[1].arg_ptr.arg_arg = Nullarg;
+			free_arg(arg);	/* non-recursive */
+			return arg2;	/* split has builtin assign */
+		    }
+		}
+		else if (nothing_in_common(arg1,arg2))
+		    arg->arg_flags &= ~AF_COMMON;
+		if (arg->arg_type == O_ASSIGN) {
+		    arg[1].arg_flags |= AF_ARYOK;
+		    arg[2].arg_flags |= AF_ARYOK;
+		}
+	    }
+	    else if (arg->arg_type == O_ASSIGN)
+		arg[1].arg_flags |= AF_ARYOK;
+	}
+	else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
+	    if (arg->arg_type == O_DEFINED)
+		arg1->arg_type = O_HELEM;	/* avoid creating one */
+	    else
+		arg1->arg_type = O_LHELEM;
+	else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
+	    arg1->arg_type = O_LHASH;
+	    if (arg->arg_len > 1) {
+		dehoist(arg,2);
+		arg2 = arg[2].arg_ptr.arg_arg;
+		if (nothing_in_common(arg1,arg2))
+		    arg->arg_flags &= ~AF_COMMON;
+		if (arg->arg_type == O_ASSIGN) {
+		    arg[1].arg_flags |= AF_ARYOK;
+		    arg[2].arg_flags |= AF_ARYOK;
+		}
+	    }
+	    else if (arg->arg_type == O_ASSIGN)
+		arg[1].arg_flags |= AF_ARYOK;
+	}
+	else if (arg1->arg_type == O_ASLICE) {
+	    arg1->arg_type = O_LASLICE;
+	    if (arg->arg_type == O_ASSIGN) {
+		dehoist(arg,2);
+		arg[1].arg_flags |= AF_ARYOK;
+		arg[2].arg_flags |= AF_ARYOK;
+	    }
+	}
+	else if (arg1->arg_type == O_HSLICE) {
+	    arg1->arg_type = O_LHSLICE;
+	    if (arg->arg_type == O_ASSIGN) {
+		dehoist(arg,2);
+		arg[1].arg_flags |= AF_ARYOK;
+		arg[2].arg_flags |= AF_ARYOK;
+	    }
+	}
+	else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
+	  (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
+	    arg[1].arg_type |= A_DONT;
+	}
+	else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
+	    (void)l(arg1);
+	    Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
+			/* grow string struct to hold an lstring struct */
+	}
+	else if (arg1->arg_type == O_ASSIGN)
+	    /*SUPPRESS 530*/
+	    ;
+	else {
+	    (void)sprintf(tokenbuf,
+	      "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
+	    yyerror(tokenbuf);
+	    return arg;
+	}
+	arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
+	if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
+	    arg[1].arg_flags |= AF_ARYOK;
+	    if (arg->arg_len > 1)
+		arg[2].arg_flags |= AF_ARYOK;
+	}
+#ifdef DEBUGGING
+	if (debug & 16)
+	    fprintf(stderr,"lval LEXPR\n");
+#endif
+	return arg;
+    }
+    if (i == A_STAR || i == A_LSTAR) {
+	arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
+	return arg;
+    }
+
+    /* not an array reference, should be a register name */
+
+    if (i != A_STAB && i != A_LVAL) {
+	(void)sprintf(tokenbuf,
+	  "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
+	yyerror(tokenbuf);
+	return arg;
+    }
+    arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
+#ifdef DEBUGGING
+    if (debug & 16)
+	fprintf(stderr,"lval LVAL\n");
+#endif
+    return arg;
+}
+
+ARG *
+fixl(type,arg)
+int type;
+ARG *arg;
+{
+    if (type == O_DEFINED || type == O_UNDEF) {
+	if (arg->arg_type != O_ITEM)
+	    arg = hide_ary(arg);
+	if (arg->arg_type == O_ITEM) {
+	    type = arg[1].arg_type & A_MASK;
+	    if (type == A_EXPR || type == A_LEXPR)
+		arg[1].arg_type = A_LEXPR|A_DONT;
+	}
+    }
+    return arg;
+}
+
+void
+dehoist(arg,i)
+ARG *arg;
+{
+    ARG *tmparg;
+
+    if (arg[i].arg_type != A_EXPR) {	/* dehoist */
+	tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
+	tmparg[1] = arg[i];
+	arg[i].arg_ptr.arg_arg = tmparg;
+	arg[i].arg_type = A_EXPR;
+    }
+}
+
+ARG *
+addflags(i,flags,arg)
+register ARG *arg;
+{
+    arg[i].arg_flags |= flags;
+    return arg;
+}
+
+ARG *
+hide_ary(arg)
+ARG *arg;
+{
+    if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
+	return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
+    return arg;
+}
+
+/* maybe do a join on multiple array dimensions */
+
+ARG *
+jmaybe(arg)
+register ARG *arg;
+{
+    if (arg && arg->arg_type == O_COMMA) {
+	arg = listish(arg);
+	arg = make_op(O_JOIN, 2,
+	    stab2arg(A_STAB,stabent(";",TRUE)),
+	    make_list(arg),
+	    Nullarg);
+    }
+    return arg;
+}
+
+ARG *
+make_list(arg)
+register ARG *arg;
+{
+    register int i;
+    register ARG *node;
+    register ARG *nxtnode;
+    register int j;
+    STR *tmpstr;
+
+    if (!arg) {
+	arg = op_new(0);
+	arg->arg_type = O_LIST;
+    }
+    if (arg->arg_type != O_COMMA) {
+	if (arg->arg_type != O_ARRAY)
+	    arg->arg_flags |= AF_LISTISH;	/* see listish() below */
+	    arg->arg_flags |= AF_LISTISH;	/* see listish() below */
+	return arg;
+    }
+    for (i = 2, node = arg; ; i++) {
+	if (node->arg_len < 2)
+	    break;
+        if (node[1].arg_type != A_EXPR)
+	    break;
+	node = node[1].arg_ptr.arg_arg;
+	if (node->arg_type != O_COMMA)
+	    break;
+    }
+    if (i > 2) {
+	node = arg;
+	arg = op_new(i);
+	tmpstr = arg->arg_ptr.arg_str;
+	StructCopy(node, arg, ARG);	/* copy everything except the STR */
+	arg->arg_ptr.arg_str = tmpstr;
+	for (j = i; ; ) {
+	    StructCopy(node+2, arg+j, ARG);
+	    arg[j].arg_flags |= AF_ARYOK;
+	    --j;		/* Bug in Xenix compiler */
+	    if (j < 2) {
+		StructCopy(node+1, arg+1, ARG);
+		free_arg(node);
+		break;
+	    }
+	    nxtnode = node[1].arg_ptr.arg_arg;
+	    free_arg(node);
+	    node = nxtnode;
+	}
+    }
+    arg[1].arg_flags |= AF_ARYOK;
+    arg[2].arg_flags |= AF_ARYOK;
+    arg->arg_type = O_LIST;
+    arg->arg_len = i;
+    str_free(arg->arg_ptr.arg_str);
+    arg->arg_ptr.arg_str = Nullstr;
+    return arg;
+}
+
+/* turn a single item into a list */
+
+ARG *
+listish(arg)
+ARG *arg;
+{
+    if (arg && arg->arg_flags & AF_LISTISH)
+	arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
+    return arg;
+}
+
+ARG *
+maybelistish(optype, arg)
+int optype;
+ARG *arg;
+{
+    ARG *tmparg = arg;
+
+    if (optype == O_RETURN && arg->arg_type == O_ITEM &&
+      arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
+      ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
+	tmparg = listish(tmparg);
+	free_arg(arg);
+	arg = tmparg;
+    }
+    else if (optype == O_PRTF ||
+      (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
+       arg->arg_type == O_F_OR_R) )
+	arg = listish(arg);
+    return arg;
+}
+
+/* mark list of local variables */
+
+ARG *
+localize(arg)
+ARG *arg;
+{
+    arg->arg_flags |= AF_LOCAL;
+    return arg;
+}
+
+ARG *
+rcatmaybe(arg)
+ARG *arg;
+{
+    ARG *arg2;
+
+    if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
+	arg2 = arg[2].arg_ptr.arg_arg;
+	if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
+	    arg->arg_type = O_RCAT;	
+	    arg[2].arg_type = arg2[1].arg_type;
+	    arg[2].arg_ptr = arg2[1].arg_ptr;
+	    free_arg(arg2);
+	}
+    }
+    return arg;
+}
+
+ARG *
+stab2arg(atype,stab)
+int atype;
+register STAB *stab;
+{
+    register ARG *arg;
+
+    arg = op_new(1);
+    arg->arg_type = O_ITEM;
+    arg[1].arg_type = atype;
+    arg[1].arg_ptr.arg_stab = stab;
+    return arg;
+}
+
+ARG *
+cval_to_arg(cval)
+register char *cval;
+{
+    register ARG *arg;
+
+    arg = op_new(1);
+    arg->arg_type = O_ITEM;
+    arg[1].arg_type = A_SINGLE;
+    arg[1].arg_ptr.arg_str = str_make(cval,0);
+    Safefree(cval);
+    return arg;
+}
+
+ARG *
+op_new(numargs)
+int numargs;
+{
+    register ARG *arg;
+
+    Newz(203,arg, numargs + 1, ARG);
+    arg->arg_ptr.arg_str = Str_new(21,0);
+    arg->arg_len = numargs;
+    return arg;
+}
+
+void
+free_arg(arg)
+ARG *arg;
+{
+    str_free(arg->arg_ptr.arg_str);
+    Safefree(arg);
+}
+
+ARG *
+make_match(type,expr,spat)
+int type;
+ARG *expr;
+SPAT *spat;
+{
+    register ARG *arg;
+
+    arg = make_op(type,2,expr,Nullarg,Nullarg);
+
+    arg[2].arg_type = A_SPAT|A_DONT;
+    arg[2].arg_ptr.arg_spat = spat;
+#ifdef DEBUGGING
+    if (debug & 16)
+	fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
+#endif
+
+    if (type == O_SUBST || type == O_NSUBST) {
+	if (arg[1].arg_type != A_STAB) {
+	    yyerror("Illegal lvalue");
+	}
+	arg[1].arg_type = A_LVAL;
+    }
+    return arg;
+}
+
+ARG *
+cmd_to_arg(cmd)
+CMD *cmd;
+{
+    register ARG *arg;
+
+    arg = op_new(1);
+    arg->arg_type = O_ITEM;
+    arg[1].arg_type = A_CMD;
+    arg[1].arg_ptr.arg_cmd = cmd;
+    return arg;
+}
+
+/* Check two expressions to see if there is any identifier in common */
+
+static int
+nothing_in_common(arg1,arg2)
+ARG *arg1;
+ARG *arg2;
+{
+    static int thisexpr = 0;	/* I don't care if this wraps */
+
+    thisexpr++;
+    if (arg_common(arg1,thisexpr,1))
+	return 0;	/* hit eval or do {} */
+    stab_lastexpr(defstab) = thisexpr;		/* pretend to hit @_ */
+    if (arg_common(arg2,thisexpr,0))
+	return 0;	/* hit identifier again */
+    return 1;
+}
+
+/* Recursively descend an expression and mark any identifier or check
+ * it to see if it was marked already.
+ */
+
+static int
+arg_common(arg,exprnum,marking)
+register ARG *arg;
+int exprnum;
+int marking;
+{
+    register int i;
+
+    if (!arg)
+	return 0;
+    for (i = arg->arg_len; i >= 1; i--) {
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    break;
+	case A_LEXPR:
+	case A_EXPR:
+	    if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
+		return 1;
+	    break;
+	case A_CMD:
+	    return 1;		/* assume hanky panky */
+	case A_STAR:
+	case A_LSTAR:
+	case A_STAB:
+	case A_LVAL:
+	case A_ARYLEN:
+	case A_LARYLEN:
+	    if (marking)
+		stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
+	    else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
+		return 1;
+	    break;
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    {
+		register char *s = arg[i].arg_ptr.arg_str->str_ptr;
+		register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
+		register STAB *stab;
+
+		while (*s) {
+		    if (*s == '$' && s[1]) {
+			s = scanident(s,send,tokenbuf);
+			stab = stabent(tokenbuf,TRUE);
+			if (marking)
+			    stab_lastexpr(stab) = exprnum;
+			else if (stab_lastexpr(stab) == exprnum)
+			    return 1;
+			continue;
+		    }
+		    else if (*s == '\\' && s[1])
+			s++;
+		    s++;
+		}
+	    }
+	    break;
+	case A_SPAT:
+	    if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
+		return 1;
+	    break;
+	case A_READ:
+	case A_INDREAD:
+	case A_GLOB:
+	case A_WORD:
+	case A_SINGLE:
+	    break;
+	}
+    }
+    switch (arg->arg_type) {
+    case O_ARRAY:
+    case O_LARRAY:
+	if ((arg[1].arg_type & A_MASK) == A_STAB)
+	    (void)aadd(arg[1].arg_ptr.arg_stab);
+	break;
+    case O_HASH:
+    case O_LHASH:
+	if ((arg[1].arg_type & A_MASK) == A_STAB)
+	    (void)hadd(arg[1].arg_ptr.arg_stab);
+	break;
+    case O_EVAL:
+    case O_SUBR:
+    case O_DBSUBR:
+	return 1;
+    }
+    return 0;
+}
+
+static int
+spat_common(spat,exprnum,marking)
+register SPAT *spat;
+int exprnum;
+int marking;
+{
+    if (spat->spat_runtime)
+	if (arg_common(spat->spat_runtime,exprnum,marking))
+	    return 1;
+    if (spat->spat_repl) {
+	if (arg_common(spat->spat_repl,exprnum,marking))
+	    return 1;
+    }
+    return 0;
+}
diff --git a/gnu/usr.bin/perl/perl/crypt.c b/gnu/usr.bin/perl/perl/crypt.c
new file mode 100644
index 000000000000..3299a8663c6e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/crypt.c
@@ -0,0 +1,200 @@
+/*
+ * Copyright (c) 1989 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Tom Truscott.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *	This product includes software developed by the University of
+ *	California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+/* from static char sccsid[] = "@(#)crypt.c	5.11 (Berkeley) 6/25/91"; */
+static char rcsid[] = "$Header: /home/cvs/386BSD/src/lib/libc/gen/crypt.c,v 1.6 1993/08/29 22:03:56 nate Exp $";
+#endif /* LIBC_SCCS and not lint */
+
+#include <unistd.h>
+#include <stdio.h>
+
+/*
+ * UNIX password, and DES, encryption.
+ * 
+ * since this is non-exportable, this is just a dummy.  if you want real
+ * encryption, make sure you've got libcrypt.a around.
+ */
+
+#define SCRAMBLE		/* Don't leave them in plaintext */
+
+#ifndef SCRAMBLE
+static char     cryptresult[1+4+4+11+1];        /* "encrypted" result */
+
+char *
+crypt(key, setting)
+	register const char *key;
+	register const char *setting;
+{
+	fprintf(stderr, "WARNING!  crypt(3) not present in the system!\n");
+	strncpy(cryptresult, key, sizeof cryptresult);
+	cryptresult[sizeof cryptresult - 1] = '\0';
+	return (cryptresult);
+}
+
+#else
+
+char *
+crypt(pw, salt)
+	register const char *pw;
+	register const char *salt;
+{
+	static char     password[14];
+	long            matrix[128], *m, vector[2];
+	char            a, b, *p;
+	int             i, value;
+	unsigned short  crc;
+	unsigned long   t;
+
+	/* Ugly hack, but I'm too lazy to find the real problem - NW */
+	bzero(matrix, 128 * sizeof(long));
+
+	if (salt[0]) {
+		a = salt[0];
+		if (salt[1])
+			b = salt[1];
+		else
+			b = a;
+	} else
+		a = b = '0';
+	password[0] = a;
+	password[1] = b;
+	if (a > 'Z')
+		a -= 6;
+	if (a > '9')
+		a -= 7;
+	if (b > 'Z')
+		b -= 6;
+	if (b > '9')
+		b -= 7;
+	a -= '.';
+	b -= '.';
+	value = (a | (b << 6)) & 07777;
+
+	crc = value;
+	value += 1000;
+	b = 0;
+	p = (char *)pw;
+	while (value--) {
+		if (crc & 0x8000)
+			crc = (crc << 1) ^ 0x1021;
+		else
+			crc <<= 1;
+		if (!b) {
+			b = 8;
+			if (!(i = *p++)) {
+				p = (char *)pw;
+				i = *p++;
+			}
+		}
+		if (i & 0x80)
+			crc ^= 1;
+		i <<= 1;
+		b--;
+	}
+
+	m = matrix;
+	matrix[0] = 0;
+	a = 32;
+	for (value = 07777; value >= 0; value--) {
+		*m <<= 1;
+		if (crc & 0x8000) {
+			*m |= 1;
+			crc = (crc << 1) ^ 0x1021;
+		} else
+			crc <<= 1;
+		if (!b) {
+			b = 8;
+			if (!(i = *p++)) {
+				p = (char *)pw;
+				i = *p++;
+			}
+		}
+		if (i & 0x80)
+			crc ^= 1;
+		i <<= 1;
+		b--;
+		if (!(a--)) {
+			a = 32;
+			*++m = 0;
+		}
+	}
+
+	vector[0] = 0;
+	vector[1] = 0;
+	p = (char *) vector;
+	for (i = 0; i < 7; i++)
+		if (pw[i])
+			*p++ = pw[i];
+		else
+			break;
+
+	p = password + 2;
+	a = 6;
+	m = matrix;
+	*p = 0;
+	for (i = 077; i >= 0; i--) {
+		t = *m++;
+		t = t ^ *m++;
+		t = t ^ vector[0];
+		t = t ^ vector[1];
+		b = 0;
+		while (t) {
+			if (t & 1)
+				b = 1 - b;
+			t >>= 1;
+		}
+		a--;
+		if (b)
+			*p |= 1 << a;
+		if (!a) {
+			a = 6;
+			*++p = 0;
+		}
+	}
+
+	for (i = 2; i < 13; i++) {
+		password[i] += '.';
+		if (password[i] > '9')
+			password[i] += 7;
+		if (password[i] > 'Z')
+			password[i] += 6;
+	}
+	password[13] = 0;
+
+	return password;
+}
+#endif
diff --git a/gnu/usr.bin/perl/perl/doarg.c b/gnu/usr.bin/perl/perl/doarg.c
new file mode 100644
index 000000000000..f36dd135b77c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/doarg.c
@@ -0,0 +1,1849 @@
+/* $RCSfile: doarg.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: doarg.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.8  1993/02/05  19:32:27  lwall
+ * patch36: substitution didn't always invalidate numericity
+ *
+ * Revision 4.0.1.7  92/06/11  21:07:11  lwall
+ * patch34: join with null list attempted negative allocation
+ * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
+ * 
+ * Revision 4.0.1.6  92/06/08  12:34:30  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: pattern modifiers i and o didn't interact right
+ * patch20: join() now pre-extends target string to avoid excessive copying
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
+ * patch20: usersub routines didn't reclaim temp values soon enough
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * patch20: added Atari ST portability
+ * 
+ * Revision 4.0.1.5  91/11/11  16:31:58  lwall
+ * patch19: added little-endian pack/unpack options
+ * 
+ * Revision 4.0.1.4  91/11/05  16:35:06  lwall
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: added some support for 64-bit integers
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: sprintf() now supports any length of s field
+ * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
+ * patch11: defined(&$foo) and undef(&$foo) didn't work
+ * 
+ * Revision 4.0.1.3  91/06/10  01:18:41  lwall
+ * patch10: pack(hh,1) dumped core
+ * 
+ * Revision 4.0.1.2  91/06/07  10:42:17  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * patch4: undef @array disabled "@array" interpolation
+ * patch4: chop("") was returning "\0" rather than ""
+ * patch4: vector logical operations &, | and ^ sometimes returned null string
+ * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
+ * 
+ * Revision 4.0.1.1  91/04/11  17:40:14  lwall
+ * patch1: fixed undefined environ problem
+ * patch1: fixed debugger coredump on subroutines
+ * 
+ * Revision 4.0  91/03/20  01:06:42  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+extern unsigned char fold[];
+
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
+static void doencodes();
+
+int
+do_subst(str,arg,sp)
+STR *str;
+ARG *arg;
+int sp;
+{
+    register SPAT *spat;
+    SPAT *rspat;
+    register STR *dstr;
+    register char *s = str_get(str);
+    char *strend = s + str->str_cur;
+    register char *m;
+    char *c;
+    register char *d;
+    int clen;
+    int iters = 0;
+    int maxiters = (strend - s) + 10;
+    register int i;
+    bool once;
+    char *orig;
+    int safebase;
+
+    rspat = spat = arg[2].arg_ptr.arg_spat;
+    if (!spat || !s)
+	fatal("panic: do_subst");
+    else if (spat->spat_runtime) {
+	nointrp = "|)";
+	(void)eval(spat->spat_runtime,G_SCALAR,sp);
+	m = str_get(dstr = stack->ary_array[sp+1]);
+	nointrp = "";
+	if (spat->spat_regexp) {
+	    regfree(spat->spat_regexp);
+	    spat->spat_regexp = Null(REGEXP*);	/* required if regcomp pukes */
+	}
+	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD);
+	if (spat->spat_flags & SPAT_KEEP) {
+	    if (!(spat->spat_flags & SPAT_FOLD))
+		scanconst(spat, m, dstr->str_cur);
+	    arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	    hoistmust(spat);
+            if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+                curcmd->c_flags &= ~CF_OPTIMIZE;
+                opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+            }
+	}
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
+    }
+#endif
+    safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
+      !sawampersand);
+    if (!spat->spat_regexp->prelen && lastspat)
+	spat = lastspat;
+    orig = m = s;
+    if (hint) {
+	if (hint < s || hint > strend)
+	    fatal("panic: hint in do_match");
+	s = hint;
+	hint = Nullch;
+	if (spat->spat_regexp->regback >= 0) {
+	    s -= spat->spat_regexp->regback;
+	    if (s < m)
+		s = m;
+	}
+	else
+	    s = m;
+    }
+    else if (spat->spat_short) {
+	if (spat->spat_flags & SPAT_SCANFIRST) {
+	    if (str->str_pok & SP_STUDIED) {
+		if (screamfirst[spat->spat_short->str_rare] < 0)
+		    goto nope;
+		else if (!(s = screaminstr(str,spat->spat_short)))
+		    goto nope;
+	    }
+#ifndef lint
+	    else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
+	      spat->spat_short)))
+		goto nope;
+#endif
+	    if (s && spat->spat_regexp->regback >= 0) {
+		++spat->spat_short->str_u.str_useful;
+		s -= spat->spat_regexp->regback;
+		if (s < m)
+		    s = m;
+	    }
+	    else
+		s = m;
+	}
+	else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+	  bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+	    goto nope;
+	if (--spat->spat_short->str_u.str_useful < 0) {
+	    str_free(spat->spat_short);
+	    spat->spat_short = Nullstr;	/* opt is being useless */
+	}
+    }
+    once = !(rspat->spat_flags & SPAT_GLOBAL);
+    if (rspat->spat_flags & SPAT_CONST) {	/* known replacement string? */
+	if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
+	    dstr = rspat->spat_repl[1].arg_ptr.arg_str;
+	else {					/* constant over loop, anyway */
+	    (void)eval(rspat->spat_repl,G_SCALAR,sp);
+	    dstr = stack->ary_array[sp+1];
+	}
+	c = str_get(dstr);
+	clen = dstr->str_cur;
+	if (clen <= spat->spat_regexp->minlen) {
+					/* can do inplace substitution */
+	    if (regexec(spat->spat_regexp, s, strend, orig, 0,
+	      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
+		if (spat->spat_regexp->subbase) /* oops, no we can't */
+		    goto long_way;
+		d = s;
+		lastspat = spat;
+		str->str_pok = SP_VALID;	/* disable possible screamer */
+		if (once) {
+		    m = spat->spat_regexp->startp[0];
+		    d = spat->spat_regexp->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';
+			str->str_cur = m - s;
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
+			return sp;
+		    }
+		    /*SUPPRESS 560*/
+		    else if (i = m - s) {	/* faster from front */
+			d -= clen;
+			m = d;
+			str_chop(str,d-i);
+			s += i;
+			while (i--)
+			    *--d = *--s;
+			if (clen)
+			    Copy(c, m, clen, char);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
+			return sp;
+		    }
+		    else if (clen) {
+			d -= clen;
+			str_chop(str,d);
+			Copy(c,d,clen,char);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
+			return sp;
+		    }
+		    else {
+			str_chop(str,d);
+			STABSET(str);
+			str_numset(arg->arg_ptr.arg_str, 1.0);
+			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+			str->str_nok = 0;
+			return sp;
+		    }
+		    /* NOTREACHED */
+		}
+		do {
+		    if (iters++ > maxiters)
+			fatal("Substitution loop");
+		    m = spat->spat_regexp->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 = spat->spat_regexp->endp[0];
+		} while (regexec(spat->spat_regexp, s, strend, orig, s == m,
+		    Nullstr, TRUE));	/* (don't match same null twice) */
+		if (s != d) {
+		    i = strend - s;
+		    str->str_cur = d - str->str_ptr + i;
+		    Move(s,d,i+1,char);		/* include the Null */
+		}
+		STABSET(str);
+		str_numset(arg->arg_ptr.arg_str, (double)iters);
+		stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+		str->str_nok = 0;
+		return sp;
+	    }
+	    str_numset(arg->arg_ptr.arg_str, 0.0);
+	    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+	    return sp;
+	}
+    }
+    else
+	c = Nullch;
+    if (regexec(spat->spat_regexp, s, strend, orig, 0,
+      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
+    long_way:
+	dstr = Str_new(25,str_len(str));
+	str_nset(dstr,m,s-m);
+	if (spat->spat_regexp->subbase)
+	    curspat = spat;
+	lastspat = spat;
+	do {
+	    if (iters++ > maxiters)
+		fatal("Substitution loop");
+	    if (spat->spat_regexp->subbase
+	      && spat->spat_regexp->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = spat->spat_regexp->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = spat->spat_regexp->startp[0];
+	    str_ncat(dstr,s,m-s);
+	    s = spat->spat_regexp->endp[0];
+	    if (c) {
+		if (clen)
+		    str_ncat(dstr,c,clen);
+	    }
+	    else {
+		char *mysubbase = spat->spat_regexp->subbase;
+
+		spat->spat_regexp->subbase = Nullch;	/* so recursion works */
+		(void)eval(rspat->spat_repl,G_SCALAR,sp);
+		str_scat(dstr,stack->ary_array[sp+1]);
+		if (spat->spat_regexp->subbase)
+		    Safefree(spat->spat_regexp->subbase);
+		spat->spat_regexp->subbase = mysubbase;
+	    }
+	    if (once)
+		break;
+	} while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
+	    safebase));
+	str_ncat(dstr,s,strend - s);
+	str_replace(str,dstr);
+	STABSET(str);
+	str_numset(arg->arg_ptr.arg_str, (double)iters);
+	stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+	str->str_nok = 0;
+	return sp;
+    }
+    str_numset(arg->arg_ptr.arg_str, 0.0);
+    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+    return sp;
+
+nope:
+    ++spat->spat_short->str_u.str_useful;
+    str_numset(arg->arg_ptr.arg_str, 0.0);
+    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
+    return sp;
+}
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
+int
+do_trans(str,arg)
+STR *str;
+ARG *arg;
+{
+    register short *tbl;
+    register char *s;
+    register int matches = 0;
+    register int ch;
+    register char *send;
+    register char *d;
+    register int squash = arg[2].arg_len & 1;
+
+    tbl = (short*) arg[2].arg_ptr.arg_cval;
+    s = str_get(str);
+    send = s + str->str_cur;
+    if (!tbl || !s)
+	fatal("panic: do_trans");
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.TBL\n");
+    }
+#endif
+    if (!arg[2].arg_len) {
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 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';
+	str->str_cur = d - str->str_ptr;
+    }
+    STABSET(str);
+    return matches;
+}
+
+void
+do_join(str,arglast)
+register STR *str;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char *delim = str_get(st[sp]);
+    register STRLEN len;
+    int delimlen = st[sp]->str_cur;
+
+    st += sp + 1;
+
+    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
+    if (str->str_len < len + items) {	/* current length is way too short */
+	while (items-- > 0) {
+	    if (*st)
+		len += (*st)->str_cur;
+	    st++;
+	}
+	STR_GROW(str, len + 1);		/* so try to pre-extend */
+
+	items = arglast[2] - sp;
+	st -= items;
+    }
+
+    if (items-- > 0)
+	str_sset(str, *st++);
+    else
+	str_set(str,"");
+    len = delimlen;
+    if (len) {
+	for (; items > 0; items--,st++) {
+	    str_ncat(str,delim,len);
+	    str_scat(str,*st);
+	}
+    }
+    else {
+	for (; items > 0; items--,st++)
+	    str_scat(str,*st);
+    }
+    STABSET(str);
+}
+
+void
+do_pack(str,arglast)
+register STR *str;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items;
+    register char *pat = str_get(st[sp]);
+    register char *patend = pat + st[sp]->str_cur;
+    register int len;
+    int datumtype;
+    STR *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;
+    short ashort;
+    int aint;
+    unsigned int auint;
+    long along;
+    unsigned long aulong;
+#ifdef QUAD
+    quad aquad;
+    unsigned quad auquad;
+#endif
+    char *aptr;
+    float afloat;
+    double adouble;
+
+    items = arglast[2] - sp;
+    st += ++sp;
+    str_nset(str,"",0);
+    while (pat < patend) {
+#define NEXTFROM (items-- > 0 ? *st++ : &str_no)
+	datumtype = *pat++;
+	if (*pat == '*') {
+	    len = index("@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 '%':
+	    fatal("% may only be used in unpack");
+	case '@':
+	    len -= str->str_cur;
+	    if (len > 0)
+		goto grow;
+	    len = -len;
+	    if (len > 0)
+		goto shrink;
+	    break;
+	case 'X':
+	  shrink:
+	    if (str->str_cur < len)
+		fatal("X outside of string");
+	    str->str_cur -= len;
+	    str->str_ptr[str->str_cur] = '\0';
+	    break;
+	case 'x':
+	  grow:
+	    while (len >= 10) {
+		str_ncat(str,null10,10);
+		len -= 10;
+	    }
+	    str_ncat(str,null10,len);
+	    break;
+	case 'A':
+	case 'a':
+	    fromstr = NEXTFROM;
+	    aptr = str_get(fromstr);
+	    if (pat[-1] == '*')
+		len = fromstr->str_cur;
+	    if (fromstr->str_cur > len)
+		str_ncat(str,aptr,len);
+	    else {
+		str_ncat(str,aptr,fromstr->str_cur);
+		len -= fromstr->str_cur;
+		if (datumtype == 'A') {
+		    while (len >= 10) {
+			str_ncat(str,space10,10);
+			len -= 10;
+		    }
+		    str_ncat(str,space10,len);
+		}
+		else {
+		    while (len >= 10) {
+			str_ncat(str,null10,10);
+			len -= 10;
+		    }
+		    str_ncat(str,null10,len);
+		}
+	    }
+	    break;
+	case 'B':
+	case 'b':
+	    {
+		char *savepat = pat;
+		int saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = str_get(fromstr);
+		if (pat[-1] == '*')
+		    len = fromstr->str_cur;
+		pat = aptr;
+		aint = str->str_cur;
+		str->str_cur += (len+7)/8;
+		STR_GROW(str, str->str_cur + 1);
+		aptr = str->str_ptr + aint;
+		if (len > fromstr->str_cur)
+		    len = fromstr->str_cur;
+		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 = str->str_ptr + str->str_cur;
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'H':
+	case 'h':
+	    {
+		char *savepat = pat;
+		int saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = str_get(fromstr);
+		if (pat[-1] == '*')
+		    len = fromstr->str_cur;
+		pat = aptr;
+		aint = str->str_cur;
+		str->str_cur += (len+1)/2;
+		STR_GROW(str, str->str_cur + 1);
+		aptr = str->str_ptr + aint;
+		if (len > fromstr->str_cur)
+		    len = fromstr->str_cur;
+		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 = str->str_ptr + str->str_cur;
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'C':
+	case 'c':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = (int)str_gnum(fromstr);
+		achar = aint;
+		str_ncat(str,&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)str_gnum(fromstr);
+		str_ncat(str, (char *)&afloat, sizeof (float));
+	    }
+	    break;
+	case 'd':
+	case 'D':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		adouble = (double)str_gnum(fromstr);
+		str_ncat(str, (char *)&adouble, sizeof (double));
+	    }
+	    break;
+	case 'n':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+#ifdef HAS_HTONS
+		ashort = htons(ashort);
+#endif
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'v':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+#ifdef HAS_HTOVS
+		ashort = htovs(ashort);
+#endif
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'S':
+	case 's':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (short)str_gnum(fromstr);
+		str_ncat(str,(char*)&ashort,sizeof(short));
+	    }
+	    break;
+	case 'I':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auint = U_I(str_gnum(fromstr));
+		str_ncat(str,(char*)&auint,sizeof(unsigned int));
+	    }
+	    break;
+	case 'i':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = (int)str_gnum(fromstr);
+		str_ncat(str,(char*)&aint,sizeof(int));
+	    }
+	    break;
+	case 'N':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTONL
+		aulong = htonl(aulong);
+#endif
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'V':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTOVL
+		aulong = htovl(aulong);
+#endif
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'L':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(str_gnum(fromstr));
+		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+	    }
+	    break;
+	case 'l':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		along = (long)str_gnum(fromstr);
+		str_ncat(str,(char*)&along,sizeof(long));
+	    }
+	    break;
+#ifdef QUAD
+	case 'Q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auquad = (unsigned quad)str_gnum(fromstr);
+		str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
+	    }
+	    break;
+	case 'q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aquad = (quad)str_gnum(fromstr);
+		str_ncat(str,(char*)&aquad,sizeof(quad));
+	    }
+	    break;
+#endif /* QUAD */
+	case 'p':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aptr = str_get(fromstr);
+		str_ncat(str,(char*)&aptr,sizeof(char*));
+	    }
+	    break;
+	case 'u':
+	    fromstr = NEXTFROM;
+	    aptr = str_get(fromstr);
+	    aint = fromstr->str_cur;
+	    STR_GROW(str,aint * 4 / 3);
+	    if (len <= 1)
+		len = 45;
+	    else
+		len = len / 3 * 3;
+	    while (aint > 0) {
+		int todo;
+
+		if (aint > len)
+		    todo = len;
+		else
+		    todo = aint;
+		doencodes(str, aptr, todo);
+		aint -= todo;
+		aptr += todo;
+	    }
+	    break;
+	}
+    }
+    STABSET(str);
+}
+#undef NEXTFROM
+
+static void
+doencodes(str, s, len)
+register STR *str;
+register char *s;
+register int len;
+{
+    char hunk[5];
+
+    *hunk = len + ' ';
+    str_ncat(str, 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));
+	str_ncat(str, hunk, 4);
+	s += 3;
+	len -= 3;
+    }
+    for (s = str->str_ptr; *s; s++) {
+	if (*s == ' ')
+	    *s = '`';
+    }
+    str_ncat(str, "\n", 1);
+}
+
+void
+do_sprintf(str,len,sarg)
+register STR *str;
+register int len;
+register STR **sarg;
+{
+    register char *s;
+    register char *t;
+    register char *f;
+    bool dolong;
+#ifdef QUAD
+    bool doquad;
+#endif /* QUAD */
+    char ch;
+    static STR *sargnull = &str_no;
+    register char *send;
+    register STR *arg;
+    char *xs;
+    int xlen;
+    int pre;
+    int post;
+    double value;
+
+    str_set(str,"");
+    len--;			/* don't count pattern string */
+    t = s = str_get(*sarg);
+    send = s + (*sarg)->str_cur;
+    sarg++;
+    for ( ; ; len--) {
+
+	/*SUPPRESS 560*/
+	if (len <= 0 || !(arg = *sarg++))
+	    arg = sargnull;
+
+	/*SUPPRESS 530*/
+	for ( ; t < send && *t != '%'; t++) ;
+	if (t >= send)
+	    break;		/* end of format string, ignore extra args */
+	f = t;
+	*buf = '\0';
+	xs = buf;
+#ifdef QUAD
+	doquad =
+#endif /* 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 '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 QUAD
+		if (dolong) {
+		    dolong = FALSE;
+		    doquad = TRUE;
+		} else
+#endif
+		dolong = TRUE;
+		continue;
+	    case 'c':
+		ch = *(++t);
+		*t = '\0';
+		xlen = (int)str_gnum(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 QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(quad)str_gnum(arg));
+		else
+#endif
+		if (dolong)
+		    (void)sprintf(xs,f,(long)str_gnum(arg));
+		else
+		    (void)sprintf(xs,f,(int)str_gnum(arg));
+		xlen = strlen(xs);
+		break;
+	    case 'X': case 'O':
+		dolong = TRUE;
+		/* FALL THROUGH */
+	    case 'x': case 'o': case 'u':
+		ch = *(++t);
+		*t = '\0';
+		value = str_gnum(arg);
+#ifdef QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(unsigned quad)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,str_gnum(arg));
+		xlen = strlen(xs);
+		break;
+	    case 's':
+		ch = *(++t);
+		*t = '\0';
+		xs = str_get(arg);
+		xlen = arg->str_cur;
+		if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
+		  && xlen == sizeof(STBP)) {
+		    STR *tmpstr = Str_new(24,0);
+
+		    stab_efullname(tmpstr, ((STAB*)arg)); /* a stab value! */
+		    sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
+					/* reformat to non-binary */
+		    xs = tokenbuf;
+		    xlen = strlen(tokenbuf);
+		    str_free(tmpstr);
+		}
+		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
+		    break;		/* so handle simple cases */
+		}
+		else if (f[1] == '-') {
+		    char *mp = index(f, '.');
+		    int min = atoi(f+2);
+
+		    if (mp) {
+			int max = atoi(mp+1);
+
+			if (xlen > max)
+			    xlen = max;
+		    }
+		    if (xlen < min)
+			post = min - xlen;
+		    break;
+		}
+		else if (isDIGIT(f[1])) {
+		    char *mp = index(f, '.');
+		    int min = atoi(f+1);
+
+		    if (mp) {
+			int 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;
+	    STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
+	    str_ncat(str, s, f - s);
+	    if (pre) {
+		repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
+		str->str_cur += pre;
+	    }
+	    str_ncat(str, xs, xlen);
+	    if (post) {
+		repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
+		str->str_cur += post;
+	    }
+	    s = t;
+	    break;		/* break from for loop */
+	}
+    }
+    str_ncat(str, s, t - s);
+    STABSET(str);
+}
+
+STR *
+do_push(ary,arglast)
+register ARRAY *ary;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register STR *str = &str_undef;
+
+    for (st += ++sp; items > 0; items--,st++) {
+	str = Str_new(26,0);
+	if (*st)
+	    str_sset(str,*st);
+	(void)apush(ary,str);
+    }
+    return str;
+}
+
+void
+do_unshift(ary,arglast)
+register ARRAY *ary;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register STR *str;
+    register int i;
+
+    aunshift(ary,items);
+    i = 0;
+    for (st += ++sp; i < items; i++,st++) {
+	str = Str_new(27,0);
+	str_sset(str,*st);
+	(void)astore(ary,i,str);
+    }
+}
+
+int
+do_subr(arg,gimme,arglast)
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register SUBR *sub;
+    SPAT * VOLATILE oldspat = curspat;
+    STR *str;
+    STAB *stab;
+    int oldsave = savestack->ary_fill;
+    int oldtmps_base = tmps_base;
+    int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
+    register CSV *csv;
+
+    if ((arg[1].arg_type & A_MASK) == A_WORD)
+	stab = arg[1].arg_ptr.arg_stab;
+    else {
+	STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	if (tmpstr)
+	    stab = stabent(str_get(tmpstr),TRUE);
+	else
+	    stab = Nullstab;
+    }
+    if (!stab)
+	fatal("Undefined subroutine called");
+    if (!(sub = stab_sub(stab))) {
+	STR *tmpstr = arg[0].arg_ptr.arg_str;
+
+	stab_efullname(tmpstr, stab);
+	fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
+    }
+    if (arg->arg_type == O_DBSUBR && !sub->usersub) {
+	str = stab_val(DBsub);
+	saveitem(str);
+	stab_efullname(str,stab);
+	sub = stab_sub(DBsub);
+	if (!sub)
+	    fatal("No DBsub routine");
+    }
+    str = Str_new(15, sizeof(CSV));
+    str->str_state = SS_SCSV;
+    (void)apush(savestack,str);
+    csv = (CSV*)str->str_ptr;
+    csv->sub = sub;
+    csv->stab = stab;
+    csv->curcsv = curcsv;
+    csv->curcmd = curcmd;
+    csv->depth = sub->depth;
+    csv->wantarray = gimme;
+    csv->hasargs = hasargs;
+    curcsv = csv;
+    tmps_base = tmps_max;
+    if (sub->usersub) {
+	csv->hasargs = 0;
+	csv->savearray = Null(ARRAY*);;
+	csv->argarray = Null(ARRAY*);
+	st[sp] = arg->arg_ptr.arg_str;
+	if (!hasargs)
+	    items = 0;
+	sp = (*sub->usersub)(sub->userindex,sp,items);
+    }
+    else {
+	if (hasargs) {
+	    csv->savearray = stab_xarray(defstab);
+	    csv->argarray = afake(defstab, items, &st[sp+1]);
+	    stab_xarray(defstab) = csv->argarray;
+	}
+	sub->depth++;
+	if (sub->depth >= 2) {	/* save temporaries on recursion? */
+	    if (sub->depth == 100 && dowarn)
+		warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
+	    savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+	}
+	sp = cmd_exec(sub->cmd,gimme, --sp);	/* so do it already */
+    }
+
+    st = stack->ary_array;
+    tmps_base = oldtmps_base;
+    for (items = arglast[0] + 1; items <= sp; items++)
+	st[items] = str_mortal(st[items]);
+	    /* in case restore wipes old str */
+    restorelist(oldsave);
+    curspat = oldspat;
+    return sp;
+}
+
+int
+do_assign(arg,gimme,arglast)
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+
+    register STR **st = stack->ary_array;
+    STR **firstrelem = st + arglast[1] + 1;
+    STR **firstlelem = st + arglast[0] + 1;
+    STR **lastrelem = st + arglast[2];
+    STR **lastlelem = st + arglast[1];
+    register STR **relem;
+    register STR **lelem;
+
+    register STR *str;
+    register ARRAY *ary;
+    register int makelocal;
+    HASH *hash;
+    int i;
+
+    makelocal = (arg->arg_flags & AF_LOCAL) != 0;
+    localizing = makelocal;
+    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 (arg->arg_flags & AF_COMMON) {
+	for (relem = firstrelem; relem <= lastrelem; relem++) {
+	    /*SUPPRESS 560*/
+	    if (str = *relem)
+		*relem = str_mortal(str);
+	}
+    }
+    relem = firstrelem;
+    lelem = firstlelem;
+    ary = Null(ARRAY*);
+    hash = Null(HASH*);
+    while (lelem <= lastlelem) {
+	str = *lelem++;
+	if (str->str_state >= SS_HASH) {
+	    if (str->str_state == SS_ARY) {
+		if (makelocal)
+		    ary = saveary(str->str_u.str_stab);
+		else {
+		    ary = stab_array(str->str_u.str_stab);
+		    ary->ary_fill = -1;
+		}
+		i = 0;
+		while (relem <= lastrelem) {	/* gobble up all the rest */
+		    str = Str_new(28,0);
+		    if (*relem)
+			str_sset(str,*relem);
+		    *(relem++) = str;
+		    (void)astore(ary,i++,str);
+		}
+	    }
+	    else if (str->str_state == SS_HASH) {
+		char *tmps;
+		STR *tmpstr;
+		int magic = 0;
+		STAB *tmpstab = str->str_u.str_stab;
+
+		if (makelocal)
+		    hash = savehash(str->str_u.str_stab);
+		else {
+		    hash = stab_hash(str->str_u.str_stab);
+		    if (tmpstab == envstab) {
+			magic = 'E';
+			environ[0] = Nullch;
+		    }
+		    else if (tmpstab == sigstab) {
+			magic = 'S';
+#ifndef NSIG
+#define NSIG 32
+#endif
+			for (i = 1; i < NSIG; i++)
+			    signal(i, SIG_DFL);	/* crunch, crunch, crunch */
+		    }
+#ifdef SOME_DBM
+		    else if (hash->tbl_dbm)
+			magic = 'D';
+#endif
+		    hclear(hash, magic == 'D');	/* wipe any dbm file too */
+
+		}
+		while (relem < lastrelem) {	/* gobble up all the rest */
+		    if (*relem)
+			str = *(relem++);
+		    else
+			str = &str_no, relem++;
+		    tmps = str_get(str);
+		    tmpstr = Str_new(29,0);
+		    if (*relem)
+			str_sset(tmpstr,*relem);	/* value */
+		    *(relem++) = tmpstr;
+		    (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
+		    if (magic) {
+			str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
+			stabset(tmpstr->str_magic, tmpstr);
+		    }
+		}
+	    }
+	    else
+		fatal("panic: do_assign");
+	}
+	else {
+	    if (makelocal)
+		saveitem(str);
+	    if (relem <= lastrelem) {
+		str_sset(str, *relem);
+		*(relem++) = str;
+	    }
+	    else {
+		str_sset(str, &str_undef);
+		if (gimme == G_ARRAY) {
+		    i = ++lastrelem - firstrelem;
+		    relem++;		/* tacky, I suppose */
+		    astore(stack,i,str);
+		    if (st != stack->ary_array) {
+			st = stack->ary_array;
+			firstrelem = st + arglast[1] + 1;
+			firstlelem = st + arglast[0] + 1;
+			lastlelem = st + arglast[1];
+			lastrelem = st + i;
+			relem = lastrelem + 1;
+		    }
+		}
+	    }
+	    STABSET(str);
+	}
+    }
+    if (delaymagic & ~DM_DELAY) {
+	if (delaymagic & DM_UID) {
+#ifdef HAS_SETREUID
+	    (void)setreuid(uid,euid);
+#else /* not HAS_SETREUID */
+#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)
+		    fatal("No setreuid available");
+		(void)setuid(uid);
+	    }
+#endif /* not HAS_SETREUID */
+	    uid = (int)getuid();
+	    euid = (int)geteuid();
+	}
+	if (delaymagic & DM_GID) {
+#ifdef HAS_SETREGID
+	    (void)setregid(gid,egid);
+#else /* not HAS_SETREGID */
+#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)
+		    fatal("No setregid available");
+		(void)setgid(gid);
+	    }
+#endif /* not HAS_SETREGID */
+	    gid = (int)getgid();
+	    egid = (int)getegid();
+	}
+    }
+    delaymagic = 0;
+    localizing = FALSE;
+    if (gimme == G_ARRAY) {
+	i = lastrelem - firstrelem + 1;
+	if (ary || hash)
+	    Copy(firstrelem, firstlelem, i, STR*);
+	return arglast[0] + i;
+    }
+    else {
+	str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
+	*firstlelem = arg->arg_ptr.arg_str;
+	return arglast[0] + 1;
+    }
+}
+
+int					/*SUPPRESS 590*/
+do_study(str,arg,gimme,arglast)
+STR *str;
+ARG *arg;
+int gimme;
+int *arglast;
+{
+    register unsigned char *s;
+    register int pos = str->str_cur;
+    register int ch;
+    register int *sfirst;
+    register int *snext;
+    static int maxscream = -1;
+    static STR *lastscream = Nullstr;
+    int retval;
+    int retarg = arglast[0] + 1;
+
+#ifndef lint
+    s = (unsigned char*)(str_get(str));
+#else
+    s = Null(unsigned char*);
+#endif
+    if (lastscream)
+	lastscream->str_pok &= ~SP_STUDIED;
+    lastscream = str;
+    if (pos <= 0) {
+	retval = 0;
+	goto ret;
+    }
+    if (pos > maxscream) {
+	if (maxscream < 0) {
+	    maxscream = pos + 80;
+	    New(301,screamfirst, 256, int);
+	    New(302,screamnext, maxscream, int);
+	}
+	else {
+	    maxscream = pos + pos / 4;
+	    Renew(screamnext, maxscream, int);
+	}
+    }
+
+    sfirst = screamfirst;
+    snext = screamnext;
+
+    if (!sfirst || !snext)
+	fatal("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;
+    }
+
+    str->str_pok |= SP_STUDIED;
+    retval = 1;
+  ret:
+    str_numset(arg->arg_ptr.arg_str,(double)retval);
+    stack->ary_array[retarg] = arg->arg_ptr.arg_str;
+    return retarg;
+}
+
+int					/*SUPPRESS 590*/
+do_defined(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register int type;
+    register int retarg = arglast[0] + 1;
+    int retval;
+    ARRAY *ary;
+    HASH *hash;
+
+    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
+	fatal("Illegal argument to defined()");
+    arg = arg[1].arg_ptr.arg_arg;
+    type = arg->arg_type;
+
+    if (type == O_SUBR || type == O_DBSUBR) {
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
+	else {
+	    STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	    retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
+	}
+    }
+    else if (type == O_ARRAY || type == O_LARRAY ||
+	     type == O_ASLICE || type == O_LASLICE )
+	retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
+	    && ary->ary_max >= 0 );
+    else if (type == O_HASH || type == O_LHASH ||
+	     type == O_HSLICE || type == O_LHSLICE )
+	retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
+	    && hash->tbl_array);
+    else
+	retval = FALSE;
+    str_numset(str,(double)retval);
+    stack->ary_array[retarg] = str;
+    return retarg;
+}
+
+int						/*SUPPRESS 590*/
+do_undef(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register int type;
+    register STAB *stab;
+    int retarg = arglast[0] + 1;
+
+    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
+	fatal("Illegal argument to undef()");
+    arg = arg[1].arg_ptr.arg_arg;
+    type = arg->arg_type;
+
+    if (type == O_ARRAY || type == O_LARRAY) {
+	stab = arg[1].arg_ptr.arg_stab;
+	afree(stab_xarray(stab));
+	stab_xarray(stab) = anew(stab);		/* so "@array" still works */
+    }
+    else if (type == O_HASH || type == O_LHASH) {
+	stab = arg[1].arg_ptr.arg_stab;
+	if (stab == envstab)
+	    environ[0] = Nullch;
+	else if (stab == sigstab) {
+	    int i;
+
+	    for (i = 1; i < NSIG; i++)
+		signal(i, SIG_DFL);	/* munch, munch, munch */
+	}
+	(void)hfree(stab_xhash(stab), TRUE);
+	stab_xhash(stab) = Null(HASH*);
+    }
+    else if (type == O_SUBR || type == O_DBSUBR) {
+	stab = arg[1].arg_ptr.arg_stab;
+	if ((arg[1].arg_type & A_MASK) != A_WORD) {
+	    STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+	    if (tmpstr)
+		stab = stabent(str_get(tmpstr),TRUE);
+	    else
+		stab = Nullstab;
+	}
+	if (stab && stab_sub(stab)) {
+	    cmd_free(stab_sub(stab)->cmd);
+	    stab_sub(stab)->cmd = Nullcmd;
+	    afree(stab_sub(stab)->tosave);
+	    Safefree(stab_sub(stab));
+	    stab_sub(stab) = Null(SUBR*);
+	}
+    }
+    else
+	fatal("Can't undefine that kind of object");
+    str_numset(str,0.0);
+    stack->ary_array[retarg] = str;
+    return retarg;
+}
+
+int
+do_vec(lvalue,astr,arglast)
+int lvalue;
+STR *astr;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    int sp = arglast[0];
+    register STR *str = st[++sp];
+    register int offset = (int)str_gnum(st[++sp]);
+    register int size = (int)str_gnum(st[++sp]);
+    unsigned char *s = (unsigned char*)str_get(str);
+    unsigned long retnum;
+    int len;
+
+    sp = arglast[1];
+    offset *= size;		/* turn into bit offset */
+    len = (offset + size + 7) / 8;
+    if (offset < 0 || size < 1)
+	retnum = 0;
+    else if (!lvalue && len > str->str_cur)
+	retnum = 0;
+    else {
+	if (len > str->str_cur) {
+	    STR_GROW(str,len);
+	    (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
+	    str->str_cur = len;
+	}
+	s = (unsigned char*)str_get(str);
+	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];
+	}
+
+	if (lvalue) {                      /* it's an lvalue! */
+	    struct lstring *lstr = (struct lstring*)astr;
+
+	    astr->str_magic = str;
+	    st[sp]->str_rare = 'v';
+	    lstr->lstr_offset = offset;
+	    lstr->lstr_len = size;
+	}
+    }
+
+    str_numset(astr,(double)retnum);
+    st[sp] = astr;
+    return sp;
+}
+
+void
+do_vecset(mstr,str)
+STR *mstr;
+STR *str;
+{
+    struct lstring *lstr = (struct lstring*)str;
+    register int offset;
+    register int size;
+    register unsigned char *s = (unsigned char*)mstr->str_ptr;
+    register unsigned long lval = U_L(str_gnum(str));
+    int mask;
+
+    mstr->str_rare = 0;
+    str->str_magic = Nullstr;
+    offset = lstr->lstr_offset;
+    size = lstr->lstr_len;
+    if (size < 8) {
+	mask = (1 << size) - 1;
+	size = offset & 7;
+	lval &= mask;
+	offset >>= 3;
+	s[offset] &= ~(mask << size);
+	s[offset] |= lval << size;
+    }
+    else {
+	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,str)
+register STR *astr;
+register STR *str;
+{
+    register char *tmps;
+    register int i;
+    ARRAY *ary;
+    HASH *hash;
+    HENT *entry;
+
+    if (!str)
+	return;
+    if (str->str_state == SS_ARY) {
+	ary = stab_array(str->str_u.str_stab);
+	for (i = 0; i <= ary->ary_fill; i++)
+	    do_chop(astr,ary->ary_array[i]);
+	return;
+    }
+    if (str->str_state == SS_HASH) {
+	hash = stab_hash(str->str_u.str_stab);
+	(void)hiterinit(hash);
+	/*SUPPRESS 560*/
+	while (entry = hiternext(hash))
+	    do_chop(astr,hiterval(hash,entry));
+	return;
+    }
+    tmps = str_get(str);
+    if (tmps && str->str_cur) {
+	tmps += str->str_cur - 1;
+	str_nset(astr,tmps,1);	/* remember last char */
+	*tmps = '\0';				/* wipe it out */
+	str->str_cur = tmps - str->str_ptr;
+	str->str_nok = 0;
+	STABSET(str);
+    }
+    else
+	str_nset(astr,"",0);
+}
+
+void
+do_vop(optype,str,left,right)
+STR *str;
+STR *left;
+STR *right;
+{
+    register char *s;
+    register char *l = str_get(left);
+    register char *r = str_get(right);
+    register int len;
+
+    len = left->str_cur;
+    if (len > right->str_cur)
+	len = right->str_cur;
+    if (str->str_cur > len)
+	str->str_cur = len;
+    else if (str->str_cur < len) {
+	STR_GROW(str,len);
+	(void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
+	str->str_cur = len;
+    }
+    str->str_pok = 1;
+    str->str_nok = 0;
+    s = str->str_ptr;
+    if (!s) {
+	str_nset(str,"",0);
+	s = str->str_ptr;
+    }
+    switch (optype) {
+    case O_BIT_AND:
+	while (len--)
+	    *s++ = *l++ & *r++;
+	break;
+    case O_XOR:
+	while (len--)
+	    *s++ = *l++ ^ *r++;
+	goto mop_up;
+    case O_BIT_OR:
+	while (len--)
+	    *s++ = *l++ | *r++;
+      mop_up:
+	len = str->str_cur;
+	if (right->str_cur > len)
+	    str_ncat(str,right->str_ptr+len,right->str_cur - len);
+	else if (left->str_cur > len)
+	    str_ncat(str,left->str_ptr+len,left->str_cur - len);
+	break;
+    }
+}
+
+int
+do_syscall(arglast)
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+#ifdef atarist
+    unsigned long arg[14]; /* yes, we really need that many ! */
+#else
+    unsigned long arg[8];
+#endif
+    register int i = 0;
+    int retval = -1;
+
+#ifdef HAS_SYSCALL
+#ifdef TAINT
+    for (st += ++sp; items--; st++)
+	tainted |= (*st)->str_tainted;
+    st = stack->ary_array;
+    sp = arglast[1];
+    items = arglast[2] - sp;
+#endif
+#ifdef TAINT
+    taintproper("Insecure dependency in syscall");
+#endif
+    /* 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 (items--) {
+	if (st[++sp]->str_nok || !i)
+	    arg[i++] = (unsigned long)str_gnum(st[sp]);
+#ifndef lint
+	else
+	    arg[i++] = (unsigned long)st[sp]->str_ptr;
+#endif /* lint */
+    }
+    sp = arglast[1];
+    items = arglast[2] - sp;
+    switch (items) {
+    case 0:
+	fatal("Too few args to syscall");
+    case 1:
+	retval = syscall(arg[0]);
+	break;
+    case 2:
+	retval = syscall(arg[0],arg[1]);
+	break;
+    case 3:
+	retval = syscall(arg[0],arg[1],arg[2]);
+	break;
+    case 4:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3]);
+	break;
+    case 5:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
+	break;
+    case 6:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
+	break;
+    case 7:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
+	break;
+    case 8:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7]);
+	break;
+#ifdef atarist
+    case 9:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8]);
+	break;
+    case 10:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9]);
+	break;
+    case 11:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10]);
+	break;
+    case 12:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11]);
+	break;
+    case 13:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11], arg[12]);
+	break;
+    case 14:
+	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+	  arg[7], arg[8], arg[9], arg[10], arg[11], arg[12], arg[13]);
+	break;
+#endif /* atarist */
+    }
+    return retval;
+#else
+    fatal("syscall() unimplemented");
+#endif
+}
+
+
diff --git a/gnu/usr.bin/perl/perl/doio.c b/gnu/usr.bin/perl/perl/doio.c
new file mode 100644
index 000000000000..eb1dac538cb0
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/doio.c
@@ -0,0 +1,2951 @@
+/* $RCSfile: doio.c,v $$Revision: 1.2 $$Date: 1994/03/09 22:24: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: doio.c,v $
+ * Revision 1.2  1994/03/09  22:24:27  ache
+ * (cast) added for last argument of semctl
+ *
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.6  92/06/11  21:08:16  lwall
+ * patch34: some systems don't declare h_errno extern in header files
+ * 
+ * Revision 4.0.1.5  92/06/08  13:00:21  lwall
+ * patch20: some machines don't define ENOTSOCK in errno.h
+ * patch20: new warnings for failed use of stat operators on filenames with \n
+ * patch20: wait failed when STDOUT or STDERR reopened to a pipe
+ * patch20: end of file latch not reset on reopen of STDIN
+ * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround
+ * patch20: fixed memory leak on system() for vfork() machines
+ * patch20: get*by* routines now return something useful in a scalar context
+ * patch20: h_errno now accessible via $?
+ * 
+ * Revision 4.0.1.4  91/11/05  16:51:43  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: perl mistook some streams for sockets because they return mode 0 too
+ * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
+ * patch11: certain perl errors should set EBADF so that $! looks better
+ * patch11: truncate on a closed filehandle could dump
+ * patch11: stats of _ forgot whether prior stat was actually lstat
+ * patch11: -T returned true on NFS directory
+ * 
+ * Revision 4.0.1.3  91/06/10  01:21:19  lwall
+ * patch10: read didn't work from character special files open for writing
+ * patch10: close-on-exec wrongly set on system file descriptors
+ * 
+ * Revision 4.0.1.2  91/06/07  10:53:39  lwall
+ * patch4: new copyright notice
+ * patch4: system fd's are now treated specially
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: character special files now opened with bidirectional stdio buffers
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:41:06  lwall
+ * patch1: hopefully straightened out some of the Xenix mess
+ * 
+ * Revision 4.0  91/03/20  01:07:06  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+
+#ifdef HAS_SOCKET
+#include <sys/socket.h>
+#include <netdb.h>
+#ifndef ENOTSOCK
+#include <net/errno.h>
+#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
+
+#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>
+#endif
+#endif
+
+#ifdef I_PWD
+#include <pwd.h>
+#endif
+#ifdef I_GRP
+#include <grp.h>
+#endif
+#ifdef I_UTIME
+#include <utime.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+int laststatval = -1;
+int laststype = O_STAT;
+
+static char* warn_nl = "Unsuccessful %s on filename containing newline";
+
+bool
+do_open(stab,name,len)
+STAB *stab;
+register char *name;
+int len;
+{
+    FILE *fp;
+    register STIO *stio = stab_io(stab);
+    char *myname = savestr(name);
+    int result;
+    int fd;
+    int writing = 0;
+    char mode[3];		/* stdio file mode ("r\0" or "r+\0") */
+    FILE *saveifp = Nullfp;
+    FILE *saveofp = Nullfp;
+    char savetype = ' ';
+
+    mode[0] = mode[1] = mode[2] = '\0';
+    name = myname;
+    forkprocess = 1;		/* assume true if no fork */
+    while (len && isSPACE(name[len-1]))
+	name[--len] = '\0';
+    if (!stio)
+	stio = stab_io(stab) = stio_new();
+    else if (stio->ifp) {
+	fd = fileno(stio->ifp);
+	if (stio->type == '-')
+	    result = 0;
+	else if (fd <= maxsysfd) {
+	    saveifp = stio->ifp;
+	    saveofp = stio->ofp;
+	    savetype = stio->type;
+	    result = 0;
+	}
+	else if (stio->type == '|')
+	    result = mypclose(stio->ifp);
+	else if (stio->ifp != stio->ofp) {
+	    if (stio->ofp) {
+		result = fclose(stio->ofp);
+		fclose(stio->ifp);	/* clear stdio, fd already closed */
+	    }
+	    else
+		result = fclose(stio->ifp);
+	}
+	else
+	    result = fclose(stio->ifp);
+	if (result == EOF && fd > maxsysfd)
+	    fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
+	      stab_ename(stab));
+	stio->ofp = stio->ifp = Nullfp;
+    }
+    if (*name == '+' && len > 1 && name[len-1] != '|') {	/* scary */
+	mode[1] = *name++;
+	mode[2] = '\0';
+	--len;
+	writing = 1;
+    }
+    else  {
+	mode[1] = '\0';
+    }
+    stio->type = *name;
+    if (*name == '|') {
+	/*SUPPRESS 530*/
+	for (name++; isSPACE(*name); name++) ;
+#ifdef TAINT
+	taintenv();
+	taintproper("Insecure dependency in piped open");
+#endif
+	fp = mypopen(name,"w");
+	writing = 1;
+    }
+    else if (*name == '>') {
+#ifdef TAINT
+	taintproper("Insecure dependency in open");
+#endif
+	name++;
+	if (*name == '>') {
+	    mode[0] = stio->type = 'a';
+	    name++;
+	}
+	else
+	    mode[0] = 'w';
+	writing = 1;
+	if (*name == '&') {
+	  duplicity:
+	    name++;
+	    while (isSPACE(*name))
+		name++;
+	    if (isDIGIT(*name))
+		fd = atoi(name);
+	    else {
+		stab = stabent(name,FALSE);
+		if (!stab || !stab_io(stab)) {
+#ifdef EINVAL
+		    errno = EINVAL;
+#endif
+		    goto say_false;
+		}
+		if (stab_io(stab) && stab_io(stab)->ifp) {
+		    fd = fileno(stab_io(stab)->ifp);
+		    if (stab_io(stab)->type == 's')
+			stio->type = 's';
+		}
+		else
+		    fd = -1;
+	    }
+	    if (!(fp = fdopen(fd = dup(fd),mode))) {
+		close(fd);
+	    }
+	}
+	else {
+	    while (isSPACE(*name))
+		name++;
+	    if (strEQ(name,"-")) {
+		fp = stdout;
+		stio->type = '-';
+	    }
+	    else  {
+		fp = fopen(name,mode);
+	    }
+	}
+    }
+    else {
+	if (*name == '<') {
+	    mode[0] = 'r';
+	    name++;
+	    while (isSPACE(*name))
+		name++;
+	    if (*name == '&')
+		goto duplicity;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		stio->type = '-';
+	    }
+	    else
+		fp = fopen(name,mode);
+	}
+	else if (name[len-1] == '|') {
+#ifdef TAINT
+	    taintenv();
+	    taintproper("Insecure dependency in piped open");
+#endif
+	    name[--len] = '\0';
+	    while (len && isSPACE(name[len-1]))
+		name[--len] = '\0';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    fp = mypopen(name,"r");
+	    stio->type = '|';
+	}
+	else {
+	    stio->type = '<';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		stio->type = '-';
+	    }
+	    else
+		fp = fopen(name,"r");
+	}
+    }
+    if (!fp) {
+	if (dowarn && stio->type == '<' && index(name, '\n'))
+	    warn(warn_nl, "open");
+	Safefree(myname);
+	goto say_false;
+    }
+    Safefree(myname);
+    if (stio->type &&
+      stio->type != '|' && stio->type != '-') {
+	if (fstat(fileno(fp),&statbuf) < 0) {
+	    (void)fclose(fp);
+	    goto say_false;
+	}
+	if (S_ISSOCK(statbuf.st_mode))
+	    stio->type = '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), tokenbuf, &buflen) >= 0
+		|| errno != ENOTSOCK)
+		stio->type = '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;
+	    STR *str;
+
+	    dup2(fileno(fp), fd);
+	    str = afetch(fdpid,fileno(fp),TRUE);
+	    pid = str->str_u.str_useful;
+	    str->str_u.str_useful = 0;
+	    str = afetch(fdpid,fd,TRUE);
+	    str->str_u.str_useful = pid;
+	    fclose(fp);
+
+	}
+	fp = saveifp;
+	clearerr(fp);
+    }
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fd = fileno(fp);
+    fcntl(fd,F_SETFD,fd > maxsysfd);
+#endif
+    stio->ifp = fp;
+    if (writing) {
+	if (stio->type == 's'
+	  || (stio->type == '>' && S_ISCHR(statbuf.st_mode)) ) {
+	    if (!(stio->ofp = fdopen(fileno(fp),"w"))) {
+		fclose(fp);
+		stio->ifp = Nullfp;
+		goto say_false;
+	    }
+	}
+	else
+	    stio->ofp = fp;
+    }
+    return TRUE;
+
+say_false:
+    stio->ifp = saveifp;
+    stio->ofp = saveofp;
+    stio->type = savetype;
+    return FALSE;
+}
+
+FILE *
+nextargv(stab)
+register STAB *stab;
+{
+    register STR *str;
+#ifndef FLEXFILENAMES
+    int filedev;
+    int fileino;
+#endif
+    int fileuid;
+    int filegid;
+    static int filemode = 0;
+    static int lastfd;
+    static char *oldname;
+
+    if (!argvoutstab)
+	argvoutstab = stabent("ARGVOUT",TRUE);
+    if (filemode & (S_ISUID|S_ISGID)) {
+	fflush(stab_io(argvoutstab)->ifp);  /* chmod must follow last write */
+#ifdef HAS_FCHMOD
+	(void)fchmod(lastfd,filemode);
+#else
+	(void)chmod(oldname,filemode);
+#endif
+    }
+    filemode = 0;
+    while (alen(stab_xarray(stab)) >= 0) {
+	str = ashift(stab_xarray(stab));
+	str_sset(stab_val(stab),str);
+	STABSET(stab_val(stab));
+	oldname = str_get(stab_val(stab));
+	if (do_open(stab,oldname,stab_val(stab)->str_cur)) {
+	    if (inplace) {
+#ifdef TAINT
+		taintproper("Insecure dependency in inplace open");
+#endif
+		if (strEQ(oldname,"-")) {
+		    str_free(str);
+		    defoutstab = stabent("STDOUT",TRUE);
+		    return stab_io(stab)->ifp;
+		}
+#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(stab,FALSE);
+		    str_free(str);
+		    continue;
+		}
+		if (*inplace) {
+#ifdef SUFFIX
+		    add_suffix(str,inplace);
+#else
+		    str_cat(str,inplace);
+#endif
+#ifndef FLEXFILENAMES
+		    if (stat(str->str_ptr,&statbuf) >= 0
+		      && statbuf.st_dev == filedev
+		      && statbuf.st_ino == fileino ) {
+			warn("Can't do inplace edit: %s > 14 characters",
+			  str->str_ptr );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#endif
+#ifdef HAS_RENAME
+#ifndef DOSISH
+		    if (rename(oldname,str->str_ptr) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#else
+		    do_close(stab,FALSE);
+		    (void)unlink(str->str_ptr);
+		    (void)rename(oldname,str->str_ptr);
+		    do_open(stab,str->str_ptr,stab_val(stab)->str_cur);
+#endif /* MSDOS */
+#else
+		    (void)UNLINK(str->str_ptr);
+		    if (link(oldname,str->str_ptr) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+		    (void)UNLINK(oldname);
+#endif
+		}
+		else {
+#ifndef DOSISH
+		    if (UNLINK(oldname) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#else
+		    fatal("Can't do inplace edit without backup");
+#endif
+		}
+
+		str_nset(str,">",1);
+		str_cat(str,oldname);
+		errno = 0;		/* in case sprintf set errno */
+		if (!do_open(argvoutstab,str->str_ptr,str->str_cur)) {
+		    warn("Can't do inplace edit on %s: %s",
+		      oldname, strerror(errno) );
+		    do_close(stab,FALSE);
+		    str_free(str);
+		    continue;
+		}
+		defoutstab = argvoutstab;
+		lastfd = fileno(stab_io(argvoutstab)->ifp);
+		(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
+		}
+	    }
+	    str_free(str);
+	    return stab_io(stab)->ifp;
+	}
+	else
+	    fprintf(stderr,"Can't open %s: %s\n",str_get(str), strerror(errno));
+	str_free(str);
+    }
+    if (inplace) {
+	(void)do_close(argvoutstab,FALSE);
+	defoutstab = stabent("STDOUT",TRUE);
+    }
+    return Nullfp;
+}
+
+#ifdef HAS_PIPE
+void
+do_pipe(str, rstab, wstab)
+STR *str;
+STAB *rstab;
+STAB *wstab;
+{
+    register STIO *rstio;
+    register STIO *wstio;
+    int fd[2];
+
+    if (!rstab)
+	goto badexit;
+    if (!wstab)
+	goto badexit;
+
+    rstio = stab_io(rstab);
+    wstio = stab_io(wstab);
+
+    if (!rstio)
+	rstio = stab_io(rstab) = stio_new();
+    else if (rstio->ifp)
+	do_close(rstab,FALSE);
+    if (!wstio)
+	wstio = stab_io(wstab) = stio_new();
+    else if (wstio->ifp)
+	do_close(wstab,FALSE);
+
+    if (pipe(fd) < 0)
+	goto badexit;
+    rstio->ifp = fdopen(fd[0], "r");
+    wstio->ofp = fdopen(fd[1], "w");
+    wstio->ifp = wstio->ofp;
+    rstio->type = '<';
+    wstio->type = '>';
+    if (!rstio->ifp || !wstio->ofp) {
+	if (rstio->ifp) fclose(rstio->ifp);
+	else close(fd[0]);
+	if (wstio->ofp) fclose(wstio->ofp);
+	else close(fd[1]);
+	goto badexit;
+    }
+
+    str_sset(str,&str_yes);
+    return;
+
+badexit:
+    str_sset(str,&str_undef);
+    return;
+}
+#endif
+
+bool
+do_close(stab,explicit)
+STAB *stab;
+bool explicit;
+{
+    bool retval = FALSE;
+    register STIO *stio;
+    int status;
+
+    if (!stab)
+	stab = argvstab;
+    if (!stab) {
+	errno = EBADF;
+	return FALSE;
+    }
+    stio = stab_io(stab);
+    if (!stio) {		/* never opened */
+	if (dowarn && explicit)
+	    warn("Close on unopened file <%s>",stab_ename(stab));
+	return FALSE;
+    }
+    if (stio->ifp) {
+	if (stio->type == '|') {
+	    status = mypclose(stio->ifp);
+	    retval = (status == 0);
+	    statusvalue = (unsigned short)status & 0xffff;
+	}
+	else if (stio->type == '-')
+	    retval = TRUE;
+	else {
+	    if (stio->ofp && stio->ofp != stio->ifp) {		/* a socket */
+		retval = (fclose(stio->ofp) != EOF);
+		fclose(stio->ifp);	/* clear stdio, fd already closed */
+	    }
+	    else
+		retval = (fclose(stio->ifp) != EOF);
+	}
+	stio->ofp = stio->ifp = Nullfp;
+    }
+    if (explicit)
+	stio->lines = 0;
+    stio->type = ' ';
+    return retval;
+}
+
+bool
+do_eof(stab)
+STAB *stab;
+{
+    register STIO *stio;
+    int ch;
+
+    if (!stab) {			/* eof() */
+	if (argvstab)
+	    stio = stab_io(argvstab);
+	else
+	    return TRUE;
+    }
+    else
+	stio = stab_io(stab);
+
+    if (!stio)
+	return TRUE;
+
+    while (stio->ifp) {
+
+#ifdef STDSTDIO			/* (the code works without this) */
+	if (stio->ifp->_cnt > 0)	/* cheat a little, since */
+	    return FALSE;		/* this is the most usual case */
+#endif
+
+	ch = getc(stio->ifp);
+	if (ch != EOF) {
+	    (void)ungetc(ch, stio->ifp);
+	    return FALSE;
+	}
+#ifdef STDSTDIO
+	if (stio->ifp->_cnt < -1)
+	    stio->ifp->_cnt = -1;
+#endif
+	if (!stab) {			/* not necessarily a real EOF yet? */
+	    if (!nextargv(argvstab))	/* get another fp handy */
+		return TRUE;
+	}
+	else
+	    return TRUE;		/* normal fp, definitely end of file */
+    }
+    return TRUE;
+}
+
+long
+do_tell(stab)
+STAB *stab;
+{
+    register STIO *stio;
+
+    if (!stab)
+	goto phooey;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto phooey;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(stio->ifp))
+	(void)fseek (stio->ifp, 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return ftell(stio->ifp);
+
+phooey:
+    if (dowarn)
+	warn("tell() on unopened file");
+    errno = EBADF;
+    return -1L;
+}
+
+bool
+do_seek(stab, pos, whence)
+STAB *stab;
+long pos;
+int whence;
+{
+    register STIO *stio;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(stio->ifp))
+	(void)fseek (stio->ifp, 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return fseek(stio->ifp, pos, whence) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("seek() on unopened file");
+    errno = EBADF;
+    return FALSE;
+}
+
+int
+do_ctl(optype,stab,func,argstr)
+int optype;
+STAB *stab;
+int func;
+STR *argstr;
+{
+    register STIO *stio;
+    register char *s;
+    int retval;
+
+    if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
+	errno = EBADF;	/* well, sort of... */
+	return -1;
+    }
+
+    if (argstr->str_pok || !argstr->str_nok) {
+	if (!argstr->str_pok)
+	    s = str_get(argstr);
+
+#ifdef IOCPARM_MASK
+#ifndef IOCPARM_LEN
+#define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
+#endif
+#endif
+#ifdef IOCPARM_LEN
+	retval = IOCPARM_LEN(func);	/* on BSDish systes we're safe */
+#else
+	retval = 256;			/* otherwise guess at what's safe */
+#endif
+	if (argstr->str_cur < retval) {
+	    Str_Grow(argstr,retval+1);
+	    argstr->str_cur = retval;
+	}
+
+	s = argstr->str_ptr;
+	s[argstr->str_cur] = 17;	/* a little sanity check here */
+    }
+    else {
+	retval = (int)str_gnum(argstr);
+#ifdef DOSISH
+	s = (char*)(long)retval;		/* ouch */
+#else
+	s = (char*)retval;		/* ouch */
+#endif
+    }
+
+#ifndef lint
+    if (optype == O_IOCTL)
+	retval = ioctl(fileno(stio->ifp), func, s);
+    else
+#ifdef DOSISH
+	fatal("fcntl is not implemented");
+#else
+#ifdef HAS_FCNTL
+	retval = fcntl(fileno(stio->ifp), func, s);
+#else
+	fatal("fcntl is not implemented");
+#endif
+#endif
+#else /* lint */
+    retval = 0;
+#endif /* lint */
+
+    if (argstr->str_pok) {
+	if (s[argstr->str_cur] != 17)
+	    fatal("Return value overflowed string");
+	s[argstr->str_cur] = 0;		/* put our null back */
+    }
+    return retval;
+}
+
+int
+do_stat(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    int max = 13;
+
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (tmpstab != defstab) {
+	    laststype = O_STAT;
+	    statstab = tmpstab;
+	    str_set(statname,"");
+	    if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	      fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
+		max = 0;
+		laststatval = -1;
+	    }
+	}
+	else if (laststatval < 0)
+	    max = 0;
+    }
+    else {
+	str_set(statname,str_get(ary->ary_array[sp]));
+	statstab = Nullstab;
+#ifdef HAS_LSTAT
+	laststype = arg->arg_type;
+	if (arg->arg_type == O_LSTAT)
+	    laststatval = lstat(str_get(statname),&statcache);
+	else
+#endif
+	    laststatval = stat(str_get(statname),&statcache);
+	if (laststatval < 0) {
+	    if (dowarn && index(str_get(statname), '\n'))
+		warn(warn_nl, "stat");
+	    max = 0;
+	}
+    }
+
+    if (gimme != G_ARRAY) {
+	if (max)
+	    str_sset(str,&str_yes);
+	else
+	    str_sset(str,&str_undef);
+	STABSET(str);
+	ary->ary_array[sp] = str;
+	return sp;
+    }
+    sp--;
+    if (max) {
+#ifndef lint
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_dev)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_ino)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_mode)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_nlink)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_uid)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_gid)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_rdev)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_size)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_atime)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_mtime)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_ctime)));
+#ifdef STATBLOCKS
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_blksize)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_blocks)));
+#else
+	(void)astore(ary,++sp,
+	  str_2mortal(str_make("",0)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_make("",0)));
+#endif
+#else /* lint */
+	(void)astore(ary,++sp,str_nmake(0.0));
+#endif /* lint */
+    }
+    return sp;
+}
+
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+	/* code courtesy of William Kucharski */
+#define HAS_CHSIZE
+
+int chsize(fd, length)
+int 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 */
+
+int					/*SUPPRESS 590*/
+do_truncate(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    off_t len = (off_t)str_gnum(ary->ary_array[sp+1]);
+    int result = 1;
+    STAB *tmpstab;
+
+#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
+#ifdef HAS_TRUNCATE
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	  ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else if (truncate(str_get(ary->ary_array[sp]), len) < 0)
+	result = 0;
+#else
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	  chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else {
+	int tmpfd;
+
+	if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0)
+	    result = 0;
+	else {
+	    if (chsize(tmpfd, len) < 0)
+		result = 0;
+	    close(tmpfd);
+	}
+    }
+#endif
+
+    if (result)
+	str_sset(str,&str_yes);
+    else
+	str_sset(str,&str_undef);
+    STABSET(str);
+    ary->ary_array[sp] = str;
+    return sp;
+#else
+    fatal("truncate not implemented");
+#endif
+}
+
+int
+looks_like_number(str)
+STR *str;
+{
+    register char *s;
+    register char *send;
+
+    if (!str->str_pok)
+	return TRUE;
+    s = str->str_ptr; 
+    send = s + str->str_cur;
+    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 == str->str_ptr)
+	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(str,fp)
+register STR *str;
+FILE *fp;
+{
+    register char *tmps;
+
+    if (!fp) {
+	if (dowarn)
+	    warn("print to unopened file");
+	errno = EBADF;
+	return FALSE;
+    }
+    if (!str)
+	return TRUE;
+    if (ofmt &&
+      ((str->str_nok && str->str_u.str_nval != 0.0)
+       || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
+	fprintf(fp, ofmt, str->str_u.str_nval);
+	return !ferror(fp);
+    }
+    else {
+	tmps = str_get(str);
+	if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
+	  && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
+	    STR *tmpstr = str_mortal(&str_undef);
+	    stab_efullname(tmpstr,((STAB*)str));/* a stab value, be nice */
+	    str = tmpstr;
+	    tmps = str->str_ptr;
+	    putc('*',fp);
+	}
+	if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
+	    return FALSE;
+    }
+    return TRUE;
+}
+
+bool
+do_aprint(arg,fp,arglast)
+register ARG *arg;
+register FILE *fp;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int retval;
+    register int items = arglast[2] - sp;
+
+    if (!fp) {
+	if (dowarn)
+	    warn("print to unopened file");
+	errno = EBADF;
+	return FALSE;
+    }
+    st += ++sp;
+    if (arg->arg_type == O_PRTF) {
+	do_sprintf(arg->arg_ptr.arg_str,items,st);
+	retval = do_print(arg->arg_ptr.arg_str,fp);
+    }
+    else {
+	retval = (items <= 0);
+	for (; items > 0; items--,st++) {
+	    if (retval && ofslen) {
+		if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
+		    retval = FALSE;
+		    break;
+		}
+	    }
+	    if (!(retval = do_print(*st, fp)))
+		break;
+	}
+	if (retval && orslen)
+	    if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
+		retval = FALSE;
+    }
+    return retval;
+}
+
+int
+mystat(arg,str)
+ARG *arg;
+STR *str;
+{
+    STIO *stio;
+
+    if (arg[1].arg_type & A_DONT) {
+	stio = stab_io(arg[1].arg_ptr.arg_stab);
+	if (stio && stio->ifp) {
+	    statstab = arg[1].arg_ptr.arg_stab;
+	    str_set(statname,"");
+	    laststype = O_STAT;
+	    return (laststatval = fstat(fileno(stio->ifp), &statcache));
+	}
+	else {
+	    if (arg[1].arg_ptr.arg_stab == defstab)
+		return laststatval;
+	    if (dowarn)
+		warn("Stat on unopened file <%s>",
+		  stab_ename(arg[1].arg_ptr.arg_stab));
+	    statstab = Nullstab;
+	    str_set(statname,"");
+	    return (laststatval = -1);
+	}
+    }
+    else {
+	statstab = Nullstab;
+	str_set(statname,str_get(str));
+	laststype = O_STAT;
+	laststatval = stat(str_get(str),&statcache);
+	if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+	    warn(warn_nl, "stat");
+	return laststatval;
+    }
+}
+
+int
+mylstat(arg,str)
+ARG *arg;
+STR *str;
+{
+    if (arg[1].arg_type & A_DONT) {
+	if (arg[1].arg_ptr.arg_stab == defstab) {
+	    if (laststype != O_LSTAT)
+		fatal("The stat preceding -l _ wasn't an lstat");
+	    return laststatval;
+	}
+	fatal("You can't use -l on a filehandle");
+    }
+
+    laststype = O_LSTAT;
+    statstab = Nullstab;
+    str_set(statname,str_get(str));
+#ifdef HAS_LSTAT
+    laststatval = lstat(str_get(str),&statcache);
+#else
+    laststatval = stat(str_get(str),&statcache);
+#endif
+    if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+	warn(warn_nl, "lstat");
+    return laststatval;
+}
+
+STR *
+do_fttext(arg,str)
+register ARG *arg;
+STR *str;
+{
+    int i;
+    int len;
+    int odd = 0;
+    STDCHAR tbuf[512];
+    register STDCHAR *s;
+    register STIO *stio;
+
+    if (arg[1].arg_type & A_DONT) {
+	if (arg[1].arg_ptr.arg_stab == defstab) {
+	    if (statstab)
+		stio = stab_io(statstab);
+	    else {
+		str = statname;
+		goto really_filename;
+	    }
+	}
+	else {
+	    statstab = arg[1].arg_ptr.arg_stab;
+	    str_set(statname,"");
+	    stio = stab_io(statstab);
+	}
+	if (stio && stio->ifp) {
+#if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */
+	    fstat(fileno(stio->ifp),&statcache);
+	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
+		return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
+	    if (stio->ifp->_cnt <= 0) {
+		i = getc(stio->ifp);
+		if (i != EOF)
+		    (void)ungetc(i,stio->ifp);
+	    }
+	    if (stio->ifp->_cnt <= 0)	/* null file is anything */
+		return &str_yes;
+	    len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
+	    s = stio->ifp->_base;
+#else
+	    fatal("-T and -B not implemented on filehandles");
+#endif
+	}
+	else {
+	    if (dowarn)
+		warn("Test on unopened file <%s>",
+		  stab_ename(arg[1].arg_ptr.arg_stab));
+	    errno = EBADF;
+	    return &str_undef;
+	}
+    }
+    else {
+	statstab = Nullstab;
+	str_set(statname,str_get(str));
+      really_filename:
+	i = open(str_get(str),0);
+	if (i < 0) {
+	    if (dowarn && index(str_get(str), '\n'))
+		warn(warn_nl, "open");
+	    return &str_undef;
+	}
+	fstat(i,&statcache);
+	len = read(i,tbuf,512);
+	(void)close(i);
+	if (len <= 0) {
+	    if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
+		return &str_no;		/* special case NFS directories */
+	    return &str_yes;		/* null file is anything */
+	}
+	s = tbuf;
+    }
+
+    /* now scan s to look for textiness */
+
+    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 * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
+	return &str_no;
+    else
+	return &str_yes;
+}
+
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
+bool
+do_aexec(really,arglast)
+STR *really;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char **a;
+    char *tmps;
+
+    if (items) {
+	New(401,Argv, items+1, char*);
+	a = Argv;
+	for (st += ++sp; items > 0; items--,st++) {
+	    if (*st)
+		*a++ = str_get(*st);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+#ifdef TAINT
+	if (*Argv[0] != '/')	/* will execvp use PATH? */
+	    taintenv();		/* testing IFS here is overkill, probably */
+#endif
+	if (really && *(tmps = str_get(really)))
+	    execvp(tmps,Argv);
+	else
+	    execvp(Argv[0],Argv);
+    }
+    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];
+
+    /* 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 */
+
+    /*SUPPRESS 530*/
+    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
+    if (*s == '=')
+	goto doshell;
+    for (s = cmd; *s; s++) {
+	if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\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 = nsavestr(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;
+	}
+    }
+    do_execfree();
+    return FALSE;
+}
+
+#ifdef HAS_SOCKET
+int
+do_socket(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int domain, type, protocol, fd;
+
+    if (!stab) {
+	errno = EBADF;
+	return FALSE;
+    }
+
+    stio = stab_io(stab);
+    if (!stio)
+	stio = stab_io(stab) = stio_new();
+    else if (stio->ifp)
+	do_close(stab,FALSE);
+
+    domain = (int)str_gnum(st[++sp]);
+    type = (int)str_gnum(st[++sp]);
+    protocol = (int)str_gnum(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in socket");
+#endif
+    fd = socket(domain,type,protocol);
+    if (fd < 0)
+	return FALSE;
+    stio->ifp = fdopen(fd, "r");	/* stdio gets confused about sockets */
+    stio->ofp = fdopen(fd, "w");
+    stio->type = 's';
+    if (!stio->ifp || !stio->ofp) {
+	if (stio->ifp) fclose(stio->ifp);
+	if (stio->ofp) fclose(stio->ofp);
+	if (!stio->ifp && !stio->ofp) close(fd);
+	return FALSE;
+    }
+
+    return TRUE;
+}
+
+int
+do_bind(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    char *addr;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    addr = str_get(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in bind");
+#endif
+    return bind(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("bind() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_connect(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    char *addr;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    addr = str_get(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in connect");
+#endif
+    return connect(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("connect() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_listen(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int backlog;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    backlog = (int)str_gnum(st[++sp]);
+    return listen(fileno(stio->ifp), backlog) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("listen() on closed fd");
+    errno = EBADF;
+    return FALSE;
+}
+
+void
+do_accept(str, nstab, gstab)
+STR *str;
+STAB *nstab;
+STAB *gstab;
+{
+    register STIO *nstio;
+    register STIO *gstio;
+    int len = sizeof buf;
+    int fd;
+
+    if (!nstab)
+	goto badexit;
+    if (!gstab)
+	goto nuts;
+
+    gstio = stab_io(gstab);
+    nstio = stab_io(nstab);
+
+    if (!gstio || !gstio->ifp)
+	goto nuts;
+    if (!nstio)
+	nstio = stab_io(nstab) = stio_new();
+    else if (nstio->ifp)
+	do_close(nstab,FALSE);
+
+    fd = accept(fileno(gstio->ifp),(struct sockaddr *)buf,&len);
+    if (fd < 0)
+	goto badexit;
+    nstio->ifp = fdopen(fd, "r");
+    nstio->ofp = fdopen(fd, "w");
+    nstio->type = 's';
+    if (!nstio->ifp || !nstio->ofp) {
+	if (nstio->ifp) fclose(nstio->ifp);
+	if (nstio->ofp) fclose(nstio->ofp);
+	if (!nstio->ifp && !nstio->ofp) close(fd);
+	goto badexit;
+    }
+
+    str_nset(str, buf, len);
+    return;
+
+nuts:
+    if (dowarn)
+	warn("accept() on closed fd");
+    errno = EBADF;
+badexit:
+    str_sset(str,&str_undef);
+    return;
+}
+
+int
+do_shutdown(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int how;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    how = (int)str_gnum(st[++sp]);
+    return shutdown(fileno(stio->ifp), how) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("shutdown() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_sopt(optype, stab, arglast)
+int optype;
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int fd;
+    unsigned int lvl;
+    unsigned int optname;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    fd = fileno(stio->ifp);
+    lvl = (unsigned int)str_gnum(st[sp+1]);
+    optname = (unsigned int)str_gnum(st[sp+2]);
+    switch (optype) {
+    case O_GSOCKOPT:
+	st[sp] = str_2mortal(Str_new(22,257));
+	st[sp]->str_cur = 256;
+	st[sp]->str_pok = 1;
+	if (getsockopt(fd, lvl, optname, st[sp]->str_ptr,
+			(int*)&st[sp]->str_cur) < 0)
+	    goto nuts;
+	break;
+    case O_SSOCKOPT:
+	st[sp] = st[sp+3];
+	if (setsockopt(fd, lvl, optname, st[sp]->str_ptr, st[sp]->str_cur) < 0)
+	    goto nuts;
+	st[sp] = &str_yes;
+	break;
+    }
+    
+    return sp;
+
+nuts:
+    if (dowarn)
+	warn("[gs]etsockopt() on closed fd");
+    st[sp] = &str_undef;
+    errno = EBADF;
+    return sp;
+
+}
+
+int
+do_getsockname(optype, stab, arglast)
+int optype;
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int fd;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    st[sp] = str_2mortal(Str_new(22,257));
+    st[sp]->str_cur = 256;
+    st[sp]->str_pok = 1;
+    fd = fileno(stio->ifp);
+    switch (optype) {
+    case O_GETSOCKNAME:
+	if (getsockname(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
+	    goto nuts2;
+	break;
+    case O_GETPEERNAME:
+	if (getpeername(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
+	    goto nuts2;
+	break;
+    }
+    
+    return sp;
+
+nuts:
+    if (dowarn)
+	warn("get{sock,peer}name() on closed fd");
+    errno = EBADF;
+nuts2:
+    st[sp] = &str_undef;
+    return sp;
+
+}
+
+int
+do_ghent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct hostent *gethostbyname();
+    struct hostent *gethostbyaddr();
+#ifdef HAS_GETHOSTENT
+    struct hostent *gethostent();
+#endif
+    struct hostent *hent;
+    unsigned long len;
+
+    if (which == O_GHBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	hent = gethostbyname(name);
+    }
+    else if (which == O_GHBYADDR) {
+	STR *addrstr = ary->ary_array[sp+1];
+	int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
+	char *addr = str_get(addrstr);
+
+	hent = gethostbyaddr(addr,addrstr->str_cur,addrtype);
+    }
+    else
+#ifdef HAS_GETHOSTENT
+	hent = gethostent();
+#else
+	fatal("gethostent not implemented");
+#endif
+
+#ifdef HOST_NOT_FOUND
+    if (!hent)
+	statusvalue = (unsigned short)h_errno & 0xffff;
+#endif
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (hent) {
+	    if (which == O_GHBYNAME) {
+#ifdef h_addr
+		str_nset(str, *hent->h_addr, hent->h_length);
+#else
+		str_nset(str, hent->h_addr, hent->h_length);
+#endif
+	    }
+	    else
+		str_set(str, hent->h_name);
+	}
+	return sp;
+    }
+
+    if (hent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, hent->h_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = hent->h_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)hent->h_addrtype);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	len = hent->h_length;
+	str_numset(str, (double)len);
+#ifdef h_addr
+	for (elem = hent->h_addr_list; *elem; elem++) {
+	    (void)astore(ary, ++sp, str = str_mortal(&str_no));
+	    str_nset(str, *elem, len);
+	}
+#else
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_nset(str, hent->h_addr, len);
+#endif /* h_addr */
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gnent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct netent *getnetbyname();
+    struct netent *getnetbyaddr();
+    struct netent *getnetent();
+    struct netent *nent;
+
+    if (which == O_GNBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	nent = getnetbyname(name);
+    }
+    else if (which == O_GNBYADDR) {
+	unsigned long addr = U_L(str_gnum(ary->ary_array[sp+1]));
+	int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
+
+	nent = getnetbyaddr((long)addr,addrtype);
+    }
+    else
+	nent = getnetent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (nent) {
+	    if (which == O_GNBYNAME)
+		str_numset(str, (double)nent->n_net);
+	    else
+		str_set(str, nent->n_name);
+	}
+	return sp;
+    }
+
+    if (nent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, nent->n_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = nent->n_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)nent->n_addrtype);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)nent->n_net);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gpent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct protoent *getprotobyname();
+    struct protoent *getprotobynumber();
+    struct protoent *getprotoent();
+    struct protoent *pent;
+
+    if (which == O_GPBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	pent = getprotobyname(name);
+    }
+    else if (which == O_GPBYNUMBER) {
+	int proto = (int)str_gnum(ary->ary_array[sp+1]);
+
+	pent = getprotobynumber(proto);
+    }
+    else
+	pent = getprotoent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (pent) {
+	    if (which == O_GPBYNAME)
+		str_numset(str, (double)pent->p_proto);
+	    else
+		str_set(str, pent->p_name);
+	}
+	return sp;
+    }
+
+    if (pent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pent->p_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = pent->p_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pent->p_proto);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gsent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct servent *getservbyname();
+    struct servent *getservbynumber();
+    struct servent *getservent();
+    struct servent *sent;
+
+    if (which == O_GSBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+	char *proto = str_get(ary->ary_array[sp+2]);
+
+	if (proto && !*proto)
+	    proto = Nullch;
+
+	sent = getservbyname(name,proto);
+    }
+    else if (which == O_GSBYPORT) {
+	int port = (int)str_gnum(ary->ary_array[sp+1]);
+	char *proto = str_get(ary->ary_array[sp+2]);
+
+	sent = getservbyport(port,proto);
+    }
+    else
+	sent = getservent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (sent) {
+	    if (which == O_GSBYNAME) {
+#ifdef HAS_NTOHS
+		str_numset(str, (double)ntohs(sent->s_port));
+#else
+		str_numset(str, (double)(sent->s_port));
+#endif
+	    }
+	    else
+		str_set(str, sent->s_name);
+	}
+	return sp;
+    }
+
+    if (sent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, sent->s_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = sent->s_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef HAS_NTOHS
+	str_numset(str, (double)ntohs(sent->s_port));
+#else
+	str_numset(str, (double)(sent->s_port));
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, sent->s_proto);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+#endif /* HAS_SOCKET */
+
+#ifdef HAS_SELECT
+int
+do_select(gimme,arglast)
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register int i;
+    register int j;
+    register char *s;
+    register STR *str;
+    double value;
+    int maxlen = 0;
+    int nfound;
+    struct timeval timebuf;
+    struct timeval *tbuf = &timebuf;
+    int growsize;
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+    int masksize;
+    int offset;
+    char *fd_sets[4];
+    int k;
+
+#if BYTEORDER & 0xf0000
+#define ORDERBYTE (0x88888888 - BYTEORDER)
+#else
+#define ORDERBYTE (0x4444 - BYTEORDER)
+#endif
+
+#endif
+
+    for (i = 1; i <= 3; i++) {
+	j = st[sp+i]->str_cur;
+	if (maxlen < j)
+	    maxlen = j;
+    }
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+    growsize = maxlen;		/* little endians can use vecs directly */
+#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
+
+    for (i = 1; i <= 3; i++) {
+	str = st[sp+i];
+	j = str->str_len;
+	if (j < growsize) {
+	    if (str->str_pok) {
+		Str_Grow(str,growsize);
+		s = str_get(str) + j;
+		while (++j <= growsize) {
+		    *s++ = '\0';
+		}
+	    }
+	    else if (str->str_ptr) {
+		Safefree(str->str_ptr);
+		str->str_ptr = Nullch;
+	    }
+	}
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+	s = str->str_ptr;
+	if (s) {
+	    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];
+	    }
+	}
+#endif
+    }
+    str = st[sp+4];
+    if (str->str_nok || str->str_pok) {
+	value = str_gnum(str);
+	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*);
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+    nfound = select(
+	maxlen * 8,
+	st[sp+1]->str_ptr,
+	st[sp+2]->str_ptr,
+	st[sp+3]->str_ptr,
+	tbuf);
+#else
+    nfound = select(
+	maxlen * 8,
+	fd_sets[1],
+	fd_sets[2],
+	fd_sets[3],
+	tbuf);
+    for (i = 1; i <= 3; i++) {
+	if (fd_sets[i]) {
+	    str = st[sp+i];
+	    s = str->str_ptr;
+	    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
+
+    st[++sp] = str_mortal(&str_no);
+    str_numset(st[sp], (double)nfound);
+    if (gimme == G_ARRAY && tbuf) {
+	value = (double)(timebuf.tv_sec) +
+		(double)(timebuf.tv_usec) / 1000000.0;
+	st[++sp] = str_mortal(&str_no);
+	str_numset(st[sp], value);
+    }
+    return sp;
+}
+#endif /* SELECT */
+
+#ifdef HAS_SOCKET
+int
+do_spair(stab1, stab2, arglast)
+STAB *stab1;
+STAB *stab2;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[2];
+    register STIO *stio1;
+    register STIO *stio2;
+    int domain, type, protocol, fd[2];
+
+    if (!stab1 || !stab2)
+	return FALSE;
+
+    stio1 = stab_io(stab1);
+    stio2 = stab_io(stab2);
+    if (!stio1)
+	stio1 = stab_io(stab1) = stio_new();
+    else if (stio1->ifp)
+	do_close(stab1,FALSE);
+    if (!stio2)
+	stio2 = stab_io(stab2) = stio_new();
+    else if (stio2->ifp)
+	do_close(stab2,FALSE);
+
+    domain = (int)str_gnum(st[++sp]);
+    type = (int)str_gnum(st[++sp]);
+    protocol = (int)str_gnum(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in socketpair");
+#endif
+#ifdef HAS_SOCKETPAIR
+    if (socketpair(domain,type,protocol,fd) < 0)
+	return FALSE;
+#else
+    fatal("Socketpair unimplemented");
+#endif
+    stio1->ifp = fdopen(fd[0], "r");
+    stio1->ofp = fdopen(fd[0], "w");
+    stio1->type = 's';
+    stio2->ifp = fdopen(fd[1], "r");
+    stio2->ofp = fdopen(fd[1], "w");
+    stio2->type = 's';
+    if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) {
+	if (stio1->ifp) fclose(stio1->ifp);
+	if (stio1->ofp) fclose(stio1->ofp);
+	if (!stio1->ifp && !stio1->ofp) close(fd[0]);
+	if (stio2->ifp) fclose(stio2->ifp);
+	if (stio2->ofp) fclose(stio2->ofp);
+	if (!stio2->ifp && !stio2->ofp) close(fd[1]);
+	return FALSE;
+    }
+
+    return TRUE;
+}
+
+#endif /* HAS_SOCKET */
+
+int
+do_gpwent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+#ifdef I_PWD
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register STR *str;
+    struct passwd *getpwnam();
+    struct passwd *getpwuid();
+    struct passwd *getpwent();
+    struct passwd *pwent;
+
+    if (which == O_GPWNAM) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	pwent = getpwnam(name);
+    }
+    else if (which == O_GPWUID) {
+	int uid = (int)str_gnum(ary->ary_array[sp+1]);
+
+	pwent = getpwuid(uid);
+    }
+    else
+	pwent = getpwent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (pwent) {
+	    if (which == O_GPWNAM)
+		str_numset(str, (double)pwent->pw_uid);
+	    else
+		str_set(str, pwent->pw_name);
+	}
+	return sp;
+    }
+
+    if (pwent) {
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_passwd);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_uid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_gid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef PWCHANGE
+	str_numset(str, (double)pwent->pw_change);
+#else
+#ifdef PWQUOTA
+	str_numset(str, (double)pwent->pw_quota);
+#else
+#ifdef PWAGE
+	str_set(str, pwent->pw_age);
+#endif
+#endif
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef PWCLASS
+	str_set(str,pwent->pw_class);
+#else
+#ifdef PWCOMMENT
+	str_set(str, pwent->pw_comment);
+#endif
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_gecos);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_dir);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_shell);
+#ifdef PWEXPIRE
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_expire);
+#endif
+    }
+
+    return sp;
+#else
+    fatal("password routines not implemented");
+#endif
+}
+
+int
+do_ggrent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+#ifdef I_GRP
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct group *getgrnam();
+    struct group *getgrgid();
+    struct group *getgrent();
+    struct group *grent;
+
+    if (which == O_GGRNAM) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	grent = getgrnam(name);
+    }
+    else if (which == O_GGRGID) {
+	int gid = (int)str_gnum(ary->ary_array[sp+1]);
+
+	grent = getgrgid(gid);
+    }
+    else
+	grent = getgrent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (grent) {
+	    if (which == O_GGRNAM)
+		str_numset(str, (double)grent->gr_gid);
+	    else
+		str_set(str, grent->gr_name);
+	}
+	return sp;
+    }
+
+    if (grent) {
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, grent->gr_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, grent->gr_passwd);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)grent->gr_gid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = grent->gr_mem; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+    }
+
+    return sp;
+#else
+    fatal("group routines not implemented");
+#endif
+}
+
+int
+do_dirop(optype,stab,gimme,arglast)
+int optype;
+STAB *stab;
+int gimme;
+int *arglast;
+{
+#if defined(DIRENT) && defined(HAS_READDIR)
+    register ARRAY *ary = stack;
+    register STR **st = ary->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    long along;
+#ifndef apollo
+    struct DIRENT *readdir();
+#endif
+    register struct DIRENT *dp;
+
+    if (!stab)
+	goto nope;
+    if (!(stio = stab_io(stab)))
+	stio = stab_io(stab) = stio_new();
+    if (!stio->dirp && optype != O_OPEN_DIR)
+	goto nope;
+    st[sp] = &str_yes;
+    switch (optype) {
+    case O_OPEN_DIR:
+	if (stio->dirp)
+	    closedir(stio->dirp);
+	if (!(stio->dirp = opendir(str_get(st[sp+1]))))
+	    goto nope;
+	break;
+    case O_READDIR:
+	if (gimme == G_ARRAY) {
+	    --sp;
+	    /*SUPPRESS 560*/
+	    while (dp = readdir(stio->dirp)) {
+#ifdef DIRNAMLEN
+		(void)astore(ary,++sp,
+		  str_2mortal(str_make(dp->d_name,dp->d_namlen)));
+#else
+		(void)astore(ary,++sp,
+		  str_2mortal(str_make(dp->d_name,0)));
+#endif
+	    }
+	}
+	else {
+	    if (!(dp = readdir(stio->dirp)))
+		goto nope;
+	    st[sp] = str_mortal(&str_undef);
+#ifdef DIRNAMLEN
+	    str_nset(st[sp], dp->d_name, dp->d_namlen);
+#else
+	    str_set(st[sp], dp->d_name);
+#endif
+	}
+	break;
+#if defined(HAS_TELLDIR) || defined(telldir)
+    case O_TELLDIR: {
+#ifndef telldir
+	    long telldir();
+#endif
+	    st[sp] = str_mortal(&str_undef);
+	    str_numset(st[sp], (double)telldir(stio->dirp));
+	    break;
+	}
+#endif
+#if defined(HAS_SEEKDIR) || defined(seekdir)
+    case O_SEEKDIR:
+	st[sp] = str_mortal(&str_undef);
+	along = (long)str_gnum(st[sp+1]);
+	(void)seekdir(stio->dirp,along);
+	break;
+#endif
+#if defined(HAS_REWINDDIR) || defined(rewinddir)
+    case O_REWINDDIR:
+	st[sp] = str_mortal(&str_undef);
+	(void)rewinddir(stio->dirp);
+	break;
+#endif
+    case O_CLOSEDIR:
+	st[sp] = str_mortal(&str_undef);
+	(void)closedir(stio->dirp);
+	stio->dirp = 0;
+	break;
+    default:
+	goto phooey;
+    }
+    return sp;
+
+nope:
+    st[sp] = &str_undef;
+    if (!errno)
+	errno = EBADF;
+    return sp;
+
+#endif
+phooey:
+    fatal("Unimplemented directory operation");
+}
+
+int
+apply(type,arglast)
+int type;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register int val;
+    register int val2;
+    register int tot = 0;
+    char *s;
+
+#ifdef TAINT
+    for (st += ++sp; items--; st++)
+	tainted |= (*st)->str_tainted;
+    st = stack->ary_array;
+    sp = arglast[1];
+    items = arglast[2] - sp;
+#endif
+    switch (type) {
+    case O_CHMOD:
+#ifdef TAINT
+	taintproper("Insecure dependency in chmod");
+#endif
+	if (--items > 0) {
+	    tot = items;
+	    val = (int)str_gnum(st[++sp]);
+	    while (items--) {
+		if (chmod(str_get(st[++sp]),val))
+		    tot--;
+	    }
+	}
+	break;
+#ifdef HAS_CHOWN
+    case O_CHOWN:
+#ifdef TAINT
+	taintproper("Insecure dependency in chown");
+#endif
+	if (items > 2) {
+	    items -= 2;
+	    tot = items;
+	    val = (int)str_gnum(st[++sp]);
+	    val2 = (int)str_gnum(st[++sp]);
+	    while (items--) {
+		if (chown(str_get(st[++sp]),val,val2))
+		    tot--;
+	    }
+	}
+	break;
+#endif
+#ifdef HAS_KILL
+    case O_KILL:
+#ifdef TAINT
+	taintproper("Insecure dependency in kill");
+#endif
+	if (--items > 0) {
+	    tot = items;
+	    s = str_get(st[++sp]);
+	    if (isUPPER(*s)) {
+		if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
+		    s += 3;
+		if (!(val = whichsig(s)))
+		    fatal("Unrecognized signal name \"%s\"",s);
+	    }
+	    else
+		val = (int)str_gnum(st[sp]);
+	    if (val < 0) {
+		val = -val;
+		while (items--) {
+		    int proc = (int)str_gnum(st[++sp]);
+#ifdef HAS_KILLPG
+		    if (killpg(proc,val))	/* BSD */
+#else
+		    if (kill(-proc,val))	/* SYSV */
+#endif
+			tot--;
+		}
+	    }
+	    else {
+		while (items--) {
+		    if (kill((int)(str_gnum(st[++sp])),val))
+			tot--;
+		}
+	    }
+	}
+	break;
+#endif
+    case O_UNLINK:
+#ifdef TAINT
+	taintproper("Insecure dependency in unlink");
+#endif
+	tot = items;
+	while (items--) {
+	    s = str_get(st[++sp]);
+	    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;
+    case O_UTIME:
+#ifdef TAINT
+	taintproper("Insecure dependency in utime");
+#endif
+	if (items > 2) {
+#ifdef I_UTIME
+	    struct utimbuf utbuf;
+#else
+	    struct {
+		long    actime;
+		long	modtime;
+	    } utbuf;
+#endif
+
+	    Zero(&utbuf, sizeof utbuf, char);
+	    utbuf.actime = (long)str_gnum(st[++sp]);    /* time accessed */
+	    utbuf.modtime = (long)str_gnum(st[++sp]);    /* time modified */
+	    items -= 2;
+#ifndef lint
+	    tot = items;
+	    while (items--) {
+		if (utime(str_get(st[++sp]),&utbuf))
+		    tot--;
+	    }
+#endif
+	}
+	else
+	    items = 0;
+	break;
+    }
+    return tot;
+}
+
+/* Do the permissions allow some operation?  Assumes statcache already set. */
+
+int
+cando(bit, effective, statbufp)
+int bit;
+int 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((int)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 */
+}
+
+int
+ingroup(testgid,effective)
+int testgid;
+int effective;
+{
+    if (testgid == (effective ? egid : gid))
+	return TRUE;
+#ifdef HAS_GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+    {
+	GROUPSTYPE gary[NGROUPS];
+	int 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)
+
+int
+do_ipcget(optype, arglast)
+int optype;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    key_t key;
+    int n, flags;
+
+    key = (key_t)str_gnum(st[++sp]);
+    n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]);
+    flags = (int)str_gnum(st[++sp]);
+    errno = 0;
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGGET:
+	return msgget(key, flags);
+#endif
+#ifdef HAS_SEM
+    case O_SEMGET:
+	return semget(key, n, flags);
+#endif
+#ifdef HAS_SHM
+    case O_SHMGET:
+	return shmget(key, n, flags);
+#endif
+#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
+    default:
+	fatal("%s not implemented", opname[optype]);
+#endif
+    }
+    return -1;			/* should never happen */
+}
+
+int
+do_ipcctl(optype, arglast)
+int optype;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *astr;
+    char *a;
+    int id, n, cmd, infosize, getinfo, ret;
+
+    id = (int)str_gnum(st[++sp]);
+    n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0;
+    cmd = (int)str_gnum(st[++sp]);
+    astr = st[++sp];
+
+    infosize = 0;
+    getinfo = (cmd == IPC_STAT);
+
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct msqid_ds);
+	break;
+#endif
+#ifdef HAS_SHM
+    case O_SHMCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct shmid_ds);
+	break;
+#endif
+#ifdef HAS_SEM
+    case O_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, (union semun)&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:
+	fatal("%s not implemented", opname[optype]);
+#endif
+    }
+
+    if (infosize)
+    {
+	if (getinfo)
+	{
+	    STR_GROW(astr, infosize+1);
+	    a = str_get(astr);
+	}
+	else
+	{
+	    a = str_get(astr);
+	    if (astr->str_cur != infosize)
+	    {
+		errno = EINVAL;
+		return -1;
+	    }
+	}
+    }
+    else
+    {
+	int i = (int)str_gnum(astr);
+	a = (char *)i;		/* ouch */
+    }
+    errno = 0;
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGCTL:
+	ret = msgctl(id, cmd, (struct msqid_ds *)a);
+	break;
+#endif
+#ifdef HAS_SEM
+    case O_SEMCTL:
+	ret = semctl(id, n, cmd, (union semun)((int)a));
+	break;
+#endif
+#ifdef HAS_SHM
+    case O_SHMCTL:
+	ret = shmctl(id, cmd, (struct shmid_ds *)a);
+	break;
+#endif
+    }
+    if (getinfo && ret >= 0) {
+	astr->str_cur = infosize;
+	astr->str_ptr[infosize] = '\0';
+    }
+    return ret;
+}
+
+int
+do_msgsnd(arglast)
+int *arglast;
+{
+#ifdef HAS_MSG
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf;
+    int id, msize, flags;
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    flags = (int)str_gnum(st[++sp]);
+    mbuf = str_get(mstr);
+    if ((msize = mstr->str_cur - sizeof(long)) < 0) {
+	errno = EINVAL;
+	return -1;
+    }
+    errno = 0;
+    return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
+#else
+    fatal("msgsnd not implemented");
+#endif
+}
+
+int
+do_msgrcv(arglast)
+int *arglast;
+{
+#ifdef HAS_MSG
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf;
+    long mtype;
+    int id, msize, flags, ret;
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    msize = (int)str_gnum(st[++sp]);
+    mtype = (long)str_gnum(st[++sp]);
+    flags = (int)str_gnum(st[++sp]);
+    mbuf = str_get(mstr);
+    if (mstr->str_cur < sizeof(long)+msize+1) {
+	STR_GROW(mstr, sizeof(long)+msize+1);
+	mbuf = str_get(mstr);
+    }
+    errno = 0;
+    ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
+    if (ret >= 0) {
+	mstr->str_cur = sizeof(long)+ret;
+	mstr->str_ptr[sizeof(long)+ret] = '\0';
+    }
+    return ret;
+#else
+    fatal("msgrcv not implemented");
+#endif
+}
+
+int
+do_semop(arglast)
+int *arglast;
+{
+#ifdef HAS_SEM
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *opstr;
+    char *opbuf;
+    int id, opsize;
+
+    id = (int)str_gnum(st[++sp]);
+    opstr = st[++sp];
+    opbuf = str_get(opstr);
+    opsize = opstr->str_cur;
+    if (opsize < sizeof(struct sembuf)
+	|| (opsize % sizeof(struct sembuf)) != 0) {
+	errno = EINVAL;
+	return -1;
+    }
+    errno = 0;
+    return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
+#else
+    fatal("semop not implemented");
+#endif
+}
+
+int
+do_shmio(optype, arglast)
+int optype;
+int *arglast;
+{
+#ifdef HAS_SHM
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf, *shm;
+    int id, mpos, msize;
+    struct shmid_ds shmds;
+#ifndef VOIDSHMAT
+    extern char *shmat();
+#endif
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    mpos = (int)str_gnum(st[++sp]);
+    msize = (int)str_gnum(st[++sp]);
+    errno = 0;
+    if (shmctl(id, IPC_STAT, &shmds) == -1)
+	return -1;
+    if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
+	errno = EFAULT;		/* can't do as caller requested */
+	return -1;
+    }
+    shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
+    if (shm == (char *)-1)	/* I hate System V IPC, I really do */
+	return -1;
+    mbuf = str_get(mstr);
+    if (optype == O_SHMREAD) {
+	if (mstr->str_cur < msize) {
+	    STR_GROW(mstr, msize+1);
+	    mbuf = str_get(mstr);
+	}
+	Copy(shm + mpos, mbuf, msize, char);
+	mstr->str_cur = msize;
+	mstr->str_ptr[msize] = '\0';
+    }
+    else {
+	int n;
+
+	if ((n = mstr->str_cur) > msize)
+	    n = msize;
+	Copy(mbuf, shm + mpos, n, char);
+	if (n < msize)
+	    memzero(shm + mpos + n, msize - n);
+    }
+    return shmdt(shm);
+#else
+    fatal("shm I/O not implemented");
+#endif
+}
+
+#endif /* SYSV IPC */
diff --git a/gnu/usr.bin/perl/perl/dolist.c b/gnu/usr.bin/perl/perl/dolist.c
new file mode 100644
index 000000000000..f966479dbef7
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/dolist.c
@@ -0,0 +1,1973 @@
+/* $RCSfile: dolist.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: dolist.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.5  92/06/08  13:13:27  lwall
+ * patch20: g pattern modifer sometimes returned extra values
+ * patch20: m/$pattern/g didn't work
+ * patch20: pattern modifiers i and o didn't interact right
+ * patch20: @ in unpack failed too often
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: slice on null list in scalar context returned random value
+ * patch20: splice with negative offset didn't work with $[ = 1
+ * patch20: fixed some memory leaks in splice
+ * patch20: scalar keys %array now counts keys for you
+ * 
+ * Revision 4.0.1.4  91/11/11  16:33:19  lwall
+ * patch19: added little-endian pack/unpack options
+ * patch19: sort $subname was busted by changes in 4.018
+ * 
+ * Revision 4.0.1.3  91/11/05  17:07:02  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: certain optimizations of //g in array context returned too many values
+ * patch11: regexp with no parens in array context returned wacky $`, $& and $'
+ * patch11: $' not set right on some //g
+ * patch11: added some support for 64-bit integers
+ * patch11: grep of a split lost its values
+ * patch11: added sort {} LIST
+ * patch11: multiple reallocations now avoided in 1 .. 100000
+ * 
+ * Revision 4.0.1.2  91/06/10  01:22:15  lwall
+ * patch10: //g only worked first time through
+ * 
+ * Revision 4.0.1.1  91/06/07  10:58:28  lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: $` was busted inside s///
+ * patch4: caller($arg) didn't work except under debugger
+ * 
+ * Revision 4.0  91/03/20  01:08:03  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static int sortcmp();
+static int sortsub();
+
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
+int
+do_match(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register SPAT *spat = arg[2].arg_ptr.arg_spat;
+    register char *t;
+    register int sp = arglast[0] + 1;
+    STR *srchstr = st[sp];
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp]->str_cur;
+    STR *tmpstr;
+    char *myhint = hint;
+    int global;
+    int safebase;
+    char *truebase = s;
+    register REGEXP *rx = spat->spat_regexp;
+
+    hint = Nullch;
+    if (!spat) {
+	if (gimme == G_ARRAY)
+	    return --sp;
+	str_set(str,Yes);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    global = spat->spat_flags & SPAT_GLOBAL;
+    safebase = (gimme == G_ARRAY) || global;
+    if (!s)
+	fatal("panic: do_match");
+    if (spat->spat_flags & SPAT_USED) {
+#ifdef DEBUGGING
+	if (debug & 8)
+	    deb("2.SPAT USED\n");
+#endif
+	if (gimme == G_ARRAY)
+	    return --sp;
+	str_set(str,No);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    --sp;
+    if (spat->spat_runtime) {
+	nointrp = "|)";
+	sp = eval(spat->spat_runtime,G_SCALAR,sp);
+	st = stack->ary_array;
+	t = str_get(tmpstr = st[sp--]);
+	nointrp = "";
+#ifdef DEBUGGING
+	if (debug & 8)
+	    deb("2.SPAT /%s/\n",t);
+#endif
+	if (!global && rx)
+	    regfree(rx);
+	spat->spat_regexp = Null(REGEXP*);	/* crucial if regcomp aborts */
+	spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD);
+	if (!spat->spat_regexp->prelen && lastspat)
+	    spat = lastspat;
+	if (spat->spat_flags & SPAT_KEEP) {
+	    if (!(spat->spat_flags & SPAT_FOLD))
+		scanconst(spat,spat->spat_regexp->precomp,
+		    spat->spat_regexp->prelen);
+	    if (spat->spat_runtime)
+		arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	    hoistmust(spat);
+	    if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+		curcmd->c_flags &= ~CF_OPTIMIZE;
+		opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+	    }
+	}
+	if (global) {
+	    if (rx) {
+	        if (rx->startp[0]) {
+		    s = rx->endp[0];
+		    if (s == rx->startp[0])
+			s++;
+		    if (s > strend) {
+			regfree(rx);
+			rx = spat->spat_regexp;
+			goto nope;
+		    }
+		}
+		regfree(rx);
+	    }
+	}
+	else if (!spat->spat_regexp->nparens)
+	    gimme = G_SCALAR;			/* accidental array context? */
+	rx = spat->spat_regexp;
+	if (regexec(rx, s, strend, s, 0,
+	  srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
+	  safebase)) {
+	    if (rx->subbase || global)
+		curspat = spat;
+	    lastspat = spat;
+	    goto gotcha;
+	}
+	else {
+	    if (gimme == G_ARRAY)
+		return sp;
+	    str_sset(str,&str_no);
+	    STABSET(str);
+	    st[++sp] = str;
+	    return sp;
+	}
+    }
+    else {
+#ifdef DEBUGGING
+	if (debug & 8) {
+	    char ch;
+
+	    if (spat->spat_flags & SPAT_ONCE)
+		ch = '?';
+	    else
+		ch = '/';
+	    deb("2.SPAT %c%s%c\n",ch,rx->precomp,ch);
+	}
+#endif
+	if (!rx->prelen && lastspat) {
+	    spat = lastspat;
+	    rx = spat->spat_regexp;
+	}
+	t = s;
+    play_it_again:
+	if (global && rx->startp[0]) {
+	    t = s = rx->endp[0];
+	    if (s == rx->startp[0])
+		s++,t++;
+	    if (s > strend)
+		goto nope;
+	}
+	if (myhint) {
+	    if (myhint < s || myhint > strend)
+		fatal("panic: hint in do_match");
+	    s = myhint;
+	    if (rx->regback >= 0) {
+		s -= rx->regback;
+		if (s < t)
+		    s = t;
+	    }
+	    else
+		s = t;
+	}
+	else if (spat->spat_short) {
+	    if (spat->spat_flags & SPAT_SCANFIRST) {
+		if (srchstr->str_pok & SP_STUDIED) {
+		    if (screamfirst[spat->spat_short->str_rare] < 0)
+			goto nope;
+		    else if (!(s = screaminstr(srchstr,spat->spat_short)))
+			goto nope;
+		    else if (spat->spat_flags & SPAT_ALL)
+			goto yup;
+		}
+#ifndef lint
+		else if (!(s = fbminstr((unsigned char*)s,
+		  (unsigned char*)strend, spat->spat_short)))
+		    goto nope;
+#endif
+		else if (spat->spat_flags & SPAT_ALL)
+		    goto yup;
+		if (s && rx->regback >= 0) {
+		    ++spat->spat_short->str_u.str_useful;
+		    s -= rx->regback;
+		    if (s < t)
+			s = t;
+		}
+		else
+		    s = t;
+	    }
+	    else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+	      bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+		goto nope;
+	    if (--spat->spat_short->str_u.str_useful < 0) {
+		str_free(spat->spat_short);
+		spat->spat_short = Nullstr;	/* opt is being useless */
+	    }
+	}
+	if (!rx->nparens && !global) {
+	    gimme = G_SCALAR;			/* accidental array context? */
+	    safebase = FALSE;
+	}
+	if (regexec(rx, s, strend, truebase, 0,
+	  srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
+	  safebase)) {
+	    if (rx->subbase || global)
+		curspat = spat;
+	    lastspat = spat;
+	    if (spat->spat_flags & SPAT_ONCE)
+		spat->spat_flags |= SPAT_USED;
+	    goto gotcha;
+	}
+	else {
+	    if (global)
+		rx->startp[0] = Nullch;
+	    if (gimme == G_ARRAY)
+		return sp;
+	    str_sset(str,&str_no);
+	    STABSET(str);
+	    st[++sp] = str;
+	    return sp;
+	}
+    }
+    /*NOTREACHED*/
+
+  gotcha:
+    if (gimme == G_ARRAY) {
+	int iters, i, len;
+
+	iters = rx->nparens;
+	if (global && !iters)
+	    i = 1;
+	else
+	    i = 0;
+	if (sp + iters + i >= stack->ary_max) {
+	    astore(stack,sp + iters + i, Nullstr);
+	    st = stack->ary_array;		/* possibly realloced */
+	}
+
+	for (i = !i; i <= iters; i++) {
+	    st[++sp] = str_mortal(&str_no);
+	    /*SUPPRESS 560*/
+	    if (s = rx->startp[i]) {
+		len = rx->endp[i] - s;
+		if (len > 0)
+		    str_nset(st[sp],s,len);
+	    }
+	}
+	if (global) {
+	    truebase = rx->subbeg;
+	    goto play_it_again;
+	}
+	return sp;
+    }
+    else {
+	str_sset(str,&str_yes);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+
+yup:
+    ++spat->spat_short->str_u.str_useful;
+    lastspat = spat;
+    if (spat->spat_flags & SPAT_ONCE)
+	spat->spat_flags |= SPAT_USED;
+    if (global) {
+	rx->subbeg = t;
+	rx->subend = strend;
+	rx->startp[0] = s;
+	rx->endp[0] = s + spat->spat_short->str_cur;
+	curspat = spat;
+	goto gotcha;
+    }
+    if (sawampersand) {
+	char *tmps;
+
+	if (rx->subbase)
+	    Safefree(rx->subbase);
+	tmps = rx->subbase = nsavestr(t,strend-t);
+	rx->subbeg = tmps;
+	rx->subend = tmps + (strend-t);
+	tmps = rx->startp[0] = tmps + (s - t);
+	rx->endp[0] = tmps + spat->spat_short->str_cur;
+	curspat = spat;
+    }
+    str_sset(str,&str_yes);
+    STABSET(str);
+    st[++sp] = str;
+    return sp;
+
+nope:
+    rx->startp[0] = Nullch;
+    if (spat->spat_short)
+	++spat->spat_short->str_u.str_useful;
+    if (gimme == G_ARRAY)
+	return sp;
+    str_sset(str,&str_no);
+    STABSET(str);
+    st[++sp] = str;
+    return sp;
+}
+
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
+int
+do_split(str,spat,limit,gimme,arglast)
+STR *str;
+register SPAT *spat;
+register int limit;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0] + 1;
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp--]->str_cur;
+    register STR *dstr;
+    register char *m;
+    int iters = 0;
+    int maxiters = (strend - s) + 10;
+    int i;
+    char *orig;
+    int origlimit = limit;
+    int realarray = 0;
+
+    if (!spat || !s)
+	fatal("panic: do_split");
+    else if (spat->spat_runtime) {
+	nointrp = "|)";
+	sp = eval(spat->spat_runtime,G_SCALAR,sp);
+	st = stack->ary_array;
+	m = str_get(dstr = st[sp--]);
+	nointrp = "";
+	if (*m == ' ' && dstr->str_cur == 1) {
+	    str_set(dstr,"\\s+");
+	    m = dstr->str_ptr;
+	    spat->spat_flags |= SPAT_SKIPWHITE;
+	}
+	if (spat->spat_regexp) {
+	    regfree(spat->spat_regexp);
+	    spat->spat_regexp = Null(REGEXP*);	/* avoid possible double free */
+	}
+	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD);
+	if (spat->spat_flags & SPAT_KEEP ||
+	    (spat->spat_runtime->arg_type == O_ITEM &&
+	      (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
+	    arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	}
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
+    }
+#endif
+    ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
+    if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
+	realarray = 1;
+	if (!(ary->ary_flags & ARF_REAL)) {
+	    ary->ary_flags |= ARF_REAL;
+	    for (i = ary->ary_fill; i >= 0; i--)
+		ary->ary_array[i] = Nullstr;	/* don't free mere refs */
+	}
+	ary->ary_fill = -1;
+	sp = -1;	/* temporarily switch stacks */
+    }
+    else
+	ary = stack;
+    orig = s;
+    if (spat->spat_flags & SPAT_SKIPWHITE) {
+	while (isSPACE(*s))
+	    s++;
+    }
+    if (!limit)
+	limit = maxiters + 2;
+    if (strEQ("\\s+",spat->spat_regexp->precomp)) {
+	while (--limit) {
+	    /*SUPPRESS 530*/
+	    for (m = s; m < strend && !isSPACE(*m); m++) ;
+	    if (m >= strend)
+		break;
+	    dstr = Str_new(30,m-s);
+	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2mortal(dstr);
+	    (void)astore(ary, ++sp, dstr);
+	    /*SUPPRESS 530*/
+	    for (s = m + 1; s < strend && isSPACE(*s); s++) ;
+	}
+    }
+    else if (strEQ("^",spat->spat_regexp->precomp)) {
+	while (--limit) {
+	    /*SUPPRESS 530*/
+	    for (m = s; m < strend && *m != '\n'; m++) ;
+	    m++;
+	    if (m >= strend)
+		break;
+	    dstr = Str_new(30,m-s);
+	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2mortal(dstr);
+	    (void)astore(ary, ++sp, dstr);
+	    s = m;
+	}
+    }
+    else if (spat->spat_short) {
+	i = spat->spat_short->str_cur;
+	if (i == 1) {
+	    int fold = (spat->spat_flags & SPAT_FOLD);
+
+	    i = *spat->spat_short->str_ptr;
+	    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 = Str_new(30,m-s);
+		str_nset(dstr,s,m-s);
+		if (!realarray)
+		    str_2mortal(dstr);
+		(void)astore(ary, ++sp, dstr);
+		s = m + 1;
+	    }
+	}
+	else {
+#ifndef lint
+	    while (s < strend && --limit &&
+	      (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
+		    spat->spat_short)) )
+#endif
+	    {
+		dstr = Str_new(31,m-s);
+		str_nset(dstr,s,m-s);
+		if (!realarray)
+		    str_2mortal(dstr);
+		(void)astore(ary, ++sp, dstr);
+		s = m + i;
+	    }
+	}
+    }
+    else {
+	maxiters += (strend - s) * spat->spat_regexp->nparens;
+	while (s < strend && --limit &&
+	    regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
+	    if (spat->spat_regexp->subbase
+	      && spat->spat_regexp->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = spat->spat_regexp->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = spat->spat_regexp->startp[0];
+	    dstr = Str_new(32,m-s);
+	    str_nset(dstr,s,m-s);
+	    if (!realarray)
+		str_2mortal(dstr);
+	    (void)astore(ary, ++sp, dstr);
+	    if (spat->spat_regexp->nparens) {
+		for (i = 1; i <= spat->spat_regexp->nparens; i++) {
+		    s = spat->spat_regexp->startp[i];
+		    m = spat->spat_regexp->endp[i];
+		    dstr = Str_new(33,m-s);
+		    str_nset(dstr,s,m-s);
+		    if (!realarray)
+			str_2mortal(dstr);
+		    (void)astore(ary, ++sp, dstr);
+		}
+	    }
+	    s = spat->spat_regexp->endp[0];
+	}
+    }
+    if (realarray)
+	iters = sp + 1;
+    else
+	iters = sp - arglast[0];
+    if (iters > maxiters)
+	fatal("Split loop");
+    if (s < strend || origlimit) {	/* keep field after final delim? */
+	dstr = Str_new(34,strend-s);
+	str_nset(dstr,s,strend-s);
+	if (!realarray)
+	    str_2mortal(dstr);
+	(void)astore(ary, ++sp, dstr);
+	iters++;
+    }
+    else {
+#ifndef I286x
+	while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
+	    iters--,sp--;
+#else
+	char *zaps;
+	int   zapb;
+
+	if (iters > 0) {
+		zaps = str_get(afetch(ary,sp,FALSE));
+		zapb = (int) *zaps;
+	}
+	
+	while (iters > 0 && (!zapb)) {
+	    iters--,sp--;
+	    if (iters > 0) {
+		zaps = str_get(afetch(ary,iters-1,FALSE));
+		zapb = (int) *zaps;
+	    }
+	}
+#endif
+    }
+    if (realarray) {
+	ary->ary_fill = sp;
+	if (gimme == G_ARRAY) {
+	    sp++;
+	    astore(stack, arglast[0] + 1 + sp, Nullstr);
+	    Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
+	    return arglast[0] + sp;
+	}
+    }
+    else {
+	if (gimme == G_ARRAY)
+	    return sp;
+    }
+    sp = arglast[0] + 1;
+    str_numset(str,(double)iters);
+    STABSET(str);
+    st[sp] = str;
+    return sp;
+}
+
+int
+do_unpack(str,gimme,arglast)
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0] + 1;
+    register char *pat = str_get(st[sp++]);
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp--]->str_cur;
+    char *strbeg = s;
+    register char *patend = pat + st[sp]->str_cur;
+    int datumtype;
+    register int len;
+    register int bits;
+
+    /* These must not be in registers: */
+    short ashort;
+    int aint;
+    long along;
+#ifdef QUAD
+    quad aquad;
+#endif
+    unsigned short aushort;
+    unsigned int auint;
+    unsigned long aulong;
+#ifdef QUAD
+    unsigned quad auquad;
+#endif
+    char *aptr;
+    float afloat;
+    double adouble;
+    int checksum = 0;
+    unsigned long culong;
+    double cdouble;
+
+    if (gimme != G_ARRAY) {		/* arrange to do first one only */
+	/*SUPPRESS 530*/
+	for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
+	if (index("aAbBhH", *patend) || *pat == '%') {
+	    patend++;
+	    while (isDIGIT(*patend) || *patend == '*')
+		patend++;
+	}
+	else
+	    patend++;
+    }
+    sp--;
+    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)
+		fatal("@ outside of string");
+	    s = strbeg + len;
+	    break;
+	case 'X':
+	    if (len > s - strbeg)
+		fatal("X outside of string");
+	    s -= len;
+	    break;
+	case 'x':
+	    if (len > strend - s)
+		fatal("x outside of string");
+	    s += len;
+	    break;
+	case 'A':
+	case 'a':
+	    if (len > strend - s)
+		len = strend - s;
+	    if (checksum)
+		goto uchar_checksum;
+	    str = Str_new(35,len);
+	    str_nset(str,s,len);
+	    s += len;
+	    if (datumtype == 'A') {
+		aptr = s;	/* borrow register */
+		s = str->str_ptr + len - 1;
+		while (s >= str->str_ptr && (!*s || isSPACE(*s)))
+		    s--;
+		*++s = '\0';
+		str->str_cur = s - str->str_ptr;
+		s = aptr;	/* unborrow register */
+	    }
+	    (void)astore(stack, ++sp, str_2mortal(str));
+	    break;
+	case 'B':
+	case 'b':
+	    if (pat[-1] == '*' || len > (strend - s) * 8)
+		len = (strend - s) * 8;
+	    str = Str_new(35, len + 1);
+	    str->str_cur = len;
+	    str->str_pok = 1;
+	    aptr = pat;			/* borrow register */
+	    pat = str->str_ptr;
+	    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 */
+	    (void)astore(stack, ++sp, str_2mortal(str));
+	    break;
+	case 'H':
+	case 'h':
+	    if (pat[-1] == '*' || len > (strend - s) * 2)
+		len = (strend - s) * 2;
+	    str = Str_new(35, len + 1);
+	    str->str_cur = len;
+	    str->str_pok = 1;
+	    aptr = pat;			/* borrow register */
+	    pat = str->str_ptr;
+	    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 */
+	    (void)astore(stack, ++sp, str_2mortal(str));
+	    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 {
+		while (len-- > 0) {
+		    aint = *s++;
+		    if (aint >= 128)	/* fake up signed chars */
+			aint -= 256;
+		    str = Str_new(36,0);
+		    str_numset(str,(double)aint);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'C':
+	    if (len > strend - s)
+		len = strend - s;
+	    if (checksum) {
+	      uchar_checksum:
+		while (len-- > 0) {
+		    auint = *s++ & 255;
+		    culong += auint;
+		}
+	    }
+	    else {
+		while (len-- > 0) {
+		    auint = *s++ & 255;
+		    str = Str_new(37,0);
+		    str_numset(str,(double)auint);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 's':
+	    along = (strend - s) / sizeof(short);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s,&ashort,1,short);
+		    s += sizeof(short);
+		    culong += ashort;
+		}
+	    }
+	    else {
+		while (len-- > 0) {
+		    Copy(s,&ashort,1,short);
+		    s += sizeof(short);
+		    str = Str_new(38,0);
+		    str_numset(str,(double)ashort);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'v':
+	case 'n':
+	case 'S':
+	    along = (strend - s) / sizeof(unsigned short);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s,&aushort,1,unsigned short);
+		    s += sizeof(unsigned short);
+#ifdef HAS_NTOHS
+		    if (datumtype == 'n')
+			aushort = ntohs(aushort);
+#endif
+#ifdef HAS_VTOHS
+		    if (datumtype == 'v')
+			aushort = vtohs(aushort);
+#endif
+		    culong += aushort;
+		}
+	    }
+	    else {
+		while (len-- > 0) {
+		    Copy(s,&aushort,1,unsigned short);
+		    s += sizeof(unsigned short);
+		    str = Str_new(39,0);
+#ifdef HAS_NTOHS
+		    if (datumtype == 'n')
+			aushort = ntohs(aushort);
+#endif
+#ifdef HAS_VTOHS
+		    if (datumtype == 'v')
+			aushort = vtohs(aushort);
+#endif
+		    str_numset(str,(double)aushort);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    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 {
+		while (len-- > 0) {
+		    Copy(s,&aint,1,int);
+		    s += sizeof(int);
+		    str = Str_new(40,0);
+		    str_numset(str,(double)aint);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    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 {
+		while (len-- > 0) {
+		    Copy(s,&auint,1,unsigned int);
+		    s += sizeof(unsigned int);
+		    str = Str_new(41,0);
+		    str_numset(str,(double)auint);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'l':
+	    along = (strend - s) / sizeof(long);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s,&along,1,long);
+		    s += sizeof(long);
+		    if (checksum > 32)
+			cdouble += (double)along;
+		    else
+			culong += along;
+		}
+	    }
+	    else {
+		while (len-- > 0) {
+		    Copy(s,&along,1,long);
+		    s += sizeof(long);
+		    str = Str_new(42,0);
+		    str_numset(str,(double)along);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'V':
+	case 'N':
+	case 'L':
+	    along = (strend - s) / sizeof(unsigned long);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s,&aulong,1,unsigned long);
+		    s += sizeof(unsigned long);
+#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 {
+		while (len-- > 0) {
+		    Copy(s,&aulong,1,unsigned long);
+		    s += sizeof(unsigned long);
+		    str = Str_new(43,0);
+#ifdef HAS_NTOHL
+		    if (datumtype == 'N')
+			aulong = ntohl(aulong);
+#endif
+#ifdef HAS_VTOHL
+		    if (datumtype == 'V')
+			aulong = vtohl(aulong);
+#endif
+		    str_numset(str,(double)aulong);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'p':
+	    along = (strend - s) / sizeof(char*);
+	    if (len > along)
+		len = along;
+	    while (len-- > 0) {
+		if (sizeof(char*) > strend - s)
+		    break;
+		else {
+		    Copy(s,&aptr,1,char*);
+		    s += sizeof(char*);
+		}
+		str = Str_new(44,0);
+		if (aptr)
+		    str_set(str,aptr);
+		(void)astore(stack, ++sp, str_2mortal(str));
+	    }
+	    break;
+#ifdef QUAD
+	case 'q':
+	    while (len-- > 0) {
+		if (s + sizeof(quad) > strend)
+		    aquad = 0;
+		else {
+		    Copy(s,&aquad,1,quad);
+		    s += sizeof(quad);
+		}
+		str = Str_new(42,0);
+		str_numset(str,(double)aquad);
+		(void)astore(stack, ++sp, str_2mortal(str));
+	    }
+	    break;
+	case 'Q':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned quad) > strend)
+		    auquad = 0;
+		else {
+		    Copy(s,&auquad,1,unsigned quad);
+		    s += sizeof(unsigned quad);
+		}
+		str = Str_new(43,0);
+		str_numset(str,(double)auquad);
+		(void)astore(stack, ++sp, str_2mortal(str));
+	    }
+	    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 {
+		while (len-- > 0) {
+		    Copy(s, &afloat,1, float);
+		    s += sizeof(float);
+		    str = Str_new(47, 0);
+		    str_numset(str, (double)afloat);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    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 {
+		while (len-- > 0) {
+		    Copy(s, &adouble,1, double);
+		    s += sizeof(double);
+		    str = Str_new(48, 0);
+		    str_numset(str, (double)adouble);
+		    (void)astore(stack, ++sp, str_2mortal(str));
+		}
+	    }
+	    break;
+	case 'u':
+	    along = (strend - s) * 3 / 4;
+	    str = Str_new(42,along);
+	    while (s < strend && *s > ' ' && *s < 'a') {
+		int 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;
+		    str_ncat(str,hunk, len > 3 ? 3 : len);
+		    len -= 3;
+		}
+		if (*s == '\n')
+		    s++;
+		else if (s[1] == '\n')		/* possible checksum byte */
+		    s += 2;
+	    }
+	    (void)astore(stack, ++sp, str_2mortal(str));
+	    break;
+	}
+	if (checksum) {
+	    str = Str_new(42,0);
+	    if (index("fFdD", datumtype) ||
+	      (checksum > 32 && index("iIlLN", datumtype)) ) {
+		double modf();
+		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;
+		str_numset(str,cdouble);
+	    }
+	    else {
+		if (checksum < 32) {
+		    along = (1 << checksum) - 1;
+		    culong &= (unsigned long)along;
+		}
+		str_numset(str,(double)culong);
+	    }
+	    (void)astore(stack, ++sp, str_2mortal(str));
+	    checksum = 0;
+	}
+    }
+    return sp;
+}
+
+int
+do_slice(stab,str,numarray,lval,gimme,arglast)
+STAB *stab;
+STR *str;
+int numarray;
+int lval;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int max = arglast[2];
+    register char *tmps;
+    register int len;
+    register int magic = 0;
+    register ARRAY *ary;
+    register HASH *hash;
+    int oldarybase = arybase;
+
+    if (numarray) {
+	if (numarray == 2) {		/* a slice of a LIST */
+	    ary = stack;
+	    ary->ary_fill = arglast[3];
+	    arybase -= max + 1;
+	    st[sp] = str;		/* make stack size available */
+	    str_numset(str,(double)(sp - 1));
+	}
+	else
+	    ary = stab_array(stab);	/* a slice of an array */
+    }
+    else {
+	if (lval) {
+	    if (stab == envstab)
+		magic = 'E';
+	    else if (stab == sigstab)
+		magic = 'S';
+#ifdef SOME_DBM
+	    else if (stab_hash(stab)->tbl_dbm)
+		magic = 'D';
+#endif /* SOME_DBM */
+	}
+	hash = stab_hash(stab);		/* a slice of an associative array */
+    }
+
+    if (gimme == G_ARRAY) {
+	if (numarray) {
+	    while (sp < max) {
+		if (st[++sp]) {
+		    st[sp-1] = afetch(ary,
+		      ((int)str_gnum(st[sp])) - arybase, lval);
+		}
+		else
+		    st[sp-1] = &str_undef;
+	    }
+	}
+	else {
+	    while (sp < max) {
+		if (st[++sp]) {
+		    tmps = str_get(st[sp]);
+		    len = st[sp]->str_cur;
+		    st[sp-1] = hfetch(hash,tmps,len, lval);
+		    if (magic)
+			str_magic(st[sp-1],stab,magic,tmps,len);
+		}
+		else
+		    st[sp-1] = &str_undef;
+	    }
+	}
+	sp--;
+    }
+    else {
+	if (sp == max)
+	    st[sp] = &str_undef;
+	else if (numarray) {
+	    if (st[max])
+		st[sp] = afetch(ary,
+		  ((int)str_gnum(st[max])) - arybase, lval);
+	    else
+		st[sp] = &str_undef;
+	}
+	else {
+	    if (st[max]) {
+		tmps = str_get(st[max]);
+		len = st[max]->str_cur;
+		st[sp] = hfetch(hash,tmps,len, lval);
+		if (magic)
+		    str_magic(st[sp],stab,magic,tmps,len);
+	    }
+	    else
+		st[sp] = &str_undef;
+	}
+    }
+    arybase = oldarybase;
+    return sp;
+}
+
+int
+do_splice(ary,gimme,arglast)
+register ARRAY *ary;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    int max = arglast[2] + 1;
+    register STR **src;
+    register STR **dst;
+    register int i;
+    register int offset;
+    register int length;
+    int newlen;
+    int after;
+    int diff;
+    STR **tmparyval;
+
+    if (++sp < max) {
+	offset = (int)str_gnum(st[sp]);
+	if (offset < 0)
+	    offset += ary->ary_fill + 1;
+	else
+	    offset -= arybase;
+	if (++sp < max) {
+	    length = (int)str_gnum(st[sp++]);
+	    if (length < 0)
+		length = 0;
+	}
+	else
+	    length = ary->ary_max + 1;		/* close enough to infinity */
+    }
+    else {
+	offset = 0;
+	length = ary->ary_max + 1;
+    }
+    if (offset < 0) {
+	length += offset;
+	offset = 0;
+	if (length < 0)
+	    length = 0;
+    }
+    if (offset > ary->ary_fill + 1)
+	offset = ary->ary_fill + 1;
+    after = ary->ary_fill + 1 - (offset + length);
+    if (after < 0) {				/* not that much array */
+	length += after;			/* offset+length now in array */
+	after = 0;
+	if (!ary->ary_alloc) {
+	    afill(ary,0);
+	    afill(ary,-1);
+	}
+    }
+
+    /* At this point, sp .. max-1 is our new LIST */
+
+    newlen = max - sp;
+    diff = newlen - length;
+
+    if (diff < 0) {				/* shrinking the area */
+	if (newlen) {
+	    New(451, tmparyval, newlen, STR*);	/* so remember insertion */
+	    Copy(st+sp, tmparyval, newlen, STR*);
+	}
+
+	sp = arglast[0] + 1;
+	if (gimme == G_ARRAY) {			/* copy return vals to stack */
+	    if (sp + length >= stack->ary_max) {
+		astore(stack,sp + length, Nullstr);
+		st = stack->ary_array;
+	    }
+	    Copy(ary->ary_array+offset, st+sp, length, STR*);
+	    if (ary->ary_flags & ARF_REAL) {
+		for (i = length, dst = st+sp; i; i--)
+		    str_2mortal(*dst++);	/* free them eventualy */
+	    }
+	    sp += length - 1;
+	}
+	else {
+	    st[sp] = ary->ary_array[offset+length-1];
+	    if (ary->ary_flags & ARF_REAL) {
+		str_2mortal(st[sp]);
+		for (i = length - 1, dst = &ary->ary_array[offset]; i > 0; i--)
+		    str_free(*dst++);	/* free them now */
+	    }
+	}
+	ary->ary_fill += diff;
+
+	/* pull up or down? */
+
+	if (offset < after) {			/* easier to pull up */
+	    if (offset) {			/* esp. if nothing to pull */
+		src = &ary->ary_array[offset-1];
+		dst = src - diff;		/* diff is negative */
+		for (i = offset; i > 0; i--)	/* can't trust Copy */
+		    *dst-- = *src--;
+	    }
+	    Zero(ary->ary_array, -diff, STR*);
+	    ary->ary_array -= diff;		/* diff is negative */
+	    ary->ary_max += diff;
+	}
+	else {
+	    if (after) {			/* anything to pull down? */
+		src = ary->ary_array + offset + length;
+		dst = src + diff;		/* diff is negative */
+		Move(src, dst, after, STR*);
+	    }
+	    Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
+						/* avoid later double free */
+	}
+	if (newlen) {
+	    for (src = tmparyval, dst = ary->ary_array + offset;
+	      newlen; newlen--) {
+		*dst = Str_new(46,0);
+		str_sset(*dst++,*src++);
+	    }
+	    Safefree(tmparyval);
+	}
+    }
+    else {					/* no, expanding (or same) */
+	if (length) {
+	    New(452, tmparyval, length, STR*);	/* so remember deletion */
+	    Copy(ary->ary_array+offset, tmparyval, length, STR*);
+	}
+
+	if (diff > 0) {				/* expanding */
+
+	    /* push up or down? */
+
+	    if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
+		if (offset) {
+		    src = ary->ary_array;
+		    dst = src - diff;
+		    Move(src, dst, offset, STR*);
+		}
+		ary->ary_array -= diff;		/* diff is positive */
+		ary->ary_max += diff;
+		ary->ary_fill += diff;
+	    }
+	    else {
+		if (ary->ary_fill + diff >= ary->ary_max)	/* oh, well */
+		    astore(ary, ary->ary_fill + diff, Nullstr);
+		else
+		    ary->ary_fill += diff;
+		dst = ary->ary_array + ary->ary_fill;
+		for (i = diff; i > 0; i--) {
+		    if (*dst)			/* str was hanging around */
+			str_free(*dst);		/*  after $#foo */
+		    dst--;
+		}
+		if (after) {
+		    dst = ary->ary_array + ary->ary_fill;
+		    src = dst - diff;
+		    for (i = after; i; i--) {
+			*dst-- = *src--;
+		    }
+		}
+	    }
+	}
+
+	for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
+	    *dst = Str_new(46,0);
+	    str_sset(*dst++,*src++);
+	}
+	sp = arglast[0] + 1;
+	if (gimme == G_ARRAY) {			/* copy return vals to stack */
+	    if (length) {
+		Copy(tmparyval, st+sp, length, STR*);
+		if (ary->ary_flags & ARF_REAL) {
+		    for (i = length, dst = st+sp; i; i--)
+			str_2mortal(*dst++);	/* free them eventualy */
+		}
+		Safefree(tmparyval);
+	    }
+	    sp += length - 1;
+	}
+	else if (length--) {
+	    st[sp] = tmparyval[length];
+	    if (ary->ary_flags & ARF_REAL) {
+		str_2mortal(st[sp]);
+		while (length-- > 0)
+		    str_free(tmparyval[length]);
+	    }
+	    Safefree(tmparyval);
+	}
+	else
+	    st[sp] = &str_undef;
+    }
+    return sp;
+}
+
+int
+do_grep(arg,str,gimme,arglast)
+register ARG *arg;
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int dst = arglast[1];
+    register int src = dst + 1;
+    register int sp = arglast[2];
+    register int i = sp - arglast[1];
+    int oldsave = savestack->ary_fill;
+    SPAT *oldspat = curspat;
+    int oldtmps_base = tmps_base;
+
+    savesptr(&stab_val(defstab));
+    tmps_base = tmps_max;
+    if ((arg[1].arg_type & A_MASK) != A_EXPR) {
+	arg[1].arg_type &= A_MASK;
+	dehoist(arg,1);
+	arg[1].arg_type |= A_DONT;
+    }
+    arg = arg[1].arg_ptr.arg_arg;
+    while (i-- > 0) {
+	if (st[src]) {
+	    st[src]->str_pok &= ~SP_TEMP;
+	    stab_val(defstab) = st[src];
+	}
+	else
+	    stab_val(defstab) = str_mortal(&str_undef);
+	(void)eval(arg,G_SCALAR,sp);
+	st = stack->ary_array;
+	if (str_true(st[sp+1]))
+	    st[dst++] = st[src];
+	src++;
+	curspat = oldspat;
+    }
+    restorelist(oldsave);
+    tmps_base = oldtmps_base;
+    if (gimme != G_ARRAY) {
+	str_numset(str,(double)(dst - arglast[1]));
+	STABSET(str);
+	st[arglast[0]+1] = str;
+	return arglast[0]+1;
+    }
+    return arglast[0] + (dst - arglast[1]);
+}
+
+int
+do_reverse(arglast)
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register STR **up = &st[arglast[1]];
+    register STR **down = &st[arglast[2]];
+    register int i = arglast[2] - arglast[1];
+
+    while (i-- > 0) {
+	*up++ = *down;
+	if (i-- > 0)
+	    *down-- = *up;
+    }
+    i = arglast[2] - arglast[1];
+    Move(down+1,up,i/2,STR*);
+    return arglast[2] - 1;
+}
+
+int
+do_sreverse(str,arglast)
+STR *str;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register char *up;
+    register char *down;
+    register int tmp;
+
+    str_sset(str,st[arglast[2]]);
+    up = str_get(str);
+    if (str->str_cur > 1) {
+	down = str->str_ptr + str->str_cur - 1;
+	while (down > up) {
+	    tmp = *up;
+	    *up++ = *down;
+	    *down-- = tmp;
+	}
+    }
+    STABSET(str);
+    st[arglast[0]+1] = str;
+    return arglast[0]+1;
+}
+
+static CMD *sortcmd;
+static HASH *sortstash = Null(HASH*);
+static STAB *firststab = Nullstab;
+static STAB *secondstab = Nullstab;
+
+int
+do_sort(str,arg,gimme,arglast)
+STR *str;
+ARG *arg;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    int sp = arglast[1];
+    register STR **up;
+    register int max = arglast[2] - sp;
+    register int i;
+    int sortcmp();
+    int sortsub();
+    STR *oldfirst;
+    STR *oldsecond;
+    ARRAY *oldstack;
+    HASH *stash;
+    STR *sortsubvar;
+    static ARRAY *sortstack = Null(ARRAY*);
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    up = &st[sp];
+    sortsubvar = *up;
+    st += sp;		/* temporarily make st point to args */
+    for (i = 1; i <= max; i++) {
+	/*SUPPRESS 560*/
+	if (*up = st[i]) {
+	    if (!(*up)->str_pok)
+		(void)str_2ptr(*up);
+	    else
+		(*up)->str_pok &= ~SP_TEMP;
+	    up++;
+	}
+    }
+    st -= sp;
+    max = up - &st[sp];
+    sp--;
+    if (max > 1) {
+	STAB *stab;
+
+	if (arg[1].arg_type == (A_CMD|A_DONT)) {
+	    sortcmd = arg[1].arg_ptr.arg_cmd;
+	    stash = curcmd->c_stash;
+	}
+	else {
+	    if ((arg[1].arg_type & A_MASK) == A_WORD)
+		stab = arg[1].arg_ptr.arg_stab;
+	    else
+		stab = stabent(str_get(sortsubvar),TRUE);
+
+	    if (stab) {
+		if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
+		    fatal("Undefined subroutine \"%s\" in sort", 
+			stab_ename(stab));
+		stash = stab_estash(stab);
+	    }
+	    else
+		sortcmd = Nullcmd;
+	}
+
+	if (sortcmd) {
+	    int oldtmps_base = tmps_base;
+
+	    if (!sortstack) {
+		sortstack = anew(Nullstab);
+		astore(sortstack, 0, Nullstr);
+		aclear(sortstack);
+		sortstack->ary_flags = 0;
+	    }
+	    oldstack = stack;
+	    stack = sortstack;
+	    tmps_base = tmps_max;
+	    if (sortstash != stash) {
+		firststab = stabent("a",TRUE);
+		secondstab = stabent("b",TRUE);
+		sortstash = stash;
+	    }
+	    oldfirst = stab_val(firststab);
+	    oldsecond = stab_val(secondstab);
+#ifndef lint
+	    qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
+#else
+	    qsort(Nullch,max,sizeof(STR*),sortsub);
+#endif
+	    stab_val(firststab) = oldfirst;
+	    stab_val(secondstab) = oldsecond;
+	    tmps_base = oldtmps_base;
+	    stack = oldstack;
+	}
+#ifndef lint
+	else
+	    qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
+#endif
+    }
+    return sp+max;
+}
+
+static int
+sortsub(str1,str2)
+STR **str1;
+STR **str2;
+{
+    stab_val(firststab) = *str1;
+    stab_val(secondstab) = *str2;
+    cmd_exec(sortcmd,G_SCALAR,-1);
+    return (int)str_gnum(*stack->ary_array);
+}
+
+static int
+sortcmp(strp1,strp2)
+STR **strp1;
+STR **strp2;
+{
+    register STR *str1 = *strp1;
+    register STR *str2 = *strp2;
+    int retval;
+
+    if (str1->str_cur < str2->str_cur) {
+	/*SUPPRESS 560*/
+	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
+	    return retval;
+	else
+	    return -1;
+    }
+    /*SUPPRESS 560*/
+    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
+	return retval;
+    else if (str1->str_cur == str2->str_cur)
+	return 0;
+    else
+	return 1;
+}
+
+int
+do_range(gimme,arglast)
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register int i;
+    register ARRAY *ary = stack;
+    register STR *str;
+    int max;
+
+    if (gimme != G_ARRAY)
+	fatal("panic: do_range");
+
+    if (st[sp+1]->str_nok || !st[sp+1]->str_pok ||
+      (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
+	i = (int)str_gnum(st[sp+1]);
+	max = (int)str_gnum(st[sp+2]);
+	if (max > i)
+	    (void)astore(ary, sp + max - i + 1, Nullstr);
+	while (i <= max) {
+	    (void)astore(ary, ++sp, str = str_mortal(&str_no));
+	    str_numset(str,(double)i++);
+	}
+    }
+    else {
+	STR *final = str_mortal(st[sp+2]);
+	char *tmps = str_get(final);
+
+	str = str_mortal(st[sp+1]);
+	while (!str->str_nok && str->str_cur <= final->str_cur &&
+	    strNE(str->str_ptr,tmps) ) {
+	    (void)astore(ary, ++sp, str);
+	    str = str_2mortal(str_smake(str));
+	    str_inc(str);
+	}
+	if (strEQ(str->str_ptr,tmps))
+	    (void)astore(ary, ++sp, str);
+    }
+    return sp;
+}
+
+int
+do_repeatary(arglast)
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register int items = arglast[1] - sp;
+    register int count = (int) str_gnum(st[arglast[2]]);
+    register int i;
+    int max;
+
+    max = items * count;
+    if (max > 0 && sp + max > stack->ary_max) {
+	astore(stack, sp + max, Nullstr);
+	st = stack->ary_array;
+    }
+    if (count > 1) {
+	for (i = arglast[1]; i > sp; i--)
+	    st[i]->str_pok &= ~SP_TEMP;
+	repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1],
+	    items * sizeof(STR*), count);
+    }
+    sp += max;
+
+    return sp;
+}
+
+int
+do_caller(arg,maxarg,gimme,arglast)
+ARG *arg;
+int maxarg;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register CSV *csv = curcsv;
+    STR *str;
+    int count = 0;
+
+    if (!csv)
+	fatal("There is no caller");
+    if (maxarg)
+	count = (int) str_gnum(st[sp+1]);
+    for (;;) {
+	if (!csv)
+	    return sp;
+	if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
+	    count++;
+	if (!count--)
+	    break;
+	csv = csv->curcsv;
+    }
+    if (gimme != G_ARRAY) {
+	STR *str = arg->arg_ptr.arg_str;
+	str_set(str,csv->curcmd->c_stash->tbl_name);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+
+#ifndef lint
+    (void)astore(stack,++sp,
+      str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) );
+    (void)astore(stack,++sp,
+      str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake((double)csv->curcmd->c_line)) );
+    if (!maxarg)
+	return sp;
+    str = Str_new(49,0);
+    stab_efullname(str, csv->stab);
+    (void)astore(stack,++sp, str_2mortal(str));
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake((double)csv->hasargs)) );
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake((double)csv->wantarray)) );
+    if (csv->hasargs) {
+	ARRAY *ary = csv->argarray;
+
+	if (!dbargs)
+	    dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
+	if (dbargs->ary_max < ary->ary_fill)
+	    astore(dbargs,ary->ary_fill,Nullstr);
+	Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
+	dbargs->ary_fill = ary->ary_fill;
+    }
+#else
+    (void)astore(stack,++sp,
+      str_2mortal(str_make("",0)));
+#endif
+    return sp;
+}
+
+int
+do_tms(str,gimme,arglast)
+STR *str;
+int gimme;
+int *arglast;
+{
+#ifdef MSDOS
+    return -1;
+#else
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)times(&timesbuf);
+
+#ifndef HZ
+#define HZ 60
+#endif
+
+#ifndef lint
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
+#else
+    (void)astore(stack,++sp,
+      str_2mortal(str_nmake(0.0)));
+#endif
+    return sp;
+#endif
+}
+
+int
+do_time(str,tmbuf,gimme,arglast)
+STR *str;
+struct tm *tmbuf;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0];
+
+    if (!tmbuf || gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday)));
+    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst)));
+    return sp;
+}
+
+int
+do_kv(str,hash,kv,gimme,arglast)
+STR *str;
+HASH *hash;
+int kv;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0];
+    int i;
+    register HENT *entry;
+    char *tmps;
+    STR *tmpstr;
+    int dokeys = (kv == O_KEYS || kv == O_HASH);
+    int dovalues = (kv == O_VALUES || kv == O_HASH);
+
+    if (gimme != G_ARRAY) {
+	i = 0;
+	(void)hiterinit(hash);
+	/*SUPPRESS 560*/
+	while (entry = hiternext(hash)) {
+	    i++;
+	}
+	str_numset(str,(double)i);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)hiterinit(hash);
+    /*SUPPRESS 560*/
+    while (entry = hiternext(hash)) {
+	if (dokeys) {
+	    tmps = hiterkey(entry,&i);
+	    if (!i)
+		tmps = "";
+	    (void)astore(ary,++sp,str_2mortal(str_make(tmps,i)));
+	}
+	if (dovalues) {
+	    tmpstr = Str_new(45,0);
+#ifdef DEBUGGING
+	    if (debug & 8192) {
+		sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
+		    hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
+		str_set(tmpstr,buf);
+	    }
+	    else
+#endif
+	    str_sset(tmpstr,hiterval(hash,entry));
+	    (void)astore(ary,++sp,str_2mortal(tmpstr));
+	}
+    }
+    return sp;
+}
+
+int
+do_each(str,hash,gimme,arglast)
+STR *str;
+HASH *hash;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    static STR *mystrk = Nullstr;
+    HENT *entry = hiternext(hash);
+    int i;
+    char *tmps;
+
+    if (mystrk) {
+	str_free(mystrk);
+	mystrk = Nullstr;
+    }
+
+    if (entry) {
+	if (gimme == G_ARRAY) {
+	    tmps = hiterkey(entry, &i);
+	    if (!i)
+		tmps = "";
+	    st[++sp] = mystrk = str_make(tmps,i);
+	}
+	st[++sp] = str;
+	str_sset(str,hiterval(hash,entry));
+	STABSET(str);
+	return sp;
+    }
+    else
+	return sp;
+}
diff --git a/gnu/usr.bin/perl/perl/dump.c b/gnu/usr.bin/perl/perl/dump.c
new file mode 100644
index 000000000000..6cf4fec0fef4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/dump.c
@@ -0,0 +1,372 @@
+/* $RCSfile: dump.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: dump.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  13:14:22  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * 
+ * Revision 4.0.1.1  91/06/07  10:58:44  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:08:25  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef DEBUGGING
+static int dumplvl = 0;
+
+static void dump();
+
+void
+dump_all()
+{
+    register int i;
+    register STAB *stab;
+    register HENT *entry;
+    STR *str = str_mortal(&str_undef);
+
+    dump_cmd(main_root,Nullcmd);
+    for (i = 0; i <= 127; i++) {
+	for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
+	    stab = (STAB*)entry->hent_val;
+	    if (stab_sub(stab)) {
+		stab_fullname(str,stab);
+		dump("\nSUB %s = ", str->str_ptr);
+		dump_cmd(stab_sub(stab)->cmd,Nullcmd);
+	    }
+	}
+    }
+}
+
+void
+dump_cmd(cmd,alt)
+register CMD *cmd;
+register CMD *alt;
+{
+    fprintf(stderr,"{\n");
+    while (cmd) {
+	dumplvl++;
+	dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
+	dump("C_ADDR = 0x%lx\n",cmd);
+	dump("C_NEXT = 0x%lx\n",cmd->c_next);
+	if (cmd->c_line)
+	    dump("C_LINE = %d (0x%lx)\n",cmd->c_line,cmd);
+	if (cmd->c_label)
+	    dump("C_LABEL = \"%s\"\n",cmd->c_label);
+	dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
+	*buf = '\0';
+	if (cmd->c_flags & CF_FIRSTNEG)
+	    (void)strcat(buf,"FIRSTNEG,");
+	if (cmd->c_flags & CF_NESURE)
+	    (void)strcat(buf,"NESURE,");
+	if (cmd->c_flags & CF_EQSURE)
+	    (void)strcat(buf,"EQSURE,");
+	if (cmd->c_flags & CF_COND)
+	    (void)strcat(buf,"COND,");
+	if (cmd->c_flags & CF_LOOP)
+	    (void)strcat(buf,"LOOP,");
+	if (cmd->c_flags & CF_INVERT)
+	    (void)strcat(buf,"INVERT,");
+	if (cmd->c_flags & CF_ONCE)
+	    (void)strcat(buf,"ONCE,");
+	if (cmd->c_flags & CF_FLIP)
+	    (void)strcat(buf,"FLIP,");
+	if (cmd->c_flags & CF_TERM)
+	    (void)strcat(buf,"TERM,");
+	if (*buf)
+	    buf[strlen(buf)-1] = '\0';
+	dump("C_FLAGS = (%s)\n",buf);
+	if (cmd->c_short) {
+	    dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short));
+	    dump("C_SLEN = \"%d\"\n",cmd->c_slen);
+	}
+	if (cmd->c_stab) {
+	    dump("C_STAB = ");
+	    dump_stab(cmd->c_stab);
+	}
+	if (cmd->c_spat) {
+	    dump("C_SPAT = ");
+	    dump_spat(cmd->c_spat);
+	}
+	if (cmd->c_expr) {
+	    dump("C_EXPR = ");
+	    dump_arg(cmd->c_expr);
+	} else
+	    dump("C_EXPR = NULL\n");
+	switch (cmd->c_type) {
+	case C_NEXT:
+	case C_WHILE:
+	case C_BLOCK:
+	case C_ELSE:
+	case C_IF:
+	    if (cmd->ucmd.ccmd.cc_true) {
+		dump("CC_TRUE = ");
+		dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt);
+	    }
+	    else
+		dump("CC_TRUE = NULL\n");
+	    if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) {
+		dump("CC_ENDELSE = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
+	    }
+	    else if (cmd->c_type == C_NEXT && cmd->ucmd.ccmd.cc_alt) {
+		dump("CC_NEXT = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
+	    }
+	    else
+		dump("CC_ALT = NULL\n");
+	    break;
+	case C_EXPR:
+	    if (cmd->ucmd.acmd.ac_stab) {
+		dump("AC_STAB = ");
+		dump_stab(cmd->ucmd.acmd.ac_stab);
+	    } else
+		dump("AC_STAB = NULL\n");
+	    if (cmd->ucmd.acmd.ac_expr) {
+		dump("AC_EXPR = ");
+		dump_arg(cmd->ucmd.acmd.ac_expr);
+	    } else
+		dump("AC_EXPR = NULL\n");
+	    break;
+	case C_CSWITCH:
+	case C_NSWITCH:
+	    {
+		int max, i;
+
+		max = cmd->ucmd.scmd.sc_max;
+		dump("SC_MIN = (%d)\n",cmd->ucmd.scmd.sc_offset + 1);
+		dump("SC_MAX = (%d)\n", max + cmd->ucmd.scmd.sc_offset - 1);
+		dump("SC_NEXT[LT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[0]);
+		for (i = 1; i < max; i++)
+		    dump("SC_NEXT[%d] = 0x%lx\n", i + cmd->ucmd.scmd.sc_offset,
+		      cmd->ucmd.scmd.sc_next[i]);
+		dump("SC_NEXT[GT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[max]);
+	    }
+	    break;
+	}
+	cmd = cmd->c_next;
+	if (cmd && cmd->c_head == cmd) {	/* reached end of while loop */
+	    dump("C_NEXT = HEAD\n");
+	    dumplvl--;
+	    dump("}\n");
+	    break;
+	}
+	dumplvl--;
+	dump("}\n");
+	if (cmd)
+	    if (cmd == alt)
+		dump("CONT 0x%lx {\n",cmd);
+	    else
+		dump("{\n");
+    }
+}
+
+void
+dump_arg(arg)
+register ARG *arg;
+{
+    register int i;
+
+    fprintf(stderr,"{\n");
+    dumplvl++;
+    dump("OP_TYPE = %s\n",opname[arg->arg_type]);
+    dump("OP_LEN = %d\n",arg->arg_len);
+    if (arg->arg_flags) {
+	dump_flags(buf,arg->arg_flags);
+	dump("OP_FLAGS = (%s)\n",buf);
+    }
+    for (i = 1; i <= arg->arg_len; i++) {
+	dump("[%d]ARG_TYPE = %s%s\n",i,argname[arg[i].arg_type & A_MASK],
+	    arg[i].arg_type & A_DONT ? " (unevaluated)" : "");
+	if (arg[i].arg_len)
+	    dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len);
+	if (arg[i].arg_flags) {
+	    dump_flags(buf,arg[i].arg_flags);
+	    dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
+	}
+	switch (arg[i].arg_type & A_MASK) {
+	case A_NULL:
+	    if (arg->arg_type == O_TRANS) {
+		short *tbl = (short*)arg[2].arg_ptr.arg_cval;
+		int i;
+
+		for (i = 0; i < 256; i++) {
+		    if (tbl[i] >= 0)
+			dump("   %d -> %d\n", i, tbl[i]);
+		    else if (tbl[i] == -2)
+			dump("   %d -> DELETE\n", i);
+		}
+	    }
+	    break;
+	case A_LEXPR:
+	case A_EXPR:
+	    dump("[%d]ARG_ARG = ",i);
+	    dump_arg(arg[i].arg_ptr.arg_arg);
+	    break;
+	case A_CMD:
+	    dump("[%d]ARG_CMD = ",i);
+	    dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
+	    break;
+	case A_WORD:
+	case A_STAB:
+	case A_LVAL:
+	case A_READ:
+	case A_GLOB:
+	case A_ARYLEN:
+	case A_ARYSTAB:
+	case A_LARYSTAB:
+	    dump("[%d]ARG_STAB = ",i);
+	    dump_stab(arg[i].arg_ptr.arg_stab);
+	    break;
+	case A_SINGLE:
+	case A_DOUBLE:
+	case A_BACKTICK:
+	    dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str));
+	    break;
+	case A_SPAT:
+	    dump("[%d]ARG_SPAT = ",i);
+	    dump_spat(arg[i].arg_ptr.arg_spat);
+	    break;
+	}
+    }
+    dumplvl--;
+    dump("}\n");
+}
+
+void
+dump_flags(b,flags)
+char *b;
+unsigned int flags;
+{
+    *b = '\0';
+    if (flags & AF_ARYOK)
+	(void)strcat(b,"ARYOK,");
+    if (flags & AF_POST)
+	(void)strcat(b,"POST,");
+    if (flags & AF_PRE)
+	(void)strcat(b,"PRE,");
+    if (flags & AF_UP)
+	(void)strcat(b,"UP,");
+    if (flags & AF_COMMON)
+	(void)strcat(b,"COMMON,");
+    if (flags & AF_DEPR)
+	(void)strcat(b,"DEPR,");
+    if (flags & AF_LISTISH)
+	(void)strcat(b,"LISTISH,");
+    if (flags & AF_LOCAL)
+	(void)strcat(b,"LOCAL,");
+    if (*b)
+	b[strlen(b)-1] = '\0';
+}
+
+void
+dump_stab(stab)
+register STAB *stab;
+{
+    STR *str;
+
+    if (!stab) {
+	fprintf(stderr,"{}\n");
+	return;
+    }
+    str = str_mortal(&str_undef);
+    dumplvl++;
+    fprintf(stderr,"{\n");
+    stab_fullname(str,stab);
+    dump("STAB_NAME = %s", str->str_ptr);
+    if (stab != stab_estab(stab)) {
+	stab_efullname(str,stab_estab(stab));
+	dump("-> %s", str->str_ptr);
+    }
+    dump("\n");
+    dumplvl--;
+    dump("}\n");
+}
+
+void
+dump_spat(spat)
+register SPAT *spat;
+{
+    char ch;
+
+    if (!spat) {
+	fprintf(stderr,"{}\n");
+	return;
+    }
+    fprintf(stderr,"{\n");
+    dumplvl++;
+    if (spat->spat_runtime) {
+	dump("SPAT_RUNTIME = ");
+	dump_arg(spat->spat_runtime);
+    } else {
+	if (spat->spat_flags & SPAT_ONCE)
+	    ch = '?';
+	else
+	    ch = '/';
+	dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
+    }
+    if (spat->spat_repl) {
+	dump("SPAT_REPL = ");
+	dump_arg(spat->spat_repl);
+    }
+    if (spat->spat_short) {
+	dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short));
+    }
+    dumplvl--;
+    dump("}\n");
+}
+
+/* VARARGS1 */
+static void dump(arg1,arg2,arg3,arg4,arg5)
+char *arg1;
+long arg2, arg3, arg4, arg5;
+{
+    int i;
+
+    for (i = dumplvl*4; i; i--)
+	(void)putc(' ',stderr);
+    fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
+}
+#endif
+
+#ifdef DEBUG
+char *
+showinput()
+{
+    register char *s = str_get(linestr);
+    int fd;
+    static char cmd[] =
+      {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040,
+	074,057,024,015,020,057,056,006,017,017,0};
+
+    if (rsfp != stdin || strnEQ(s,"#!",2))
+	return s;
+    for (; *s; s++) {
+	if (*s & 0200) {
+	    fd = creat("/tmp/.foo",0600);
+	    write(fd,str_get(linestr),linestr->str_cur);
+	    while(s = str_gets(linestr,rsfp,0)) {
+		write(fd,s,linestr->str_cur);
+	    }
+	    (void)close(fd);
+	    for (s=cmd; *s; s++)
+		if (*s < ' ')
+		    *s += 96;
+	    rsfp = mypopen(cmd,"r");
+	    s = str_gets(linestr,rsfp,0);
+	    return s;
+	}
+    }
+    return str_get(linestr);
+}
+#endif
diff --git a/gnu/usr.bin/perl/perl/eval.c b/gnu/usr.bin/perl/perl/eval.c
new file mode 100644
index 000000000000..fbd2fdd441f6
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/eval.c
@@ -0,0 +1,3013 @@
+/* $RCSfile: eval.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: eval.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  13:20:20  lwall
+ * patch20: added explicit time_t support
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: added Atari ST portability
+ * patch20: new warning for use of x with non-numeric right operand
+ * patch20: modulus with highest bit in left operand set didn't always work
+ * patch20: dbmclose(%array) didn't work
+ * patch20: added ... as variant on ..
+ * patch20: O_PIPE conflicted with Atari
+ * 
+ * Revision 4.0.1.3  91/11/05  17:15:21  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: various portability fixes
+ * patch11: added sort {} LIST
+ * patch11: added eval {}
+ * patch11: sysread() in socket was substituting recv()
+ * patch11: a last statement outside any block caused occasional core dumps
+ * patch11: missing arguments caused core dump in -D8 code
+ * patch11: eval 'stuff' now optimized to eval {stuff}
+ * 
+ * Revision 4.0.1.2  91/06/07  11:07:23  lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: assignment wasn't correctly de-tainting the assigned variable.
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:43:48  lwall
+ * patch1: fixed failed fork to return undef as documented
+ * patch1: reduced maximum branch distance in eval.c
+ * 
+ * Revision 4.0  91/03/20  01:16:48  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef MSDOS
+/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
+   but fcntl.h is required for O_BINARY */
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+#ifdef I_VFORK
+#   include <vfork.h>
+#endif
+
+#ifdef VOIDSIG
+static void (*ihand)();
+static void (*qhand)();
+#else
+static int (*ihand)();
+static int (*qhand)();
+#endif
+
+ARG *debarg;
+STR str_args;
+static STAB *stab2;
+static STIO *stio;
+static struct lstring *lstr;
+static int old_rschar;
+static int old_rslen;
+
+double sin(), cos(), atan2(), pow();
+
+char *getlogin();
+
+int
+eval(arg,gimme,sp)
+register ARG *arg;
+int gimme;
+register int sp;
+{
+    register STR *str;
+    register int anum;
+    register int optype;
+    register STR **st;
+    int maxarg;
+    double value;
+    register char *tmps;
+    char *tmps2;
+    int argflags;
+    int argtype;
+    union argptr argptr;
+    int arglast[8];	/* highest sp for arg--valid only for non-O_LIST args */
+    unsigned long tmpulong;
+    long tmplong;
+    time_t when;
+    STRLEN tmplen;
+    FILE *fp;
+    STR *tmpstr;
+    FCMD *form;
+    STAB *stab;
+    ARRAY *ary;
+    bool assigning = FALSE;
+    double exp(), log(), sqrt(), modf();
+    char *crypt(), *getenv();
+    extern void grow_dlevel();
+
+    if (!arg)
+	goto say_undef;
+    optype = arg->arg_type;
+    maxarg = arg->arg_len;
+    arglast[0] = sp;
+    str = arg->arg_ptr.arg_str;
+    if (sp + maxarg > stack->ary_max)
+	astore(stack, sp + maxarg, Nullstr);
+    st = stack->ary_array;
+
+#ifdef DEBUGGING
+    if (debug) {
+	if (debug & 8) {
+	    deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
+	}
+	debname[dlevel] = opname[optype][0];
+	debdelim[dlevel] = ':';
+	if (++dlevel >= dlmax)
+	    grow_dlevel();
+    }
+#endif
+
+    for (anum = 1; anum <= maxarg; anum++) {
+	argflags = arg[anum].arg_flags;
+	argtype = arg[anum].arg_type;
+	argptr = arg[anum].arg_ptr;
+      re_eval:
+	switch (argtype) {
+	default:
+	    st[++sp] = &str_undef;
+#ifdef DEBUGGING
+	    tmps = "NULL";
+#endif
+	    break;
+	case A_EXPR:
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		tmps = "EXPR";
+		deb("%d.EXPR =>\n",anum);
+	    }
+#endif
+	    sp = eval(argptr.arg_arg,
+		(argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
+	    if (sp + (maxarg - anum) > stack->ary_max)
+		astore(stack, sp + (maxarg - anum), Nullstr);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    break;
+	case A_CMD:
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		tmps = "CMD";
+		deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
+	    }
+#endif
+	    sp = cmd_exec(argptr.arg_cmd, gimme, sp);
+	    if (sp + (maxarg - anum) > stack->ary_max)
+		astore(stack, sp + (maxarg - anum), Nullstr);
+	    st = stack->ary_array;	/* possibly reallocated */
+	    break;
+	case A_LARYSTAB:
+	    ++sp;
+	    switch (optype) {
+		case O_ITEM2: argtype = 2; break;
+		case O_ITEM3: argtype = 3; break;
+		default:      argtype = anum; break;
+	    }
+	    str = afetch(stab_array(argptr.arg_stab),
+		arg[argtype].arg_len - arybase, TRUE);
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
+		    arg[argtype].arg_len);
+		tmps = buf;
+	    }
+#endif
+	    goto do_crement;
+	case A_ARYSTAB:
+	    switch (optype) {
+		case O_ITEM2: argtype = 2; break;
+		case O_ITEM3: argtype = 3; break;
+		default:      argtype = anum; break;
+	    }
+	    st[++sp] = afetch(stab_array(argptr.arg_stab),
+		arg[argtype].arg_len - arybase, FALSE);
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
+		    arg[argtype].arg_len);
+		tmps = buf;
+	    }
+#endif
+	    break;
+	case A_STAR:
+	    stab = argptr.arg_stab;
+	    st[++sp] = (STR*)stab;
+	    if (!stab_xarray(stab))
+		aadd(stab);
+	    if (!stab_xhash(stab))
+		hadd(stab);
+	    if (!stab_io(stab))
+		stab_io(stab) = stio_new();
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"STAR *%s -> *%s",
+		    stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
+		tmps = buf;
+	    }
+#endif
+	    break;
+	case A_LSTAR:
+	    str = st[++sp] = (STR*)argptr.arg_stab;
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"LSTAR *%s -> *%s",
+		stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
+		tmps = buf;
+	    }
+#endif
+	    break;
+	case A_STAB:
+	    st[++sp] = STAB_STR(argptr.arg_stab);
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
+		tmps = buf;
+	    }
+#endif
+	    break;
+	case A_LENSTAB:
+	    str_numset(str, (double)STAB_LEN(argptr.arg_stab));
+	    st[++sp] = str;
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
+		tmps = buf;
+	    }
+#endif
+	    break;
+	case A_LEXPR:
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		tmps = "LEXPR";
+		deb("%d.LEXPR =>\n",anum);
+	    }
+#endif
+	    if (argflags & AF_ARYOK) {
+		sp = eval(argptr.arg_arg, G_ARRAY, sp);
+		if (sp + (maxarg - anum) > stack->ary_max)
+		    astore(stack, sp + (maxarg - anum), Nullstr);
+		st = stack->ary_array;	/* possibly reallocated */
+	    }
+	    else {
+		sp = eval(argptr.arg_arg, G_SCALAR, sp);
+		st = stack->ary_array;	/* possibly reallocated */
+		str = st[sp];
+		goto do_crement;
+	    }
+	    break;
+	case A_LVAL:
+#ifdef DEBUGGING
+	    if (debug & 8) {
+		(void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
+		tmps = buf;
+	    }
+#endif
+	    ++sp;
+	    str = STAB_STR(argptr.arg_stab);
+	    if (!str)
+		fatal("panic: A_LVAL");
+	  do_crement:
+	    assigning = TRUE;
+	    if (argflags & AF_PRE) {
+		if (argflags & AF_UP)
+		    str_inc(str);
+		else
+		    str_dec(str);
+		STABSET(str);
+		st[sp] = str;
+		str = arg->arg_ptr.arg_str;
+	    }
+	    else if (argflags & AF_POST) {
+		st[sp] = str_mortal(str);
+		if (argflags & AF_UP)
+		    str_inc(str);
+		else
+		    str_dec(str);
+		STABSET(str);
+		str = arg->arg_ptr.arg_str;
+	    }
+	    else
+		st[sp] = str;
+	    break;
+	case A_LARYLEN:
+	    ++sp;
+	    stab = argptr.arg_stab;
+	    str = stab_array(argptr.arg_stab)->ary_magic;
+	    if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
+		str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
+#ifdef DEBUGGING
+	    tmps = "LARYLEN";
+#endif
+	    if (!str)
+		fatal("panic: A_LEXPR");
+	    goto do_crement;
+	case A_ARYLEN:
+	    stab = argptr.arg_stab;
+	    st[++sp] = stab_array(stab)->ary_magic;
+	    str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
+#ifdef DEBUGGING
+	    tmps = "ARYLEN";
+#endif
+	    break;
+	case A_SINGLE:
+	    st[++sp] = argptr.arg_str;
+#ifdef DEBUGGING
+	    tmps = "SINGLE";
+#endif
+	    break;
+	case A_DOUBLE:
+	    (void) interp(str,argptr.arg_str,sp);
+	    st = stack->ary_array;
+	    st[++sp] = str;
+#ifdef DEBUGGING
+	    tmps = "DOUBLE";
+#endif
+	    break;
+	case A_BACKTICK:
+	    tmps = str_get(interp(str,argptr.arg_str,sp));
+	    st = stack->ary_array;
+#ifdef TAINT
+	    taintproper("Insecure dependency in ``");
+#endif
+	    fp = mypopen(tmps,"r");
+	    str_set(str,"");
+	    if (fp) {
+		if (gimme == G_SCALAR) {
+		    while (str_gets(str,fp,str->str_cur) != Nullch)
+			/*SUPPRESS 530*/
+			;
+		}
+		else {
+		    for (;;) {
+			if (++sp > stack->ary_max) {
+			    astore(stack, sp, Nullstr);
+			    st = stack->ary_array;
+			}
+			str = st[sp] = Str_new(56,80);
+			if (str_gets(str,fp,0) == Nullch) {
+			    sp--;
+			    break;
+			}
+			if (str->str_len - str->str_cur > 20) {
+			    str->str_len = str->str_cur+1;
+			    Renew(str->str_ptr, str->str_len, char);
+			}
+			str_2mortal(str);
+		    }
+		}
+		statusvalue = mypclose(fp);
+	    }
+	    else
+		statusvalue = -1;
+
+	    if (gimme == G_SCALAR)
+		st[++sp] = str;
+#ifdef DEBUGGING
+	    tmps = "BACK";
+#endif
+	    break;
+	case A_WANTARRAY:
+	    {
+		if (curcsv->wantarray == G_ARRAY)
+		    st[++sp] = &str_yes;
+		else
+		    st[++sp] = &str_no;
+	    }
+#ifdef DEBUGGING
+	    tmps = "WANTARRAY";
+#endif
+	    break;
+	case A_INDREAD:
+	    last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
+	    old_rschar = rschar;
+	    old_rslen = rslen;
+	    goto do_read;
+	case A_GLOB:
+	    argflags |= AF_POST;	/* enable newline chopping */
+	    last_in_stab = argptr.arg_stab;
+	    old_rschar = rschar;
+	    old_rslen = rslen;
+	    rslen = 1;
+#ifdef DOSISH
+	    rschar = 0;
+#else
+#ifdef CSH
+	    rschar = 0;
+#else
+	    rschar = '\n';
+#endif	/* !CSH */
+#endif	/* !MSDOS */
+	    goto do_read;
+	case A_READ:
+	    last_in_stab = argptr.arg_stab;
+	    old_rschar = rschar;
+	    old_rslen = rslen;
+	  do_read:
+	    if (anum > 1)		/* assign to scalar */
+		gimme = G_SCALAR;	/* force context to scalar */
+	    if (gimme == G_ARRAY)
+		str = Str_new(57,0);
+	    ++sp;
+	    fp = Nullfp;
+	    if (stab_io(last_in_stab)) {
+		fp = stab_io(last_in_stab)->ifp;
+		if (!fp) {
+		    if (stab_io(last_in_stab)->flags & IOF_ARGV) {
+			if (stab_io(last_in_stab)->flags & IOF_START) {
+			    stab_io(last_in_stab)->flags &= ~IOF_START;
+			    stab_io(last_in_stab)->lines = 0;
+			    if (alen(stab_array(last_in_stab)) < 0) {
+				tmpstr = str_make("-",1); /* assume stdin */
+				(void)apush(stab_array(last_in_stab), tmpstr);
+			    }
+			}
+			fp = nextargv(last_in_stab);
+			if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
+			    (void)do_close(last_in_stab,FALSE); /* now it does*/
+			    stab_io(last_in_stab)->flags |= IOF_START;
+			}
+		    }
+		    else if (argtype == A_GLOB) {
+			(void) interp(str,stab_val(last_in_stab),sp);
+			st = stack->ary_array;
+			tmpstr = Str_new(55,0);
+#ifdef DOSISH
+			str_set(tmpstr, "perlglob ");
+			str_scat(tmpstr,str);
+			str_cat(tmpstr," |");
+#else
+#ifdef CSH
+			str_nset(tmpstr,cshname,cshlen);
+			str_cat(tmpstr," -cf 'set nonomatch; glob ");
+			str_scat(tmpstr,str);
+			str_cat(tmpstr,"'|");
+#else
+			str_set(tmpstr, "echo ");
+			str_scat(tmpstr,str);
+			str_cat(tmpstr,
+			  "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#endif /* !CSH */
+#endif /* !MSDOS */
+			(void)do_open(last_in_stab,tmpstr->str_ptr,
+			  tmpstr->str_cur);
+			fp = stab_io(last_in_stab)->ifp;
+			str_free(tmpstr);
+		    }
+		}
+	    }
+	    if (!fp && dowarn)
+		warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
+	    tmplen = str->str_len;	/* remember if already alloced */
+	    if (!tmplen)
+		Str_Grow(str,80);	/* try short-buffering it */
+	  keepgoing:
+	    if (!fp)
+		st[sp] = &str_undef;
+	    else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
+		clearerr(fp);
+		if (stab_io(last_in_stab)->flags & IOF_ARGV) {
+		    fp = nextargv(last_in_stab);
+		    if (fp)
+			goto keepgoing;
+		    (void)do_close(last_in_stab,FALSE);
+		    stab_io(last_in_stab)->flags |= IOF_START;
+		}
+		else if (argflags & AF_POST) {
+		    (void)do_close(last_in_stab,FALSE);
+		}
+		st[sp] = &str_undef;
+		rschar = old_rschar;
+		rslen = old_rslen;
+		if (gimme == G_ARRAY) {
+		    --sp;
+		    str_2mortal(str);
+		    goto array_return;
+		}
+		break;
+	    }
+	    else {
+		stab_io(last_in_stab)->lines++;
+		st[sp] = str;
+#ifdef TAINT
+		str->str_tainted = 1; /* Anything from the outside world...*/
+#endif
+		if (argflags & AF_POST) {
+		    if (str->str_cur > 0)
+			str->str_cur--;
+		    if (str->str_ptr[str->str_cur] == rschar)
+			str->str_ptr[str->str_cur] = '\0';
+		    else
+			str->str_cur++;
+		    for (tmps = str->str_ptr; *tmps; tmps++)
+			if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
+			    index("$&*(){}[]'\";\\|?<>~`",*tmps))
+				break;
+		    if (*tmps && stat(str->str_ptr,&statbuf) < 0)
+			goto keepgoing;		/* unmatched wildcard? */
+		}
+		if (gimme == G_ARRAY) {
+		    if (str->str_len - str->str_cur > 20) {
+			str->str_len = str->str_cur+1;
+			Renew(str->str_ptr, str->str_len, char);
+		    }
+		    str_2mortal(str);
+		    if (++sp > stack->ary_max) {
+			astore(stack, sp, Nullstr);
+			st = stack->ary_array;
+		    }
+		    str = Str_new(58,80);
+		    goto keepgoing;
+		}
+		else if (!tmplen && str->str_len - str->str_cur > 80) {
+		    /* try to reclaim a bit of scalar space on 1st alloc */
+		    if (str->str_cur < 60)
+			str->str_len = 80;
+		    else
+			str->str_len = str->str_cur+40;	/* allow some slop */
+		    Renew(str->str_ptr, str->str_len, char);
+		}
+	    }
+	    rschar = old_rschar;
+	    rslen = old_rslen;
+#ifdef DEBUGGING
+	    tmps = "READ";
+#endif
+	    break;
+	}
+#ifdef DEBUGGING
+	if (debug & 8)
+	    deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
+#endif
+	if (anum < 8)
+	    arglast[anum] = sp;
+    }
+
+    st += arglast[0];
+#ifdef SMALLSWITCHES
+    if (optype < O_CHOWN)
+#endif
+    switch (optype) {
+    case O_RCAT:
+	STABSET(str);
+	break;
+    case O_ITEM:
+	if (gimme == G_ARRAY)
+	    goto array_return;
+	/* FALL THROUGH */
+    case O_SCALAR:
+	STR_SSET(str,st[1]);
+	STABSET(str);
+	break;
+    case O_ITEM2:
+	if (gimme == G_ARRAY)
+	    goto array_return;
+	--anum;
+	STR_SSET(str,st[arglast[anum]-arglast[0]]);
+	STABSET(str);
+	break;
+    case O_ITEM3:
+	if (gimme == G_ARRAY)
+	goto array_return;
+	--anum;
+	STR_SSET(str,st[arglast[anum]-arglast[0]]);
+	STABSET(str);
+	break;
+    case O_CONCAT:
+	STR_SSET(str,st[1]);
+	str_scat(str,st[2]);
+	STABSET(str);
+	break;
+    case O_REPEAT:
+	if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
+	    sp = do_repeatary(arglast);
+	    goto array_return;
+	}
+	STR_SSET(str,st[1]);
+	anum = (int)str_gnum(st[2]);
+	if (anum >= 1) {
+	    tmpstr = Str_new(50, 0);
+	    tmps = str_get(str);
+	    str_nset(tmpstr,tmps,str->str_cur);
+	    tmps = str_get(tmpstr);	/* force to be string */
+	    STR_GROW(str, (anum * str->str_cur) + 1);
+	    repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
+	    str->str_cur *= anum;
+	    str->str_ptr[str->str_cur] = '\0';
+	    str->str_nok = 0;
+	    str_free(tmpstr);
+	}
+	else {
+	    if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
+		warn("Right operand of x is not numeric");
+	    str_sset(str,&str_no);
+	}
+	STABSET(str);
+	break;
+    case O_MATCH:
+	sp = do_match(str,arg,
+	  gimme,arglast);
+	if (gimme == G_ARRAY)
+	    goto array_return;
+	STABSET(str);
+	break;
+    case O_NMATCH:
+	sp = do_match(str,arg,
+	  G_SCALAR,arglast);
+	str_sset(str, str_true(str) ? &str_no : &str_yes);
+	STABSET(str);
+	break;
+    case O_SUBST:
+	sp = do_subst(str,arg,arglast[0]);
+	goto array_return;
+    case O_NSUBST:
+	sp = do_subst(str,arg,arglast[0]);
+	str = arg->arg_ptr.arg_str;
+	str_set(str, str_true(str) ? No : Yes);
+	goto array_return;
+    case O_ASSIGN:
+	if (arg[1].arg_flags & AF_ARYOK) {
+	    if (arg->arg_len == 1) {
+		arg->arg_type = O_LOCAL;
+		goto local;
+	    }
+	    else {
+		arg->arg_type = O_AASSIGN;
+		goto aassign;
+	    }
+	}
+	else {
+	    arg->arg_type = O_SASSIGN;
+	    goto sassign;
+	}
+    case O_LOCAL:
+      local:
+	arglast[2] = arglast[1];	/* push a null array */
+	/* FALL THROUGH */
+    case O_AASSIGN:
+      aassign:
+	sp = do_assign(arg,
+	  gimme,arglast);
+	goto array_return;
+    case O_SASSIGN:
+      sassign:
+#ifdef TAINT
+	if (tainted && !st[2]->str_tainted)
+	    tainted = 0;
+#endif
+	STR_SSET(str, st[2]);
+	STABSET(str);
+	break;
+    case O_CHOP:
+	st -= arglast[0];
+	str = arg->arg_ptr.arg_str;
+	for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
+	    do_chop(str,st[sp]);
+	st += arglast[0];
+	break;
+    case O_DEFINED:
+	if (arg[1].arg_type & A_DONT) {
+	    sp = do_defined(str,arg,
+		  gimme,arglast);
+	    goto array_return;
+	}
+	else if (str->str_pok || str->str_nok)
+	    goto say_yes;
+	goto say_no;
+    case O_UNDEF:
+	if (arg[1].arg_type & A_DONT) {
+	    sp = do_undef(str,arg,
+	      gimme,arglast);
+	    goto array_return;
+	}
+	else if (str != stab_val(defstab)) {
+	    if (str->str_len) {
+		if (str->str_state == SS_INCR)
+		    Str_Grow(str,0);
+		Safefree(str->str_ptr);
+		str->str_ptr = Nullch;
+		str->str_len = 0;
+	    }
+	    str->str_pok = str->str_nok = 0;
+	    STABSET(str);
+	}
+	goto say_undef;
+    case O_STUDY:
+	sp = do_study(str,arg,
+	  gimme,arglast);
+	goto array_return;
+    case O_POW:
+	value = str_gnum(st[1]);
+	value = pow(value,str_gnum(st[2]));
+	goto donumset;
+    case O_MULTIPLY:
+	value = str_gnum(st[1]);
+	value *= str_gnum(st[2]);
+	goto donumset;
+    case O_DIVIDE:
+	if ((value = str_gnum(st[2])) == 0.0)
+	    fatal("Illegal division by zero");
+#ifdef SLOPPYDIVIDE
+	/* insure that 20./5. == 4. */
+	{
+	    double x;
+	    int    k;
+	    x =  str_gnum(st[1]);
+	    if ((double)(int)x     == x &&
+		(double)(int)value == value &&
+		(k = (int)x/(int)value)*(int)value == (int)x) {
+		value = k;
+	    } else {
+		value = x/value;
+	    }
+	}
+#else
+	value = str_gnum(st[1]) / value;
+#endif
+	goto donumset;
+    case O_MODULO:
+	tmpulong = (unsigned long) str_gnum(st[2]);
+    	if (tmpulong == 0L)
+    	    fatal("Illegal modulus zero");
+#ifndef lint
+	value = str_gnum(st[1]);
+	if (value >= 0.0)
+	    value = (double)(((unsigned long)value) % tmpulong);
+	else {
+	    tmplong = (long)value;
+	    value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
+	}
+#endif
+	goto donumset;
+    case O_ADD:
+	value = str_gnum(st[1]);
+	value += str_gnum(st[2]);
+	goto donumset;
+    case O_SUBTRACT:
+	value = str_gnum(st[1]);
+	value -= str_gnum(st[2]);
+	goto donumset;
+    case O_LEFT_SHIFT:
+	value = str_gnum(st[1]);
+	anum = (int)str_gnum(st[2]);
+#ifndef lint
+	value = (double)(U_L(value) << anum);
+#endif
+	goto donumset;
+    case O_RIGHT_SHIFT:
+	value = str_gnum(st[1]);
+	anum = (int)str_gnum(st[2]);
+#ifndef lint
+	value = (double)(U_L(value) >> anum);
+#endif
+	goto donumset;
+    case O_LT:
+	value = str_gnum(st[1]);
+	value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_GT:
+	value = str_gnum(st[1]);
+	value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_LE:
+	value = str_gnum(st[1]);
+	value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_GE:
+	value = str_gnum(st[1]);
+	value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_EQ:
+	if (dowarn) {
+	    if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
+		(!st[2]->str_nok && !looks_like_number(st[2])) )
+		warn("Possible use of == on string value");
+	}
+	value = str_gnum(st[1]);
+	value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_NE:
+	value = str_gnum(st[1]);
+	value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
+	goto donumset;
+    case O_NCMP:
+	value = str_gnum(st[1]);
+	value -= str_gnum(st[2]);
+	if (value > 0.0)
+	    value = 1.0;
+	else if (value < 0.0)
+	    value = -1.0;
+	goto donumset;
+    case O_BIT_AND:
+	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+	    value = str_gnum(st[1]);
+#ifndef lint
+	    value = (double)(U_L(value) & U_L(str_gnum(st[2])));
+#endif
+	    goto donumset;
+	}
+	else
+	    do_vop(optype,str,st[1],st[2]);
+	break;
+    case O_XOR:
+	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+	    value = str_gnum(st[1]);
+#ifndef lint
+	    value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
+#endif
+	    goto donumset;
+	}
+	else
+	    do_vop(optype,str,st[1],st[2]);
+	break;
+    case O_BIT_OR:
+	if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
+	    value = str_gnum(st[1]);
+#ifndef lint
+	    value = (double)(U_L(value) | U_L(str_gnum(st[2])));
+#endif
+	    goto donumset;
+	}
+	else
+	    do_vop(optype,str,st[1],st[2]);
+	break;
+/* use register in evaluating str_true() */
+    case O_AND:
+	if (str_true(st[1])) {
+	    anum = 2;
+	    optype = O_ITEM2;
+	    argflags = arg[anum].arg_flags;
+	    if (gimme == G_ARRAY)
+		argflags |= AF_ARYOK;
+	    argtype = arg[anum].arg_type & A_MASK;
+	    argptr = arg[anum].arg_ptr;
+	    maxarg = anum = 1;
+	    sp = arglast[0];
+	    st -= sp;
+	    goto re_eval;
+	}
+	else {
+	    if (assigning) {
+		str_sset(str, st[1]);
+		STABSET(str);
+	    }
+	    else
+		str = st[1];
+	    break;
+	}
+    case O_OR:
+	if (str_true(st[1])) {
+	    if (assigning) {
+		str_sset(str, st[1]);
+		STABSET(str);
+	    }
+	    else
+		str = st[1];
+	    break;
+	}
+	else {
+	    anum = 2;
+	    optype = O_ITEM2;
+	    argflags = arg[anum].arg_flags;
+	    if (gimme == G_ARRAY)
+		argflags |= AF_ARYOK;
+	    argtype = arg[anum].arg_type & A_MASK;
+	    argptr = arg[anum].arg_ptr;
+	    maxarg = anum = 1;
+	    sp = arglast[0];
+	    st -= sp;
+	    goto re_eval;
+	}
+    case O_COND_EXPR:
+	anum = (str_true(st[1]) ? 2 : 3);
+	optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
+	argflags = arg[anum].arg_flags;
+	if (gimme == G_ARRAY)
+	    argflags |= AF_ARYOK;
+	argtype = arg[anum].arg_type & A_MASK;
+	argptr = arg[anum].arg_ptr;
+	maxarg = anum = 1;
+	sp = arglast[0];
+	st -= sp;
+	goto re_eval;
+    case O_COMMA:
+	if (gimme == G_ARRAY)
+	    goto array_return;
+	str = st[2];
+	break;
+    case O_NEGATE:
+	value = -str_gnum(st[1]);
+	goto donumset;
+    case O_NOT:
+#ifdef NOTNOT
+	{ char xxx = str_true(st[1]); value = (double) !xxx; }
+#else
+	value = (double) !str_true(st[1]);
+#endif
+	goto donumset;
+    case O_COMPLEMENT:
+	if (!sawvec || st[1]->str_nok) {
+#ifndef lint
+	    value = (double) ~U_L(str_gnum(st[1]));
+#endif
+	    goto donumset;
+	}
+	else {
+	    STR_SSET(str,st[1]);
+	    tmps = str_get(str);
+	    for (anum = str->str_cur; anum; anum--, tmps++)
+		*tmps = ~*tmps;
+	}
+	break;
+    case O_SELECT:
+	stab_efullname(str,defoutstab);
+	if (maxarg > 0) {
+	    if ((arg[1].arg_type & A_MASK) == A_WORD)
+		defoutstab = arg[1].arg_ptr.arg_stab;
+	    else
+		defoutstab = stabent(str_get(st[1]),TRUE);
+	    if (!stab_io(defoutstab))
+		stab_io(defoutstab) = stio_new();
+	    curoutstab = defoutstab;
+	}
+	STABSET(str);
+	break;
+    case O_WRITE:
+	if (maxarg == 0)
+	    stab = defoutstab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	    if (!(stab = arg[1].arg_ptr.arg_stab))
+		stab = defoutstab;
+	}
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab_io(stab)) {
+	    str_set(str, No);
+	    STABSET(str);
+	    break;
+	}
+	curoutstab = stab;
+	fp = stab_io(stab)->ofp;
+	debarg = arg;
+	if (stab_io(stab)->fmt_stab)
+	    form = stab_form(stab_io(stab)->fmt_stab);
+	else
+	    form = stab_form(stab);
+	if (!form || !fp) {
+	    if (dowarn) {
+		if (form)
+		    warn("No format for filehandle");
+		else {
+		    if (stab_io(stab)->ifp)
+			warn("Filehandle only opened for input");
+		    else
+			warn("Write on closed filehandle");
+		}
+	    }
+	    str_set(str, No);
+	    STABSET(str);
+	    break;
+	}
+	format(&outrec,form,sp);
+	do_write(&outrec,stab,sp);
+	if (stab_io(stab)->flags & IOF_FLUSH)
+	    (void)fflush(fp);
+	str_set(str, Yes);
+	STABSET(str);
+	break;
+    case O_DBMOPEN:
+#ifdef SOME_DBM
+	anum = arg[1].arg_type & A_MASK;
+	if (anum == A_WORD || anum == A_STAB)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (st[3]->str_nok || st[3]->str_pok)
+	    anum = (int)str_gnum(st[3]);
+	else
+	    anum = -1;
+	value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
+	goto donumset;
+#else
+	fatal("No dbm or ndbm on this machine");
+#endif
+    case O_DBMCLOSE:
+#ifdef SOME_DBM
+	anum = arg[1].arg_type & A_MASK;
+	if (anum == A_WORD || anum == A_STAB)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	hdbmclose(stab_hash(stab));
+	goto say_yes;
+#else
+	fatal("No dbm or ndbm on this machine");
+#endif
+    case O_OPEN:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	tmps = str_get(st[2]);
+	if (do_open(stab,tmps,st[2]->str_cur)) {
+	    value = (double)forkprocess;
+	    stab_io(stab)->lines = 0;
+	    goto donumset;
+	}
+	else if (forkprocess == 0)		/* we are a new child */
+	    goto say_zero;
+	else
+	    goto say_undef;
+	/* break; */
+    case O_TRANS:
+	value = (double) do_trans(str,arg);
+	str = arg->arg_ptr.arg_str;
+	goto donumset;
+    case O_NTRANS:
+	str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
+	str = arg->arg_ptr.arg_str;
+	break;
+    case O_CLOSE:
+	if (maxarg == 0)
+	    stab = defoutstab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	str_set(str, do_close(stab,TRUE) ? Yes : No );
+	STABSET(str);
+	break;
+    case O_EACH:
+	sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
+	  gimme,arglast);
+	goto array_return;
+    case O_VALUES:
+    case O_KEYS:
+	sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_LARRAY:
+	str->str_nok = str->str_pok = 0;
+	str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
+	str->str_state = SS_ARY;
+	break;
+    case O_ARRAY:
+	ary = stab_array(arg[1].arg_ptr.arg_stab);
+	maxarg = ary->ary_fill + 1;
+	if (gimme == G_ARRAY) { /* array wanted */
+	    sp = arglast[0];
+	    st -= sp;
+	    if (maxarg > 0 && sp + maxarg > stack->ary_max) {
+		astore(stack,sp + maxarg, Nullstr);
+		st = stack->ary_array;
+	    }
+	    st += sp;
+	    Copy(ary->ary_array, &st[1], maxarg, STR*);
+	    sp += maxarg;
+	    goto array_return;
+	}
+	else {
+	    value = (double)maxarg;
+	    goto donumset;
+	}
+    case O_AELEM:
+	anum = ((int)str_gnum(st[2])) - arybase;
+	str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
+	break;
+    case O_DELETE:
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	tmps = str_get(st[2]);
+	str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
+	if (tmpstab == envstab)
+	    my_setenv(tmps,Nullch);
+	if (!str)
+	    goto say_undef;
+	break;
+    case O_LHASH:
+	str->str_nok = str->str_pok = 0;
+	str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
+	str->str_state = SS_HASH;
+	break;
+    case O_HASH:
+	if (gimme == G_ARRAY) { /* array wanted */
+	    sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
+		gimme,arglast);
+	    goto array_return;
+	}
+	else {
+	    tmpstab = arg[1].arg_ptr.arg_stab;
+	    if (!stab_hash(tmpstab)->tbl_fill)
+		goto say_zero;
+	    sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
+		stab_hash(tmpstab)->tbl_max+1);
+	    str_set(str,buf);
+	}
+	break;
+    case O_HELEM:
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	tmps = str_get(st[2]);
+	str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
+	break;
+    case O_LAELEM:
+	anum = ((int)str_gnum(st[2])) - arybase;
+	str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
+	if (!str || str == &str_undef)
+	    fatal("Assignment to non-creatable value, subscript %d",anum);
+	break;
+    case O_LHELEM:
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	tmps = str_get(st[2]);
+	anum = st[2]->str_cur;
+	str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
+	if (!str || str == &str_undef)
+	    fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
+	if (tmpstab == envstab)		/* heavy wizardry going on here */
+	    str_magic(str, tmpstab, 'E', tmps, anum);	/* str is now magic */
+					/* he threw the brick up into the air */
+	else if (tmpstab == sigstab)
+	    str_magic(str, tmpstab, 'S', tmps, anum);
+#ifdef SOME_DBM
+	else if (stab_hash(tmpstab)->tbl_dbm)
+	    str_magic(str, tmpstab, 'D', tmps, anum);
+#endif
+	else if (tmpstab == DBline)
+	    str_magic(str, tmpstab, 'L', tmps, anum);
+	break;
+    case O_LSLICE:
+	anum = 2;
+	argtype = FALSE;
+	goto do_slice_already;
+    case O_ASLICE:
+	anum = 1;
+	argtype = FALSE;
+	goto do_slice_already;
+    case O_HSLICE:
+	anum = 0;
+	argtype = FALSE;
+	goto do_slice_already;
+    case O_LASLICE:
+	anum = 1;
+	argtype = TRUE;
+	goto do_slice_already;
+    case O_LHSLICE:
+	anum = 0;
+	argtype = TRUE;
+      do_slice_already:
+	sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
+	    gimme,arglast);
+	goto array_return;
+    case O_SPLICE:
+	sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
+	goto array_return;
+    case O_PUSH:
+	if (arglast[2] - arglast[1] != 1)
+	    str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
+	else {
+	    str = Str_new(51,0);		/* must copy the STR */
+	    str_sset(str,st[2]);
+	    (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
+	}
+	break;
+    case O_POP:
+	str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
+	goto staticalization;
+    case O_SHIFT:
+	str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
+      staticalization:
+	if (!str)
+	    goto say_undef;
+	if (ary->ary_flags & ARF_REAL)
+	    (void)str_2mortal(str);
+	break;
+    case O_UNPACK:
+	sp = do_unpack(str,gimme,arglast);
+	goto array_return;
+    case O_SPLIT:
+	value = str_gnum(st[3]);
+	sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
+	  gimme,arglast);
+	goto array_return;
+    case O_LENGTH:
+	if (maxarg < 1)
+	    value = (double)str_len(stab_val(defstab));
+	else
+	    value = (double)str_len(st[1]);
+	goto donumset;
+    case O_SPRINTF:
+	do_sprintf(str, sp-arglast[0], st+1);
+	break;
+    case O_SUBSTR:
+	anum = ((int)str_gnum(st[2])) - arybase;	/* anum=where to start*/
+	tmps = str_get(st[1]);		/* force conversion to string */
+	/*SUPPRESS 560*/
+	if (argtype = (str == st[1]))
+	    str = arg->arg_ptr.arg_str;
+	if (anum < 0)
+	    anum += st[1]->str_cur + arybase;
+	if (anum < 0 || anum > st[1]->str_cur)
+	    str_nset(str,"",0);
+	else {
+	    optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
+	    if (optype < 0)
+		optype = 0;
+	    tmps += anum;
+	    anum = st[1]->str_cur - anum;	/* anum=how many bytes left*/
+	    if (anum > optype)
+		anum = optype;
+	    str_nset(str, tmps, anum);
+	    if (argtype) {			/* it's an lvalue! */
+		lstr = (struct lstring*)str;
+		str->str_magic = st[1];
+		st[1]->str_rare = 's';
+		lstr->lstr_offset = tmps - str_get(st[1]); 
+		lstr->lstr_len = anum; 
+	    }
+	}
+	break;
+    case O_PACK:
+	/*SUPPRESS 701*/
+	(void)do_pack(str,arglast);
+	break;
+    case O_GREP:
+	sp = do_grep(arg,str,gimme,arglast);
+	goto array_return;
+    case O_JOIN:
+	do_join(str,arglast);
+	break;
+    case O_SLT:
+	tmps = str_get(st[1]);
+	value = (double) (str_cmp(st[1],st[2]) < 0);
+	goto donumset;
+    case O_SGT:
+	tmps = str_get(st[1]);
+	value = (double) (str_cmp(st[1],st[2]) > 0);
+	goto donumset;
+    case O_SLE:
+	tmps = str_get(st[1]);
+	value = (double) (str_cmp(st[1],st[2]) <= 0);
+	goto donumset;
+    case O_SGE:
+	tmps = str_get(st[1]);
+	value = (double) (str_cmp(st[1],st[2]) >= 0);
+	goto donumset;
+    case O_SEQ:
+	tmps = str_get(st[1]);
+	value = (double) str_eq(st[1],st[2]);
+	goto donumset;
+    case O_SNE:
+	tmps = str_get(st[1]);
+	value = (double) !str_eq(st[1],st[2]);
+	goto donumset;
+    case O_SCMP:
+	tmps = str_get(st[1]);
+	value = (double) str_cmp(st[1],st[2]);
+	goto donumset;
+    case O_SUBR:
+	sp = do_subr(arg,gimme,arglast);
+	st = stack->ary_array + arglast[0];		/* maybe realloced */
+	goto array_return;
+    case O_DBSUBR:
+	sp = do_subr(arg,gimme,arglast);
+	st = stack->ary_array + arglast[0];		/* maybe realloced */
+	goto array_return;
+    case O_CALLER:
+	sp = do_caller(arg,maxarg,gimme,arglast);
+	st = stack->ary_array + arglast[0];		/* maybe realloced */
+	goto array_return;
+    case O_SORT:
+	sp = do_sort(str,arg,
+	  gimme,arglast);
+	goto array_return;
+    case O_REVERSE:
+	if (gimme == G_ARRAY)
+	    sp = do_reverse(arglast);
+	else
+	    sp = do_sreverse(str, arglast);
+	goto array_return;
+    case O_WARN:
+	if (arglast[2] - arglast[1] != 1) {
+	    do_join(str,arglast);
+	    tmps = str_get(str);
+	}
+	else {
+	    str = st[2];
+	    tmps = str_get(st[2]);
+	}
+	if (!tmps || !*tmps)
+	    tmps = "Warning: something's wrong";
+	warn("%s",tmps);
+	goto say_yes;
+    case O_DIE:
+	if (arglast[2] - arglast[1] != 1) {
+	    do_join(str,arglast);
+	    tmps = str_get(str);
+	}
+	else {
+	    str = st[2];
+	    tmps = str_get(st[2]);
+	}
+	if (!tmps || !*tmps)
+	    tmps = "Died";
+	fatal("%s",tmps);
+	goto say_zero;
+    case O_PRTF:
+    case O_PRINT:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab)
+	    stab = defoutstab;
+	if (!stab_io(stab)) {
+	    if (dowarn)
+		warn("Filehandle never opened");
+	    goto say_zero;
+	}
+	if (!(fp = stab_io(stab)->ofp)) {
+	    if (dowarn)  {
+		if (stab_io(stab)->ifp)
+		    warn("Filehandle opened only for input");
+		else
+		    warn("Print on closed filehandle");
+	    }
+	    goto say_zero;
+	}
+	else {
+	    if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
+		value = (double)do_aprint(arg,fp,arglast);
+	    else {
+		value = (double)do_print(st[2],fp);
+		if (orslen && optype == O_PRINT)
+		    if (fwrite(ors, 1, orslen, fp) == 0)
+			goto say_zero;
+	    }
+	    if (stab_io(stab)->flags & IOF_FLUSH)
+		if (fflush(fp) == EOF)
+		    goto say_zero;
+	}
+	goto donumset;
+    case O_CHDIR:
+	if (maxarg < 1)
+	    tmps = Nullch;
+	else
+	    tmps = str_get(st[1]);
+	if (!tmps || !*tmps) {
+	    tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
+	    tmps = str_get(tmpstr);
+	}
+	if (!tmps || !*tmps) {
+	    tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
+	    tmps = str_get(tmpstr);
+	}
+#ifdef TAINT
+	taintproper("Insecure dependency in chdir");
+#endif
+	value = (double)(chdir(tmps) >= 0);
+	goto donumset;
+    case O_EXIT:
+	if (maxarg < 1)
+	    anum = 0;
+	else
+	    anum = (int)str_gnum(st[1]);
+	exit(anum);
+	goto say_zero;
+    case O_RESET:
+	if (maxarg < 1)
+	    tmps = "";
+	else
+	    tmps = str_get(st[1]);
+	str_reset(tmps,curcmd->c_stash);
+	value = 1.0;
+	goto donumset;
+    case O_LIST:
+	if (gimme == G_ARRAY)
+	    goto array_return;
+	if (maxarg > 0)
+	    str = st[sp - arglast[0]];	/* unwanted list, return last item */
+	else
+	    str = &str_undef;
+	break;
+    case O_EOF:
+	if (maxarg <= 0)
+	    stab = last_in_stab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	str_set(str, do_eof(stab) ? Yes : No);
+	STABSET(str);
+	break;
+    case O_GETC:
+	if (maxarg <= 0)
+	    stab = stdinstab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab)
+	    stab = argvstab;
+	if (!stab || do_eof(stab)) /* make sure we have fp with something */
+	    goto say_undef;
+	else {
+#ifdef TAINT
+	    tainted = 1;
+#endif
+	    str_set(str," ");
+	    *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
+	}
+	STABSET(str);
+	break;
+    case O_TELL:
+	if (maxarg <= 0)
+	    stab = last_in_stab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_tell(stab);
+#else
+	(void)do_tell(stab);
+#endif
+	goto donumset;
+    case O_RECV:
+    case O_READ:
+    case O_SYSREAD:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	tmps = str_get(st[2]);
+	anum = (int)str_gnum(st[3]);
+	errno = 0;
+	maxarg = sp - arglast[0];
+	if (maxarg > 4)
+	    warn("Too many args on read");
+	if (maxarg == 4)
+	    maxarg = (int)str_gnum(st[4]);
+	else
+	    maxarg = 0;
+	if (!stab_io(stab) || !stab_io(stab)->ifp)
+	    goto say_undef;
+#ifdef HAS_SOCKET
+	if (optype == O_RECV) {
+	    argtype = sizeof buf;
+	    STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
+	    anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
+		buf, &argtype);
+	    if (anum >= 0) {
+		st[2]->str_cur = anum;
+		st[2]->str_ptr[anum] = '\0';
+		str_nset(str,buf,argtype);
+	    }
+	    else
+		str_sset(str,&str_undef);
+	    break;
+	}
+#else
+	if (optype == O_RECV)
+	    goto badsock;
+#endif
+	STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
+	if (optype == O_SYSREAD) {
+	    anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
+	}
+	else
+#ifdef HAS_SOCKET
+	if (stab_io(stab)->type == 's') {
+	    argtype = sizeof buf;
+	    anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
+		buf, &argtype);
+	}
+	else
+#endif
+	    anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
+	if (anum < 0)
+	    goto say_undef;
+	st[2]->str_cur = anum+maxarg;
+	st[2]->str_ptr[anum+maxarg] = '\0';
+	value = (double)anum;
+	goto donumset;
+    case O_SYSWRITE:
+    case O_SEND:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	tmps = str_get(st[2]);
+	anum = (int)str_gnum(st[3]);
+	errno = 0;
+	stio = stab_io(stab);
+	maxarg = sp - arglast[0];
+	if (!stio || !stio->ifp) {
+	    anum = -1;
+	    if (dowarn) {
+		if (optype == O_SYSWRITE)
+		    warn("Syswrite on closed filehandle");
+		else
+		    warn("Send on closed socket");
+	    }
+	}
+	else if (optype == O_SYSWRITE) {
+	    if (maxarg > 4)
+		warn("Too many args on syswrite");
+	    if (maxarg == 4)
+		optype = (int)str_gnum(st[4]);
+	    else
+		optype = 0;
+	    anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
+	}
+#ifdef HAS_SOCKET
+	else if (maxarg >= 4) {
+	    if (maxarg > 4)
+		warn("Too many args on send");
+	    tmps2 = str_get(st[4]);
+	    anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
+	      anum, tmps2, st[4]->str_cur);
+	}
+	else
+	    anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
+#else
+	else
+	    goto badsock;
+#endif
+	if (anum < 0)
+	    goto say_undef;
+	value = (double)anum;
+	goto donumset;
+    case O_SEEK:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	value = str_gnum(st[2]);
+	str_set(str, do_seek(stab,
+	  (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
+	STABSET(str);
+	break;
+    case O_RETURN:
+	tmps = "_SUB_";		/* just fake up a "last _SUB_" */
+	optype = O_LAST;
+	if (curcsv && curcsv->wantarray == G_ARRAY) {
+	    lastretstr = Nullstr;
+	    lastspbase = arglast[1];
+	    lastsize = arglast[2] - arglast[1];
+	}
+	else
+	    lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
+	goto dopop;
+    case O_REDO:
+    case O_NEXT:
+    case O_LAST:
+	tmps = Nullch;
+	if (maxarg > 0) {
+	    tmps = str_get(arg[1].arg_ptr.arg_str);
+	  dopop:
+	    while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
+	      strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
+#ifdef DEBUGGING
+		if (debug & 4) {
+		    deb("(Skipping label #%d %s)\n",loop_ptr,
+			loop_stack[loop_ptr].loop_label);
+		}
+#endif
+		loop_ptr--;
+	    }
+#ifdef DEBUGGING
+	    if (debug & 4) {
+		deb("(Found label #%d %s)\n",loop_ptr,
+		    loop_stack[loop_ptr].loop_label);
+	    }
+#endif
+	}
+	if (loop_ptr < 0) {
+	    if (tmps && strEQ(tmps, "_SUB_"))
+		fatal("Can't return outside a subroutine");
+	    fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
+	}
+	if (!lastretstr && optype == O_LAST && lastsize) {
+	    st -= arglast[0];
+	    st += lastspbase + 1;
+	    optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
+	    if (optype) {
+		for (anum = lastsize; anum > 0; anum--,st++)
+		    st[optype] = str_mortal(st[0]);
+	    }
+	    longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
+	}
+	longjmp(loop_stack[loop_ptr].loop_env, optype);
+    case O_DUMP:
+    case O_GOTO:/* shudder */
+	goto_targ = str_get(arg[1].arg_ptr.arg_str);
+	if (!*goto_targ)
+	    goto_targ = Nullch;		/* just restart from top */
+	if (optype == O_DUMP) {
+	    do_undump = 1;
+	    my_unexec();
+	}
+	longjmp(top_env, 1);
+    case O_INDEX:
+	tmps = str_get(st[1]);
+	if (maxarg < 3)
+	    anum = 0;
+	else {
+	    anum = (int) str_gnum(st[3]) - arybase;
+	    if (anum < 0)
+		anum = 0;
+	    else if (anum > st[1]->str_cur)
+		anum = st[1]->str_cur;
+	}
+#ifndef lint
+	if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
+	  (unsigned char*)tmps + st[1]->str_cur, st[2])))
+#else
+	if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
+#endif
+	    value = (double)(-1 + arybase);
+	else
+	    value = (double)(tmps2 - tmps + arybase);
+	goto donumset;
+    case O_RINDEX:
+	tmps = str_get(st[1]);
+	tmps2 = str_get(st[2]);
+	if (maxarg < 3)
+	    anum = st[1]->str_cur;
+	else {
+	    anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
+	    if (anum < 0)
+		anum = 0;
+	    else if (anum > st[1]->str_cur)
+		anum = st[1]->str_cur;
+	}
+#ifndef lint
+	if (!(tmps2 = rninstr(tmps,  tmps  + anum,
+			      tmps2, tmps2 + st[2]->str_cur)))
+#else
+	if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
+#endif
+	    value = (double)(-1 + arybase);
+	else
+	    value = (double)(tmps2 - tmps + arybase);
+	goto donumset;
+    case O_TIME:
+#ifndef lint
+	value = (double) time(Null(long*));
+#endif
+	goto donumset;
+    case O_TMS:
+	sp = do_tms(str,gimme,arglast);
+	goto array_return;
+    case O_LOCALTIME:
+	if (maxarg < 1)
+	    (void)time(&when);
+	else
+	    when = (time_t)str_gnum(st[1]);
+	sp = do_time(str,localtime(&when),
+	  gimme,arglast);
+	goto array_return;
+    case O_GMTIME:
+	if (maxarg < 1)
+	    (void)time(&when);
+	else
+	    when = (time_t)str_gnum(st[1]);
+	sp = do_time(str,gmtime(&when),
+	  gimme,arglast);
+	goto array_return;
+    case O_TRUNCATE:
+	sp = do_truncate(str,arg,
+	  gimme,arglast);
+	goto array_return;
+    case O_LSTAT:
+    case O_STAT:
+	sp = do_stat(str,arg,
+	  gimme,arglast);
+	goto array_return;
+    case O_CRYPT:
+#ifdef HAS_CRYPT
+	tmps = str_get(st[1]);
+#ifdef FCRYPT
+	str_set(str,fcrypt(tmps,str_get(st[2])));
+#else
+	str_set(str,crypt(tmps,str_get(st[2])));
+#endif
+#else
+	fatal(
+	  "The crypt() function is unimplemented due to excessive paranoia.");
+#endif
+	break;
+    case O_ATAN2:
+	value = str_gnum(st[1]);
+	value = atan2(value,str_gnum(st[2]));
+	goto donumset;
+    case O_SIN:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	value = sin(value);
+	goto donumset;
+    case O_COS:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	value = cos(value);
+	goto donumset;
+    case O_RAND:
+	if (maxarg < 1)
+	    value = 1.0;
+	else
+	    value = str_gnum(st[1]);
+	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
+	goto donumset;
+    case O_SRAND:
+	if (maxarg < 1) {
+	    (void)time(&when);
+	    anum = when;
+	}
+	else
+	    anum = (int)str_gnum(st[1]);
+	(void)srand(anum);
+	goto say_yes;
+    case O_EXP:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	value = exp(value);
+	goto donumset;
+    case O_LOG:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	if (value <= 0.0)
+	    fatal("Can't take log of %g\n", value);
+	value = log(value);
+	goto donumset;
+    case O_SQRT:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	if (value < 0.0)
+	    fatal("Can't take sqrt of %g\n", value);
+	value = sqrt(value);
+	goto donumset;
+    case O_INT:
+	if (maxarg < 1)
+	    value = str_gnum(stab_val(defstab));
+	else
+	    value = str_gnum(st[1]);
+	if (value >= 0.0)
+	    (void)modf(value,&value);
+	else {
+	    (void)modf(-value,&value);
+	    value = -value;
+	}
+	goto donumset;
+    case O_ORD:
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+#ifndef I286
+	value = (double) (*tmps & 255);
+#else
+	anum = (int) *tmps;
+	value = (double) (anum & 255);
+#endif
+	goto donumset;
+    case O_ALARM:
+#ifdef HAS_ALARM
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+	if (!tmps)
+	    tmps = "0";
+	anum = alarm((unsigned int)atoi(tmps));
+	if (anum < 0)
+	    goto say_undef;
+	value = (double)anum;
+	goto donumset;
+#else
+	fatal("Unsupported function alarm");
+	break;
+#endif
+    case O_SLEEP:
+	if (maxarg < 1)
+	    tmps = Nullch;
+	else
+	    tmps = str_get(st[1]);
+	(void)time(&when);
+	if (!tmps || !*tmps)
+	    sleep((32767<<16)+32767);
+	else
+	    sleep((unsigned int)atoi(tmps));
+#ifndef lint
+	value = (double)when;
+	(void)time(&when);
+	value = ((double)when) - value;
+#endif
+	goto donumset;
+    case O_RANGE:
+	sp = do_range(gimme,arglast);
+	goto array_return;
+    case O_F_OR_R:
+	if (gimme == G_ARRAY) {		/* it's a range */
+	    /* can we optimize to constant array? */
+	    if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
+	      (arg[2].arg_type & A_MASK) == A_SINGLE) {
+		st[2] = arg[2].arg_ptr.arg_str;
+		sp = do_range(gimme,arglast);
+		st = stack->ary_array;
+		maxarg = sp - arglast[0];
+		str_free(arg[1].arg_ptr.arg_str);
+		arg[1].arg_ptr.arg_str = Nullstr;
+		str_free(arg[2].arg_ptr.arg_str);
+		arg[2].arg_ptr.arg_str = Nullstr;
+		arg->arg_type = O_ARRAY;
+		arg[1].arg_type = A_STAB|A_DONT;
+		arg->arg_len = 1;
+		stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
+		ary = stab_array(stab);
+		afill(ary,maxarg - 1);
+		anum = maxarg;
+		st += arglast[0]+1;
+		while (maxarg-- > 0)
+		    ary->ary_array[maxarg] = str_smake(st[maxarg]);
+		st -= arglast[0]+1;
+		goto array_return;
+	    }
+	    arg->arg_type = optype = O_RANGE;
+	    maxarg = arg->arg_len = 2;
+	    anum = 2;
+	    arg[anum].arg_flags &= ~AF_ARYOK;
+	    argflags = arg[anum].arg_flags;
+	    argtype = arg[anum].arg_type & A_MASK;
+	    arg[anum].arg_type = argtype;
+	    argptr = arg[anum].arg_ptr;
+	    sp = arglast[0];
+	    st -= sp;
+	    sp++;
+	    goto re_eval;
+	}
+	arg->arg_type = O_FLIP;
+	/* FALL THROUGH */
+    case O_FLIP:
+	if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
+	  last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
+	  :
+	  str_true(st[1]) ) {
+	    arg[2].arg_type &= ~A_DONT;
+	    arg[1].arg_type |= A_DONT;
+	    arg->arg_type = optype = O_FLOP;
+	    if (arg->arg_flags & AF_COMMON) {
+		str_numset(str,0.0);
+		anum = 2;
+		argflags = arg[2].arg_flags;
+		argtype = arg[2].arg_type & A_MASK;
+		argptr = arg[2].arg_ptr;
+		sp = arglast[0];
+		st -= sp++;
+		goto re_eval;
+	    }
+	    else {
+		str_numset(str,1.0);
+		break;
+	    }
+	}
+	str_set(str,"");
+	break;
+    case O_FLOP:
+	str_inc(str);
+	if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
+	  last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
+	  :
+	  str_true(st[2]) ) {
+	    arg->arg_type = O_FLIP;
+	    arg[1].arg_type &= ~A_DONT;
+	    arg[2].arg_type |= A_DONT;
+	    str_cat(str,"E0");
+	}
+	break;
+    case O_FORK:
+#ifdef HAS_FORK
+	anum = fork();
+	if (anum < 0)
+	    goto say_undef;
+	if (!anum) {
+	    /*SUPPRESS 560*/
+	    if (tmpstab = stabent("$",allstabs))
+		str_numset(STAB_STR(tmpstab),(double)getpid());
+	    hclear(pidstatus, FALSE);	/* no kids, so don't wait for 'em */
+	}
+	value = (double)anum;
+	goto donumset;
+#else
+	fatal("Unsupported function fork");
+	break;
+#endif
+    case O_WAIT:
+#ifdef HAS_WAIT
+#ifndef lint
+	anum = wait(&argflags);
+	if (anum > 0)
+	    pidgone(anum,argflags);
+	value = (double)anum;
+#endif
+	statusvalue = (unsigned short)argflags;
+	goto donumset;
+#else
+	fatal("Unsupported function wait");
+	break;
+#endif
+    case O_WAITPID:
+#ifdef HAS_WAIT
+#ifndef lint
+	anum = (int)str_gnum(st[1]);
+	optype = (int)str_gnum(st[2]);
+	anum = wait4pid(anum, &argflags,optype);
+	value = (double)anum;
+#endif
+	statusvalue = (unsigned short)argflags;
+	goto donumset;
+#else
+	fatal("Unsupported function wait");
+	break;
+#endif
+    case O_SYSTEM:
+#ifdef HAS_FORK
+#ifdef TAINT
+	if (arglast[2] - arglast[1] == 1) {
+	    taintenv();
+	    tainted |= st[2]->str_tainted;
+	    taintproper("Insecure dependency in system");
+	}
+#endif
+	while ((anum = vfork()) == -1) {
+	    if (errno != EAGAIN) {
+		value = -1.0;
+		goto donumset;
+	    }
+	    sleep(5);
+	}
+	if (anum > 0) {
+#ifndef lint
+	    ihand = signal(SIGINT, SIG_IGN);
+	    qhand = signal(SIGQUIT, SIG_IGN);
+	    argtype = wait4pid(anum, &argflags, 0);
+#else
+	    ihand = qhand = 0;
+#endif
+	    (void)signal(SIGINT, ihand);
+	    (void)signal(SIGQUIT, qhand);
+	    statusvalue = (unsigned short)argflags;
+	    if (argtype < 0)
+		value = -1.0;
+	    else {
+		value = (double)((unsigned int)argflags & 0xffff);
+	    }
+	    do_execfree();	/* free any memory child malloced on vfork */
+	    goto donumset;
+	}
+	if ((arg[1].arg_type & A_MASK) == A_STAB)
+	    value = (double)do_aexec(st[1],arglast);
+	else if (arglast[2] - arglast[1] != 1)
+	    value = (double)do_aexec(Nullstr,arglast);
+	else {
+	    value = (double)do_exec(str_get(str_mortal(st[2])));
+	}
+	_exit(-1);
+#else /* ! FORK */
+	if ((arg[1].arg_type & A_MASK) == A_STAB)
+	    value = (double)do_aspawn(st[1],arglast);
+	else if (arglast[2] - arglast[1] != 1)
+	    value = (double)do_aspawn(Nullstr,arglast);
+	else {
+	    value = (double)do_spawn(str_get(str_mortal(st[2])));
+	}
+	goto donumset;
+#endif /* FORK */
+    case O_EXEC_OP:
+	if ((arg[1].arg_type & A_MASK) == A_STAB)
+	    value = (double)do_aexec(st[1],arglast);
+	else if (arglast[2] - arglast[1] != 1)
+	    value = (double)do_aexec(Nullstr,arglast);
+	else {
+#ifdef TAINT
+	    taintenv();
+	    tainted |= st[2]->str_tainted;
+	    taintproper("Insecure dependency in exec");
+#endif
+	    value = (double)do_exec(str_get(str_mortal(st[2])));
+	}
+	goto donumset;
+    case O_HEX:
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+	value = (double)scanhex(tmps, 99, &argtype);
+	goto donumset;
+
+    case O_OCT:
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+	while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
+	    tmps++;
+	if (*tmps == 'x')
+	    value = (double)scanhex(++tmps, 99, &argtype);
+	else
+	    value = (double)scanoct(tmps, 99, &argtype);
+	goto donumset;
+
+/* These common exits are hidden here in the middle of the switches for the
+   benefit of those machines with limited branch addressing.  Sigh.  */
+
+array_return:
+#ifdef DEBUGGING
+    if (debug) {
+	dlevel--;
+	if (debug & 8) {
+	    anum = sp - arglast[0];
+	    switch (anum) {
+	    case 0:
+		deb("%s RETURNS ()\n",opname[optype]);
+		break;
+	    case 1:
+		deb("%s RETURNS (\"%s\")\n",opname[optype],
+		    st[1] ? str_get(st[1]) : "");
+		break;
+	    default:
+		tmps = st[1] ? str_get(st[1]) : "";
+		deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
+		  anum,tmps,anum==2?"":"...,",
+			st[anum] ? str_get(st[anum]) : "");
+		break;
+	    }
+	}
+    }
+#endif
+    return sp;
+
+say_yes:
+    str = &str_yes;
+    goto normal_return;
+
+say_no:
+    str = &str_no;
+    goto normal_return;
+
+say_undef:
+    str = &str_undef;
+    goto normal_return;
+
+say_zero:
+    value = 0.0;
+    /* FALL THROUGH */
+
+donumset:
+    str_numset(str,value);
+    STABSET(str);
+    st[1] = str;
+#ifdef DEBUGGING
+    if (debug) {
+	dlevel--;
+	if (debug & 8)
+	    deb("%s RETURNS \"%f\"\n",opname[optype],value);
+    }
+#endif
+    return arglast[0] + 1;
+#ifdef SMALLSWITCHES
+    }
+    else
+    switch (optype) {
+#endif
+    case O_CHOWN:
+#ifdef HAS_CHOWN
+	value = (double)apply(optype,arglast);
+	goto donumset;
+#else
+	fatal("Unsupported function chown");
+	break;
+#endif
+    case O_KILL:
+#ifdef HAS_KILL
+	value = (double)apply(optype,arglast);
+	goto donumset;
+#else
+	fatal("Unsupported function kill");
+	break;
+#endif
+    case O_UNLINK:
+    case O_CHMOD:
+    case O_UTIME:
+	value = (double)apply(optype,arglast);
+	goto donumset;
+    case O_UMASK:
+#ifdef HAS_UMASK
+	if (maxarg < 1) {
+	    anum = umask(0);
+	    (void)umask(anum);
+	}
+	else
+	    anum = umask((int)str_gnum(st[1]));
+	value = (double)anum;
+#ifdef TAINT
+	taintproper("Insecure dependency in umask");
+#endif
+	goto donumset;
+#else
+	fatal("Unsupported function umask");
+	break;
+#endif
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    case O_MSGGET:
+    case O_SHMGET:
+    case O_SEMGET:
+	if ((anum = do_ipcget(optype, arglast)) == -1)
+	    goto say_undef;
+	value = (double)anum;
+	goto donumset;
+    case O_MSGCTL:
+    case O_SHMCTL:
+    case O_SEMCTL:
+	anum = do_ipcctl(optype, arglast);
+	if (anum == -1)
+	    goto say_undef;
+	if (anum != 0) {
+	    value = (double)anum;
+	    goto donumset;
+	}
+	str_set(str,"0 but true");
+	STABSET(str);
+	break;
+    case O_MSGSND:
+	value = (double)(do_msgsnd(arglast) >= 0);
+	goto donumset;
+    case O_MSGRCV:
+	value = (double)(do_msgrcv(arglast) >= 0);
+	goto donumset;
+    case O_SEMOP:
+	value = (double)(do_semop(arglast) >= 0);
+	goto donumset;
+    case O_SHMREAD:
+    case O_SHMWRITE:
+	value = (double)(do_shmio(optype, arglast) >= 0);
+	goto donumset;
+#else /* not SYSVIPC */
+    case O_MSGGET:
+    case O_MSGCTL:
+    case O_MSGSND:
+    case O_MSGRCV:
+    case O_SEMGET:
+    case O_SEMCTL:
+    case O_SEMOP:
+    case O_SHMGET:
+    case O_SHMCTL:
+    case O_SHMREAD:
+    case O_SHMWRITE:
+	fatal("System V IPC is not implemented on this machine");
+#endif /* not SYSVIPC */
+    case O_RENAME:
+	tmps = str_get(st[1]);
+	tmps2 = str_get(st[2]);
+#ifdef TAINT
+	taintproper("Insecure dependency in rename");
+#endif
+#ifdef HAS_RENAME
+	value = (double)(rename(tmps,tmps2) >= 0);
+#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);
+	}
+	value = (double)(anum >= 0);
+#endif
+	goto donumset;
+    case O_LINK:
+#ifdef HAS_LINK
+	tmps = str_get(st[1]);
+	tmps2 = str_get(st[2]);
+#ifdef TAINT
+	taintproper("Insecure dependency in link");
+#endif
+	value = (double)(link(tmps,tmps2) >= 0);
+	goto donumset;
+#else
+	fatal("Unsupported function link");
+	break;
+#endif
+    case O_MKDIR:
+	tmps = str_get(st[1]);
+	anum = (int)str_gnum(st[2]);
+#ifdef TAINT
+	taintproper("Insecure dependency in mkdir");
+#endif
+#ifdef HAS_MKDIR
+	value = (double)(mkdir(tmps,anum) >= 0);
+	goto donumset;
+#else
+	(void)strcpy(buf,"mkdir ");
+#endif
+#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
+      one_liner:
+	for (tmps2 = buf+6; *tmps; ) {
+	    *tmps2++ = '\\';
+	    *tmps2++ = *tmps++;
+	}
+	(void)strcpy(tmps2," 2>&1");
+	rsfp = mypopen(buf,"r");
+	if (rsfp) {
+	    *buf = '\0';
+	    tmps2 = fgets(buf,sizeof buf,rsfp);
+	    (void)mypclose(rsfp);
+	    if (tmps2 != Nullch) {
+		for (errno = 1; errno < sys_nerr; errno++) {
+		    if (instr(buf,sys_errlist[errno]))	/* you don't see this */
+			goto say_zero;
+		}
+		errno = 0;
+#ifndef EACCES
+#define EACCES EPERM
+#endif
+		if (instr(buf,"cannot make"))
+		    errno = EEXIST;
+		else if (instr(buf,"existing file"))
+		    errno = EEXIST;
+		else if (instr(buf,"ile exists"))
+		    errno = EEXIST;
+		else if (instr(buf,"non-exist"))
+		    errno = ENOENT;
+		else if (instr(buf,"does not exist"))
+		    errno = ENOENT;
+		else if (instr(buf,"not empty"))
+		    errno = EBUSY;
+		else if (instr(buf,"cannot access"))
+		    errno = EACCES;
+		else
+		    errno = EPERM;
+		goto say_zero;
+	    }
+	    else {	/* some mkdirs return no failure indication */
+		tmps = str_get(st[1]);
+		anum = (stat(tmps,&statbuf) >= 0);
+		if (optype == O_RMDIR)
+		    anum = !anum;
+		if (anum)
+		    errno = 0;
+		else
+		    errno = EACCES;	/* a guess */
+		value = (double)anum;
+	    }
+	    goto donumset;
+	}
+	else
+	    goto say_zero;
+#endif
+    case O_RMDIR:
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+#ifdef TAINT
+	taintproper("Insecure dependency in rmdir");
+#endif
+#ifdef HAS_RMDIR
+	value = (double)(rmdir(tmps) >= 0);
+	goto donumset;
+#else
+	(void)strcpy(buf,"rmdir ");
+	goto one_liner;		/* see above in HAS_MKDIR */
+#endif
+    case O_GETPPID:
+#ifdef HAS_GETPPID
+	value = (double)getppid();
+	goto donumset;
+#else
+	fatal("Unsupported function getppid");
+	break;
+#endif
+    case O_GETPGRP:
+#ifdef HAS_GETPGRP
+	if (maxarg < 1)
+	    anum = 0;
+	else
+	    anum = (int)str_gnum(st[1]);
+#ifdef _POSIX_SOURCE
+	if (anum != 0)
+	    fatal("POSIX getpgrp can't take an argument");
+	value = (double)getpgrp();
+#else
+	value = (double)getpgrp(anum);
+#endif
+	goto donumset;
+#else
+	fatal("The getpgrp() function is unimplemented on this machine");
+	break;
+#endif
+    case O_SETPGRP:
+#ifdef HAS_SETPGRP
+	argtype = (int)str_gnum(st[1]);
+	anum = (int)str_gnum(st[2]);
+#ifdef TAINT
+	taintproper("Insecure dependency in setpgrp");
+#endif
+	value = (double)(setpgrp(argtype,anum) >= 0);
+	goto donumset;
+#else
+	fatal("The setpgrp() function is unimplemented on this machine");
+	break;
+#endif
+    case O_GETPRIORITY:
+#ifdef HAS_GETPRIORITY
+	argtype = (int)str_gnum(st[1]);
+	anum = (int)str_gnum(st[2]);
+	value = (double)getpriority(argtype,anum);
+	goto donumset;
+#else
+	fatal("The getpriority() function is unimplemented on this machine");
+	break;
+#endif
+    case O_SETPRIORITY:
+#ifdef HAS_SETPRIORITY
+	argtype = (int)str_gnum(st[1]);
+	anum = (int)str_gnum(st[2]);
+	optype = (int)str_gnum(st[3]);
+#ifdef TAINT
+	taintproper("Insecure dependency in setpriority");
+#endif
+	value = (double)(setpriority(argtype,anum,optype) >= 0);
+	goto donumset;
+#else
+	fatal("The setpriority() function is unimplemented on this machine");
+	break;
+#endif
+    case O_CHROOT:
+#ifdef HAS_CHROOT
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+#ifdef TAINT
+	taintproper("Insecure dependency in chroot");
+#endif
+	value = (double)(chroot(tmps) >= 0);
+	goto donumset;
+#else
+	fatal("Unsupported function chroot");
+	break;
+#endif
+    case O_FCNTL:
+    case O_IOCTL:
+	if (maxarg <= 0)
+	    stab = last_in_stab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	argtype = U_I(str_gnum(st[2]));
+#ifdef TAINT
+	taintproper("Insecure dependency in ioctl");
+#endif
+	anum = do_ctl(optype,stab,argtype,st[3]);
+	if (anum == -1)
+	    goto say_undef;
+	if (anum != 0) {
+	    value = (double)anum;
+	    goto donumset;
+	}
+	str_set(str,"0 but true");
+	STABSET(str);
+	break;
+    case O_FLOCK:
+#ifdef HAS_FLOCK
+	if (maxarg <= 0)
+	    stab = last_in_stab;
+	else if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (stab && stab_io(stab))
+	    fp = stab_io(stab)->ifp;
+	else
+	    fp = Nullfp;
+	if (fp) {
+	    argtype = (int)str_gnum(st[2]);
+	    value = (double)(flock(fileno(fp),argtype) >= 0);
+	}
+	else
+	    value = 0;
+	goto donumset;
+#else
+	fatal("The flock() function is unimplemented on this machine");
+	break;
+#endif
+    case O_UNSHIFT:
+	ary = stab_array(arg[1].arg_ptr.arg_stab);
+	if (arglast[2] - arglast[1] != 1)
+	    do_unshift(ary,arglast);
+	else {
+	    STR *tmpstr = Str_new(52,0);	/* must copy the STR */
+	    str_sset(tmpstr,st[2]);
+	    aunshift(ary,1);
+	    (void)astore(ary,0,tmpstr);
+	}
+	value = (double)(ary->ary_fill + 1);
+	goto donumset;
+
+    case O_TRY:
+	sp = do_try(arg[1].arg_ptr.arg_cmd,
+	    gimme,arglast);
+	goto array_return;
+
+    case O_EVALONCE:
+	sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
+	    gimme,arglast);
+	if (eval_root) {
+	    str_free(arg[1].arg_ptr.arg_str);
+	    arg[1].arg_ptr.arg_cmd = eval_root;
+	    arg[1].arg_type = (A_CMD|A_DONT);
+	    arg[0].arg_type = O_TRY;
+	}
+	goto array_return;
+
+    case O_REQUIRE:
+    case O_DOFILE:
+    case O_EVAL:
+	if (maxarg < 1)
+	    tmpstr = stab_val(defstab);
+	else
+	    tmpstr =
+	      (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
+#ifdef TAINT
+	tainted |= tmpstr->str_tainted;
+	taintproper("Insecure dependency in eval");
+#endif
+	sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
+	    gimme,arglast);
+	goto array_return;
+
+    case O_FTRREAD:
+	argtype = 0;
+	anum = S_IRUSR;
+	goto check_perm;
+    case O_FTRWRITE:
+	argtype = 0;
+	anum = S_IWUSR;
+	goto check_perm;
+    case O_FTREXEC:
+	argtype = 0;
+	anum = S_IXUSR;
+	goto check_perm;
+    case O_FTEREAD:
+	argtype = 1;
+	anum = S_IRUSR;
+	goto check_perm;
+    case O_FTEWRITE:
+	argtype = 1;
+	anum = S_IWUSR;
+	goto check_perm;
+    case O_FTEEXEC:
+	argtype = 1;
+	anum = S_IXUSR;
+      check_perm:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (cando(anum,argtype,&statcache))
+	    goto say_yes;
+	goto say_no;
+
+    case O_FTIS:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	goto say_yes;
+    case O_FTEOWNED:
+    case O_FTROWNED:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
+	    goto say_yes;
+	goto say_no;
+    case O_FTZERO:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (!statcache.st_size)
+	    goto say_yes;
+	goto say_no;
+    case O_FTSIZE:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	value = (double)statcache.st_size;
+	goto donumset;
+
+    case O_FTMTIME:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	value = (double)(basetime - statcache.st_mtime) / 86400.0;
+	goto donumset;
+    case O_FTATIME:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	value = (double)(basetime - statcache.st_atime) / 86400.0;
+	goto donumset;
+    case O_FTCTIME:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	value = (double)(basetime - statcache.st_ctime) / 86400.0;
+	goto donumset;
+
+    case O_FTSOCK:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISSOCK(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTCHR:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISCHR(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTBLK:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISBLK(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTFILE:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISREG(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTDIR:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISDIR(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTPIPE:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISFIFO(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_FTLINK:
+	if (mylstat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (S_ISLNK(statcache.st_mode))
+	    goto say_yes;
+	goto say_no;
+    case O_SYMLINK:
+#ifdef HAS_SYMLINK
+	tmps = str_get(st[1]);
+	tmps2 = str_get(st[2]);
+#ifdef TAINT
+	taintproper("Insecure dependency in symlink");
+#endif
+	value = (double)(symlink(tmps,tmps2) >= 0);
+	goto donumset;
+#else
+	fatal("Unsupported function symlink");
+#endif
+    case O_READLINK:
+#ifdef HAS_SYMLINK
+	if (maxarg < 1)
+	    tmps = str_get(stab_val(defstab));
+	else
+	    tmps = str_get(st[1]);
+	anum = readlink(tmps,buf,sizeof buf);
+	if (anum < 0)
+	    goto say_undef;
+	str_nset(str,buf,anum);
+	break;
+#else
+	goto say_undef;		/* just pretend it's a normal file */
+#endif
+    case O_FTSUID:
+#ifdef S_ISUID
+	anum = S_ISUID;
+	goto check_xid;
+#else
+	goto say_no;
+#endif
+    case O_FTSGID:
+#ifdef S_ISGID
+	anum = S_ISGID;
+	goto check_xid;
+#else
+	goto say_no;
+#endif
+    case O_FTSVTX:
+#ifdef S_ISVTX
+	anum = S_ISVTX;
+#else
+	goto say_no;
+#endif
+      check_xid:
+	if (mystat(arg,st[1]) < 0)
+	    goto say_undef;
+	if (statcache.st_mode & anum)
+	    goto say_yes;
+	goto say_no;
+    case O_FTTTY:
+	if (arg[1].arg_type & A_DONT) {
+	    stab = arg[1].arg_ptr.arg_stab;
+	    tmps = "";
+	}
+	else
+	    stab = stabent(tmps = str_get(st[1]),FALSE);
+	if (stab && stab_io(stab) && stab_io(stab)->ifp)
+	    anum = fileno(stab_io(stab)->ifp);
+	else if (isDIGIT(*tmps))
+	    anum = atoi(tmps);
+	else
+	    goto say_undef;
+	if (isatty(anum))
+	    goto say_yes;
+	goto say_no;
+    case O_FTTEXT:
+    case O_FTBINARY:
+	str = do_fttext(arg,st[1]);
+	break;
+#ifdef HAS_SOCKET
+    case O_SOCKET:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_socket(stab,arglast);
+#else
+	(void)do_socket(stab,arglast);
+#endif
+	goto donumset;
+    case O_BIND:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_bind(stab,arglast);
+#else
+	(void)do_bind(stab,arglast);
+#endif
+	goto donumset;
+    case O_CONNECT:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_connect(stab,arglast);
+#else
+	(void)do_connect(stab,arglast);
+#endif
+	goto donumset;
+    case O_LISTEN:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_listen(stab,arglast);
+#else
+	(void)do_listen(stab,arglast);
+#endif
+	goto donumset;
+    case O_ACCEPT:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if ((arg[2].arg_type & A_MASK) == A_WORD)
+	    stab2 = arg[2].arg_ptr.arg_stab;
+	else
+	    stab2 = stabent(str_get(st[2]),TRUE);
+	do_accept(str,stab,stab2);
+	STABSET(str);
+	break;
+    case O_GHBYNAME:
+	if (maxarg < 1)
+	    goto say_undef;
+    case O_GHBYADDR:
+    case O_GHOSTENT:
+	sp = do_ghent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_GNBYNAME:
+	if (maxarg < 1)
+	    goto say_undef;
+    case O_GNBYADDR:
+    case O_GNETENT:
+	sp = do_gnent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_GPBYNAME:
+	if (maxarg < 1)
+	    goto say_undef;
+    case O_GPBYNUMBER:
+    case O_GPROTOENT:
+	sp = do_gpent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_GSBYNAME:
+	if (maxarg < 1)
+	    goto say_undef;
+    case O_GSBYPORT:
+    case O_GSERVENT:
+	sp = do_gsent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_SHOSTENT:
+	value = (double) sethostent((int)str_gnum(st[1]));
+	goto donumset;
+    case O_SNETENT:
+	value = (double) setnetent((int)str_gnum(st[1]));
+	goto donumset;
+    case O_SPROTOENT:
+	value = (double) setprotoent((int)str_gnum(st[1]));
+	goto donumset;
+    case O_SSERVENT:
+	value = (double) setservent((int)str_gnum(st[1]));
+	goto donumset;
+    case O_EHOSTENT:
+	value = (double) endhostent();
+	goto donumset;
+    case O_ENETENT:
+	value = (double) endnetent();
+	goto donumset;
+    case O_EPROTOENT:
+	value = (double) endprotoent();
+	goto donumset;
+    case O_ESERVENT:
+	value = (double) endservent();
+	goto donumset;
+    case O_SOCKPAIR:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if ((arg[2].arg_type & A_MASK) == A_WORD)
+	    stab2 = arg[2].arg_ptr.arg_stab;
+	else
+	    stab2 = stabent(str_get(st[2]),TRUE);
+#ifndef lint
+	value = (double)do_spair(stab,stab2,arglast);
+#else
+	(void)do_spair(stab,stab2,arglast);
+#endif
+	goto donumset;
+    case O_SHUTDOWN:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+#ifndef lint
+	value = (double)do_shutdown(stab,arglast);
+#else
+	(void)do_shutdown(stab,arglast);
+#endif
+	goto donumset;
+    case O_GSOCKOPT:
+    case O_SSOCKOPT:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	sp = do_sopt(optype,stab,arglast);
+	goto array_return;
+    case O_GETSOCKNAME:
+    case O_GETPEERNAME:
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab)
+	    goto say_undef;
+	sp = do_getsockname(optype,stab,arglast);
+	goto array_return;
+
+#else /* HAS_SOCKET not defined */
+    case O_SOCKET:
+    case O_BIND:
+    case O_CONNECT:
+    case O_LISTEN:
+    case O_ACCEPT:
+    case O_SOCKPAIR:
+    case O_GHBYNAME:
+    case O_GHBYADDR:
+    case O_GHOSTENT:
+    case O_GNBYNAME:
+    case O_GNBYADDR:
+    case O_GNETENT:
+    case O_GPBYNAME:
+    case O_GPBYNUMBER:
+    case O_GPROTOENT:
+    case O_GSBYNAME:
+    case O_GSBYPORT:
+    case O_GSERVENT:
+    case O_SHOSTENT:
+    case O_SNETENT:
+    case O_SPROTOENT:
+    case O_SSERVENT:
+    case O_EHOSTENT:
+    case O_ENETENT:
+    case O_EPROTOENT:
+    case O_ESERVENT:
+    case O_SHUTDOWN:
+    case O_GSOCKOPT:
+    case O_SSOCKOPT:
+    case O_GETSOCKNAME:
+    case O_GETPEERNAME:
+      badsock:
+	fatal("Unsupported socket function");
+#endif /* HAS_SOCKET */
+    case O_SSELECT:
+#ifdef HAS_SELECT
+	sp = do_select(gimme,arglast);
+	goto array_return;
+#else
+	fatal("select not implemented");
+#endif
+    case O_FILENO:
+	if (maxarg < 1)
+	    goto say_undef;
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
+	    goto say_undef;
+	value = fileno(fp);
+	goto donumset;
+    case O_BINMODE:
+	if (maxarg < 1)
+	    goto say_undef;
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
+	    goto say_undef;
+#ifdef DOSISH
+#ifdef atarist
+	if(fflush(fp))
+	   str_set(str, No);
+	else
+	{
+	    fp->_flag |= _IOBIN;
+	    str_set(str, Yes);
+	}
+#else
+	str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
+#endif
+#else
+	str_set(str, Yes);
+#endif
+	STABSET(str);
+	break;
+    case O_VEC:
+	sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
+	goto array_return;
+    case O_GPWNAM:
+    case O_GPWUID:
+    case O_GPWENT:
+#ifdef HAS_PASSWD
+	sp = do_gpwent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_SPWENT:
+	value = (double) setpwent();
+	goto donumset;
+    case O_EPWENT:
+	value = (double) endpwent();
+	goto donumset;
+#else
+    case O_EPWENT:
+    case O_SPWENT:
+	fatal("Unsupported password function");
+	break;
+#endif
+    case O_GGRNAM:
+    case O_GGRGID:
+    case O_GGRENT:
+#ifdef HAS_GROUP
+	sp = do_ggrent(optype,
+	  gimme,arglast);
+	goto array_return;
+    case O_SGRENT:
+	value = (double) setgrent();
+	goto donumset;
+    case O_EGRENT:
+	value = (double) endgrent();
+	goto donumset;
+#else
+    case O_EGRENT:
+    case O_SGRENT:
+	fatal("Unsupported group function");
+	break;
+#endif
+    case O_GETLOGIN:
+#ifdef HAS_GETLOGIN
+	if (!(tmps = getlogin()))
+	    goto say_undef;
+	str_set(str,tmps);
+#else
+	fatal("Unsupported function getlogin");
+#endif
+	break;
+    case O_OPEN_DIR:
+    case O_READDIR:
+    case O_TELLDIR:
+    case O_SEEKDIR:
+    case O_REWINDDIR:
+    case O_CLOSEDIR:
+	if (maxarg < 1)
+	    goto say_undef;
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if (!stab)
+	    goto say_undef;
+	sp = do_dirop(optype,stab,gimme,arglast);
+	goto array_return;
+    case O_SYSCALL:
+	value = (double)do_syscall(arglast);
+	goto donumset;
+    case O_PIPE_OP:
+#ifdef HAS_PIPE
+	if ((arg[1].arg_type & A_MASK) == A_WORD)
+	    stab = arg[1].arg_ptr.arg_stab;
+	else
+	    stab = stabent(str_get(st[1]),TRUE);
+	if ((arg[2].arg_type & A_MASK) == A_WORD)
+	    stab2 = arg[2].arg_ptr.arg_stab;
+	else
+	    stab2 = stabent(str_get(st[2]),TRUE);
+	do_pipe(str,stab,stab2);
+	STABSET(str);
+#else
+	fatal("Unsupported function pipe");
+#endif
+	break;
+    }
+
+  normal_return:
+    st[1] = str;
+#ifdef DEBUGGING
+    if (debug) {
+	dlevel--;
+	if (debug & 8)
+	    deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
+    }
+#endif
+    return arglast[0] + 1;
+}
diff --git a/gnu/usr.bin/perl/perl/form.c b/gnu/usr.bin/perl/perl/form.c
new file mode 100644
index 000000000000..57fc5de72e99
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/form.c
@@ -0,0 +1,419 @@
+/* $RCSfile: form.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: form.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  1993/02/05  19:34:32  lwall
+ * patch36: formats now ignore literal text for ~~ loop determination
+ *
+ * Revision 4.0.1.3  92/06/08  13:21:42  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
+ * Revision 4.0.1.2  91/11/05  17:18:43  lwall
+ * patch11: formats didn't fill their fields as well as they could
+ * patch11: ^ fields chopped hyphens on line break
+ * patch11: # fields could write outside allocated memory
+ * 
+ * Revision 4.0.1.1  91/06/07  11:07:59  lwall
+ * patch4: new copyright notice
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * 
+ * Revision 4.0  91/03/20  01:19:23  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* Forms stuff */
+
+static int countlines();
+
+void
+form_parseargs(fcmd)
+register FCMD *fcmd;
+{
+    register int i;
+    register ARG *arg;
+    register int items;
+    STR *str;
+    ARG *parselist();
+    line_t oldline = curcmd->c_line;
+    int oldsave = savestack->ary_fill;
+
+    str = fcmd->f_unparsed;
+    curcmd->c_line = fcmd->f_line;
+    fcmd->f_unparsed = Nullstr;
+    (void)savehptr(&curstash);
+    curstash = str->str_u.str_hash;
+    arg = parselist(str);
+    restorelist(oldsave);
+
+    items = arg->arg_len - 1;	/* ignore $$ on end */
+    for (i = 1; i <= items; i++) {
+	if (!fcmd || fcmd->f_type == F_NULL)
+	    fatal("Too many field values");
+	dehoist(arg,i);
+	fcmd->f_expr = make_op(O_ITEM,1,
+	  arg[i].arg_ptr.arg_arg,Nullarg,Nullarg);
+	if (fcmd->f_flags & FC_CHOP) {
+	    if ((fcmd->f_expr[1].arg_type & A_MASK) == A_STAB)
+		fcmd->f_expr[1].arg_type = A_LVAL;
+	    else if ((fcmd->f_expr[1].arg_type & A_MASK) == A_EXPR)
+		fcmd->f_expr[1].arg_type = A_LEXPR;
+	    else
+		fatal("^ field requires scalar lvalue");
+	}
+	fcmd = fcmd->f_next;
+    }
+    if (fcmd && fcmd->f_type)
+	fatal("Not enough field values");
+    curcmd->c_line = oldline;
+    Safefree(arg);
+    str_free(str);
+}
+
+int newsize;
+
+#define CHKLEN(allow) \
+newsize = (d - orec->o_str) + (allow); \
+if (newsize >= curlen) { \
+    curlen = d - orec->o_str; \
+    GROWSTR(&orec->o_str,&orec->o_len,orec->o_len + (allow)); \
+    d = orec->o_str + curlen;	/* in case it moves */ \
+    curlen = orec->o_len - 2; \
+}
+
+void
+format(orec,fcmd,sp)
+register struct outrec *orec;
+register FCMD *fcmd;
+int sp;
+{
+    register char *d = orec->o_str;
+    register char *s;
+    register int curlen = orec->o_len - 2;
+    register int size;
+    FCMD *nextfcmd;
+    FCMD *linebeg = fcmd;
+    char tmpchar;
+    char *t;
+    CMD mycmd;
+    STR *str;
+    char *chophere;
+    int blank = TRUE;
+
+    mycmd.c_type = C_NULL;
+    orec->o_lines = 0;
+    for (; fcmd; fcmd = nextfcmd) {
+	nextfcmd = fcmd->f_next;
+	CHKLEN(fcmd->f_presize);
+	/*SUPPRESS 560*/
+	if (s = fcmd->f_pre) {
+	    while (*s) {
+		if (*s == '\n') {
+		    t = orec->o_str;
+		    if (blank && (fcmd->f_flags & FC_REPEAT)) {
+			while (d > t && (d[-1] != '\n'))
+			    d--;
+		    }
+		    else {
+			while (d > t && (d[-1] == ' ' || d[-1] == '\t'))
+			    d--;
+		    }
+		    if (fcmd->f_flags & FC_NOBLANK) {
+			if (blank || d == orec->o_str || d[-1] == '\n') {
+			    orec->o_lines--;	/* don't print blank line */
+			    linebeg = fcmd->f_next;
+			    break;
+			}
+			else if (fcmd->f_flags & FC_REPEAT)
+			    nextfcmd = linebeg;
+			else
+			    linebeg = fcmd->f_next;
+		    }
+		    else
+			linebeg = fcmd->f_next;
+		    blank = TRUE;
+		}
+		*d++ = *s++;
+	    }
+	}
+	if (fcmd->f_unparsed)
+	    form_parseargs(fcmd);
+	switch (fcmd->f_type) {
+	case F_NULL:
+	    orec->o_lines++;
+	    break;
+	case F_LEFT:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
+		size--;
+		if (*s && index(chopset,(*d++ = *s++)))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		d -= (s - chophere);
+		if (fcmd->f_flags & FC_MORE &&
+		  *chophere && strNE(chophere,"\n")) {
+		    while (size < 3) {
+			d--;
+			size++;
+		    }
+		    while (d[-1] == ' ' && size < fcmd->f_size) {
+			d--;
+			size++;
+		    }
+		    *d++ = '.';
+		    *d++ = '.';
+		    *d++ = '.';
+		    size -= 3;
+		}
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+		str_chop(str,chophere);
+	    }
+	    if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+		size = 0;			/* no spaces before newline */
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    break;
+	case F_RIGHT:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    t = s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
+		size--;
+		if (*s && index(chopset,*s++))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		s = chophere;
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+	    }
+	    tmpchar = *s;
+	    *s = '\0';
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    size = s - t;
+	    Copy(t,d,size,char);
+	    d += size;
+	    *s = tmpchar;
+	    if (fcmd->f_flags & FC_CHOP)
+		str_chop(str,chophere);
+	    break;
+	case F_CENTER: {
+	    int halfsize;
+
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    t = s = str_get(str);
+	    size = fcmd->f_size;
+	    CHKLEN(size);
+	    chophere = Nullch;
+	    while (size && *s && *s != '\n') {
+		if (*s == '\t')
+		    *s = ' ';
+		else if (*s != ' ')
+		    blank = FALSE;
+		size--;
+		if (*s && index(chopset,*s++))
+		    chophere = s;
+		if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
+		    *s = ' ';
+	    }
+	    if (size || !*s)
+		chophere = s;
+	    else if (chophere && chophere < s && *s && index(chopset,*s))
+		chophere = s;
+	    if (fcmd->f_flags & FC_CHOP) {
+		if (!chophere)
+		    chophere = s;
+		size += (s - chophere);
+		s = chophere;
+		while (*chophere && index(chopset,*chophere)
+		  && isSPACE(*chophere))
+		    chophere++;
+	    }
+	    tmpchar = *s;
+	    *s = '\0';
+	    halfsize = size / 2;
+	    while (size > halfsize) {
+		size--;
+		*d++ = ' ';
+	    }
+	    size = s - t;
+	    Copy(t,d,size,char);
+	    d += size;
+	    *s = tmpchar;
+	    if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
+		size = 0;			/* no spaces before newline */
+	    else
+		size = halfsize;
+	    while (size) {
+		size--;
+		*d++ = ' ';
+	    }
+	    if (fcmd->f_flags & FC_CHOP)
+		str_chop(str,chophere);
+	    break;
+	}
+	case F_LINES:
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    s = str_get(str);
+	    size = str_len(str);
+	    CHKLEN(size+1);
+	    orec->o_lines += countlines(s,size) - 1;
+	    Copy(s,d,size,char);
+	    d += size;
+	    if (size && s[size-1] != '\n') {
+		*d++ = '\n';
+		orec->o_lines++;
+	    }
+	    linebeg = fcmd->f_next;
+	    break;
+	case F_DECIMAL: {
+	    double value;
+
+	    (void)eval(fcmd->f_expr,G_SCALAR,sp);
+	    str = stack->ary_array[sp+1];
+	    size = fcmd->f_size;
+	    CHKLEN(size+1);
+	    /* If the field is marked with ^ and the value is undefined,
+	       blank it out. */
+	    if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
+		while (size) {
+		    size--;
+		    *d++ = ' ';
+		}
+		break;
+	    }
+	    blank = FALSE;
+	    value = str_gnum(str);
+	    if (fcmd->f_flags & FC_DP) {
+		sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
+	    } else {
+		sprintf(d, "%*.0f", size, value);
+	    }
+	    d += size;
+	    break;
+	}
+	}
+    }
+    CHKLEN(1);
+    *d++ = '\0';
+}
+
+static int
+countlines(s,size)
+register char *s;
+register int size;
+{
+    register int count = 0;
+
+    while (size--) {
+	if (*s++ == '\n')
+	    count++;
+    }
+    return count;
+}
+
+void
+do_write(orec,stab,sp)
+struct outrec *orec;
+STAB *stab;
+int sp;
+{
+    register STIO *stio = stab_io(stab);
+    FILE *ofp = stio->ofp;
+
+#ifdef DEBUGGING
+    if (debug & 256)
+	fprintf(stderr,"left=%ld, todo=%ld\n",
+	  (long)stio->lines_left, (long)orec->o_lines);
+#endif
+    if (stio->lines_left < orec->o_lines) {
+	if (!stio->top_stab) {
+	    STAB *topstab;
+	    char tmpbuf[256];
+
+	    if (!stio->top_name) {
+		if (!stio->fmt_name)
+		    stio->fmt_name = savestr(stab_name(stab));
+		sprintf(tmpbuf, "%s_TOP", stio->fmt_name);
+		topstab = stabent(tmpbuf,FALSE);
+		if (topstab && stab_form(topstab))
+		    stio->top_name = savestr(tmpbuf);
+		else
+		    stio->top_name = savestr("top");
+	    }
+	    topstab = stabent(stio->top_name,FALSE);
+	    if (!topstab || !stab_form(topstab)) {
+		stio->lines_left = 100000000;
+		goto forget_top;
+	    }
+	    stio->top_stab = topstab;
+	}
+	if (stio->lines_left >= 0 && stio->page > 0)
+	    fwrite(formfeed->str_ptr, formfeed->str_cur, 1, ofp);
+	stio->lines_left = stio->page_len;
+	stio->page++;
+	format(&toprec,stab_form(stio->top_stab),sp);
+	fputs(toprec.o_str,ofp);
+	stio->lines_left -= toprec.o_lines;
+    }
+  forget_top:
+    fputs(orec->o_str,ofp);
+    stio->lines_left -= orec->o_lines;
+}
diff --git a/gnu/usr.bin/perl/perl/form.h b/gnu/usr.bin/perl/perl/form.h
new file mode 100644
index 000000000000..1e3e6f458540
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/form.h
@@ -0,0 +1,48 @@
+/* $RCSfile: form.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: form.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  11:08:20  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:19:37  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define F_NULL 0
+#define F_LEFT 1
+#define F_RIGHT 2
+#define F_CENTER 3
+#define F_LINES 4
+#define F_DECIMAL 5
+
+struct formcmd {
+    struct formcmd *f_next;
+    ARG *f_expr;
+    STR *f_unparsed;
+    line_t f_line;
+    char *f_pre;
+    short f_presize;
+    short f_size;
+    short f_decimals;
+    char f_type;
+    char f_flags;
+};
+
+#define FC_CHOP 1
+#define FC_NOBLANK 2
+#define FC_MORE 4
+#define FC_REPEAT 8
+#define FC_DP 16
+
+#define Nullfcmd Null(FCMD*)
+
+EXT char *chopset INIT(" \n-");
diff --git a/gnu/usr.bin/perl/perl/handy.h b/gnu/usr.bin/perl/perl/handy.h
new file mode 100644
index 000000000000..46231aed9c6e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/handy.h
@@ -0,0 +1,150 @@
+/* $RCSfile: handy.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:36 $
+ *
+ *    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: handy.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  13:23:17  lwall
+ * patch20: isascii() may now be supplied by a library routine
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
+ * Revision 4.0.1.3  91/11/05  22:54:26  lwall
+ * patch11: erratum
+ * 
+ * Revision 4.0.1.2  91/11/05  17:23:38  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.1  91/06/07  11:09:56  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:22:15  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#ifdef NULL
+#undef NULL
+#endif
+#ifndef I286
+#  define NULL 0
+#else
+#  define NULL 0L
+#endif
+#define Null(type) ((type)NULL)
+#define Nullch Null(char*)
+#define Nullfp Null(FILE*)
+
+#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)
+
+#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))
+
+#if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
+#define isALNUM(c) (isalpha(c) || isdigit(c) || c == '_')
+#define isALPHA(c) isalpha(c)
+#define isSPACE(c) isspace(c)
+#define isDIGIT(c) isdigit(c)
+#define isUPPER(c) isupper(c)
+#define isLOWER(c) islower(c)
+#else
+#define isALNUM(c) (isascii(c) && (isalpha(c) || isdigit(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))
+#endif
+
+/* Line numbers are unsigned, 16 bits. */
+typedef unsigned short line_t;
+#ifdef lint
+#define NOLINE ((line_t)0)
+#else
+#define NOLINE ((line_t) 65535)
+#endif
+
+#ifndef lint
+#ifndef LEAKTEST
+#ifndef safemalloc
+char *safemalloc();
+char *saferealloc();
+void safefree();
+#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 Str_new(x,len) str_new(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 Str_new(x,len) str_new(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 STRUCTCOPY
+#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/perl/hash.c b/gnu/usr.bin/perl/perl/hash.c
new file mode 100644
index 000000000000..15cc116001b3
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/hash.c
@@ -0,0 +1,715 @@
+/* $RCSfile: hash.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:37 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:37  nate
+ * PERL!
+ *
+ * Revision 4.0.1.3  92/06/08  13:26:29  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: delete could cause %array to give too low a count of buckets filled
+ * patch20: hash tables now split only if the memory is available to do so
+ * 
+ * Revision 4.0.1.2  91/11/05  17:24:13  lwall
+ * patch11: saberized perl
+ * 
+ * Revision 4.0.1.1  91/06/07  11:10:11  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:22:26  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static void hsplit();
+
+static 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};
+
+static void hfreeentries();
+
+STR *
+hfetch(tb,key,klen,lval)
+register HASH *tb;
+char *key;
+unsigned int klen;
+int lval;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register int maxi;
+    STR *str;
+#ifdef SOME_DBM
+    datum dkey,dcontent;
+#endif
+
+    if (!tb)
+	return &str_undef;
+    if (!tb->tbl_array) {
+	if (lval)
+	    Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*);
+	else
+	    return &str_undef;
+    }
+
+    /* The hash function we use on symbols has to be equal to the first
+     * character when taken modulo 128, so that str_reset() can be implemented
+     * efficiently.  We throw in the second character and the last character
+     * (times 128) so that long chains of identifiers starting with the
+     * same letter don't have to be strEQ'ed within hfetch(), since it
+     * compares hash values before trying strEQ().
+     */
+    if (!tb->tbl_coeffsize)
+	hash = *key + 128 * key[1] + 128 * key[klen-1];	/* assuming klen > 0 */
+    else {	/* use normal coefficients */
+	if (klen < tb->tbl_coeffsize)
+	    maxi = klen;
+	else
+	    maxi = tb->tbl_coeffsize;
+	for (s=key,		i=0,	hash = 0;
+			    i < maxi;			/*SUPPRESS 8*/
+	     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 (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	return entry->hent_val;
+    }
+#ifdef SOME_DBM
+    if (tb->tbl_dbm) {
+	dkey.dptr = key;
+	dkey.dsize = klen;
+#ifdef HAS_GDBM
+	dcontent = gdbm_fetch(tb->tbl_dbm,dkey);
+#else
+	dcontent = dbm_fetch(tb->tbl_dbm,dkey);
+#endif
+	if (dcontent.dptr) {			/* found one */
+	    str = Str_new(60,dcontent.dsize);
+	    str_nset(str,dcontent.dptr,dcontent.dsize);
+	    hstore(tb,key,klen,str,hash);		/* cache it */
+	    return str;
+	}
+    }
+#endif
+    if (lval) {		/* gonna assign to this, so it better be there */
+	str = Str_new(61,0);
+	hstore(tb,key,klen,str,hash);
+	return str;
+    }
+    return &str_undef;
+}
+
+bool
+hstore(tb,key,klen,val,hash)
+register HASH *tb;
+char *key;
+unsigned int klen;
+STR *val;
+register int hash;
+{
+    register char *s;
+    register int i;
+    register HENT *entry;
+    register HENT **oentry;
+    register int maxi;
+
+    if (!tb)
+	return FALSE;
+
+    if (hash)
+	/*SUPPRESS 530*/
+	;
+    else if (!tb->tbl_coeffsize)
+	hash = *key + 128 * key[1] + 128 * key[klen-1];
+    else {	/* use normal coefficients */
+	if (klen < tb->tbl_coeffsize)
+	    maxi = klen;
+	else
+	    maxi = tb->tbl_coeffsize;
+	for (s=key,		i=0,	hash = 0;
+			    i < maxi;			/*SUPPRESS 8*/
+	     s++,		i++,	hash *= 5) {
+	    hash += *s * coeff[i];
+	}
+    }
+
+    if (!tb->tbl_array)
+	Newz(505,tb->tbl_array, tb->tbl_max + 1, HENT*);
+
+    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 (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	Safefree(entry->hent_val);
+	entry->hent_val = val;
+	return TRUE;
+    }
+    New(501,entry, 1, HENT);
+
+    entry->hent_klen = klen;
+    entry->hent_key = nsavestr(key,klen);
+    entry->hent_val = val;
+    entry->hent_hash = hash;
+    entry->hent_next = *oentry;
+    *oentry = entry;
+
+    /* hdbmstore not necessary here because it's called from stabset() */
+
+    if (i) {				/* initial entry? */
+	tb->tbl_fill++;
+#ifdef SOME_DBM
+	if (tb->tbl_dbm && tb->tbl_max >= DBM_CACHE_MAX)
+	    return FALSE;
+#endif
+	if (tb->tbl_fill > tb->tbl_dosplit)
+	    hsplit(tb);
+    }
+#ifdef SOME_DBM
+    else if (tb->tbl_dbm) {		/* is this just a cache for dbm file? */
+	void hentdelayfree();
+
+	entry = tb->tbl_array[hash & tb->tbl_max];
+	oentry = &entry->hent_next;
+	entry = *oentry;
+	while (entry) {	/* trim chain down to 1 entry */
+	    *oentry = entry->hent_next;
+	    hentdelayfree(entry);	/* no doubt they'll want this next. */
+	    entry = *oentry;
+	}
+    }
+#endif
+
+    return FALSE;
+}
+
+STR *
+hdelete(tb,key,klen)
+register HASH *tb;
+char *key;
+unsigned int klen;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register HENT **oentry;
+    STR *str;
+    int maxi;
+#ifdef SOME_DBM
+    datum dkey;
+#endif
+
+    if (!tb || !tb->tbl_array)
+	return Nullstr;
+    if (!tb->tbl_coeffsize)
+	hash = *key + 128 * key[1] + 128 * key[klen-1];
+    else {	/* use normal coefficients */
+	if (klen < tb->tbl_coeffsize)
+	    maxi = klen;
+	else
+	    maxi = tb->tbl_coeffsize;
+	for (s=key,		i=0,	hash = 0;
+			    i < maxi;			/*SUPPRESS 8*/
+	     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 = *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)
+	    tb->tbl_fill--;
+	str = str_mortal(entry->hent_val);
+	hentfree(entry);
+#ifdef SOME_DBM
+      do_dbm_delete:
+	if (tb->tbl_dbm) {
+	    dkey.dptr = key;
+	    dkey.dsize = klen;
+#ifdef HAS_GDBM
+	    gdbm_delete(tb->tbl_dbm,dkey);
+#else
+	    dbm_delete(tb->tbl_dbm,dkey);
+#endif
+	}
+#endif
+	return str;
+    }
+#ifdef SOME_DBM
+    str = Nullstr;
+    goto do_dbm_delete;
+#else
+    return Nullstr;
+#endif
+}
+
+static 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 = tb->tbl_array;
+    nomemok = TRUE;
+    Renew(a, newsize, HENT*);
+    nomemok = FALSE;
+    if (!a) {
+	tb->tbl_dosplit = tb->tbl_max + 1;	/* never split again */
+	return;
+    }
+    Zero(&a[oldsize], oldsize, HENT*);		/* zero 2nd half*/
+    tb->tbl_max = --newsize;
+    tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
+    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(lookat)
+unsigned int lookat;
+{
+    register HASH *tb;
+
+    Newz(502,tb, 1, HASH);
+    if (lookat) {
+	tb->tbl_coeffsize = lookat;
+	tb->tbl_max = 7;		/* it's a normal associative array */
+	tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
+    }
+    else {
+	tb->tbl_max = 127;		/* it's a symbol table */
+	tb->tbl_dosplit = 128;		/* so never split */
+    }
+    tb->tbl_fill = 0;
+#ifdef SOME_DBM
+    tb->tbl_dbm = 0;
+#endif
+    (void)hiterinit(tb);	/* so each() will start off right */
+    return tb;
+}
+
+void
+hentfree(hent)
+register HENT *hent;
+{
+    if (!hent)
+	return;
+    str_free(hent->hent_val);
+    Safefree(hent->hent_key);
+    Safefree(hent);
+}
+
+void
+hentdelayfree(hent)
+register HENT *hent;
+{
+    if (!hent)
+	return;
+    str_2mortal(hent->hent_val);	/* free between statements */
+    Safefree(hent->hent_key);
+    Safefree(hent);
+}
+
+void
+hclear(tb,dodbm)
+register HASH *tb;
+int dodbm;
+{
+    if (!tb)
+	return;
+    hfreeentries(tb,dodbm);
+    tb->tbl_fill = 0;
+#ifndef lint
+    if (tb->tbl_array)
+	(void)memzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
+#endif
+}
+
+static void
+hfreeentries(tb,dodbm)
+register HASH *tb;
+int dodbm;
+{
+    register HENT *hent;
+    register HENT *ohent = Null(HENT*);
+#ifdef SOME_DBM
+    datum dkey;
+    datum nextdkey;
+#ifdef HAS_GDBM
+    GDBM_FILE old_dbm;
+#else
+#ifdef HAS_NDBM
+    DBM *old_dbm;
+#else
+    int old_dbm;
+#endif
+#endif
+#endif
+
+    if (!tb || !tb->tbl_array)
+	return;
+#ifdef SOME_DBM
+    if ((old_dbm = tb->tbl_dbm) && dodbm) {
+#ifdef HAS_GDBM
+	while (dkey = gdbm_firstkey(tb->tbl_dbm), dkey.dptr) {
+#else
+	while (dkey = dbm_firstkey(tb->tbl_dbm), dkey.dptr) {
+#endif
+	    do {
+#ifdef HAS_GDBM
+		nextdkey = gdbm_nextkey(tb->tbl_dbm, dkey);
+#else
+#ifdef HAS_NDBM
+#ifdef _CX_UX
+		nextdkey = dbm_nextkey(tb->tbl_dbm, dkey);
+#else
+		nextdkey = dbm_nextkey(tb->tbl_dbm);
+#endif
+#else
+		nextdkey = nextkey(dkey);
+#endif
+#endif
+#ifdef HAS_GDBM
+		gdbm_delete(tb->tbl_dbm,dkey);
+#else
+		dbm_delete(tb->tbl_dbm,dkey);
+#endif
+		dkey = nextdkey;
+	    } while (dkey.dptr);	/* one way or another, this works */
+	}
+    }
+    tb->tbl_dbm = 0;			/* now clear just cache */
+#endif
+    (void)hiterinit(tb);
+    /*SUPPRESS 560*/
+    while (hent = hiternext(tb)) {	/* concise but not very efficient */
+	hentfree(ohent);
+	ohent = hent;
+    }
+    hentfree(ohent);
+#ifdef SOME_DBM
+    tb->tbl_dbm = old_dbm;
+#endif
+}
+
+void
+hfree(tb,dodbm)
+register HASH *tb;
+int dodbm;
+{
+    if (!tb)
+	return;
+    hfreeentries(tb,dodbm);
+    Safefree(tb->tbl_array);
+    Safefree(tb);
+}
+
+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;
+#ifdef SOME_DBM
+    datum key;
+#endif
+
+    entry = tb->tbl_eiter;
+#ifdef SOME_DBM
+    if (tb->tbl_dbm) {
+	if (entry) {
+#ifdef HAS_GDBM
+	    key.dptr = entry->hent_key;
+	    key.dsize = entry->hent_klen;
+	    key = gdbm_nextkey(tb->tbl_dbm, key);
+#else
+#ifdef HAS_NDBM
+#ifdef _CX_UX
+	    key.dptr = entry->hent_key;
+	    key.dsize = entry->hent_klen;
+	    key = dbm_nextkey(tb->tbl_dbm, key);
+#else
+	    key = dbm_nextkey(tb->tbl_dbm);
+#endif /* _CX_UX */
+#else
+	    key.dptr = entry->hent_key;
+	    key.dsize = entry->hent_klen;
+	    key = nextkey(key);
+#endif
+#endif
+	}
+	else {
+	    Newz(504,entry, 1, HENT);
+	    tb->tbl_eiter = entry;
+#ifdef HAS_GDBM
+	    key = gdbm_firstkey(tb->tbl_dbm);
+#else
+	    key = dbm_firstkey(tb->tbl_dbm);
+#endif
+	}
+	entry->hent_key = key.dptr;
+	entry->hent_klen = key.dsize;
+	if (!key.dptr) {
+	    if (entry->hent_val)
+		str_free(entry->hent_val);
+	    Safefree(entry);
+	    tb->tbl_eiter = Null(HENT*);
+	    return Null(HENT*);
+	}
+	return entry;
+    }
+#endif
+    if (!tb->tbl_array)
+	Newz(506,tb->tbl_array, tb->tbl_max + 1, HENT*);
+    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,retlen)
+register HENT *entry;
+int *retlen;
+{
+    *retlen = entry->hent_klen;
+    return entry->hent_key;
+}
+
+STR *
+hiterval(tb,entry)
+register HASH *tb;
+register HENT *entry;
+{
+#ifdef SOME_DBM
+    datum key, content;
+
+    if (tb->tbl_dbm) {
+	key.dptr = entry->hent_key;
+	key.dsize = entry->hent_klen;
+#ifdef HAS_GDBM
+	content = gdbm_fetch(tb->tbl_dbm,key);
+#else
+	content = dbm_fetch(tb->tbl_dbm,key);
+#endif
+	if (!entry->hent_val)
+	    entry->hent_val = Str_new(62,0);
+	str_nset(entry->hent_val,content.dptr,content.dsize);
+    }
+#endif
+    return entry->hent_val;
+}
+
+#ifdef SOME_DBM
+
+#ifndef O_CREAT
+#  ifdef I_FCNTL
+#    include <fcntl.h>
+#  endif
+#  ifdef I_SYS_FILE
+#    include <sys/file.h>
+#  endif
+#endif
+
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+#ifndef O_RDWR
+#define O_RDWR 2
+#endif
+#ifndef O_CREAT
+#define O_CREAT 01000
+#endif
+
+#ifdef HAS_ODBM
+static int dbmrefcnt = 0;
+#endif
+
+bool
+hdbmopen(tb,fname,mode)
+register HASH *tb;
+char *fname;
+int mode;
+{
+    if (!tb)
+	return FALSE;
+#ifdef HAS_ODBM
+    if (tb->tbl_dbm)	/* never really closed it */
+	return TRUE;
+#endif
+    if (tb->tbl_dbm) {
+	hdbmclose(tb);
+	tb->tbl_dbm = 0;
+    }
+    hclear(tb, FALSE);	/* clear cache */
+#ifdef HAS_GDBM
+    if (mode >= 0)
+	tb->tbl_dbm = gdbm_open(fname, 0, GDBM_WRCREAT,mode, (void *) NULL);
+    if (!tb->tbl_dbm)
+	tb->tbl_dbm = gdbm_open(fname, 0, GDBM_WRITER, mode, (void *) NULL);
+    if (!tb->tbl_dbm)
+	tb->tbl_dbm = gdbm_open(fname, 0, GDBM_READER, mode, (void *) NULL);
+#else
+#ifdef HAS_NDBM
+    if (mode >= 0)
+	tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
+    if (!tb->tbl_dbm)
+	tb->tbl_dbm = dbm_open(fname, O_RDWR, mode);
+    if (!tb->tbl_dbm)
+	tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode);
+#else
+    if (dbmrefcnt++)
+	fatal("Old dbm can only open one database");
+    sprintf(buf,"%s.dir",fname);
+    if (stat(buf, &statbuf) < 0) {
+	if (mode < 0 || close(creat(buf,mode)) < 0)
+	    return FALSE;
+	sprintf(buf,"%s.pag",fname);
+	if (close(creat(buf,mode)) < 0)
+	    return FALSE;
+    }
+    tb->tbl_dbm = dbminit(fname) >= 0;
+#endif
+#endif
+    if (!tb->tbl_array && tb->tbl_dbm != 0)
+	Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*);
+    return tb->tbl_dbm != 0;
+}
+
+void
+hdbmclose(tb)
+register HASH *tb;
+{
+    if (tb && tb->tbl_dbm) {
+#ifdef HAS_GDBM
+	gdbm_close(tb->tbl_dbm);
+	tb->tbl_dbm = 0;
+#else
+#ifdef HAS_NDBM
+	dbm_close(tb->tbl_dbm);
+	tb->tbl_dbm = 0;
+#else
+	/* dbmrefcnt--;  */	/* doesn't work, rats */
+#endif
+#endif
+    }
+    else if (dowarn)
+	warn("Close on unopened dbm file");
+}
+
+bool
+hdbmstore(tb,key,klen,str)
+register HASH *tb;
+char *key;
+unsigned int klen;
+register STR *str;
+{
+    datum dkey, dcontent;
+    int error;
+
+    if (!tb || !tb->tbl_dbm)
+	return FALSE;
+    dkey.dptr = key;
+    dkey.dsize = klen;
+    dcontent.dptr = str_get(str);
+    dcontent.dsize = str->str_cur;
+#ifdef HAS_GDBM
+    error = gdbm_store(tb->tbl_dbm, dkey, dcontent, GDBM_REPLACE);
+#else
+    error = dbm_store(tb->tbl_dbm, dkey, dcontent, DBM_REPLACE);
+#endif
+    if (error) {
+	if (errno == EPERM)
+	    fatal("No write permission to dbm file");
+	warn("dbm store returned %d, errno %d, key \"%s\"",error,errno,key);
+#ifdef HAS_NDBM
+        dbm_clearerr(tb->tbl_dbm);
+#endif
+    }
+    return !error;
+}
+#endif /* SOME_DBM */
diff --git a/gnu/usr.bin/perl/perl/hash.h b/gnu/usr.bin/perl/perl/hash.h
new file mode 100644
index 000000000000..858721f54318
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/hash.h
@@ -0,0 +1,75 @@
+/* $RCSfile: hash.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:37 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:37  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  91/11/05  17:24:31  lwall
+ * patch11: random cleanup
+ * 
+ * Revision 4.0.1.1  91/06/07  11:10:33  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:22:38  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define FILLPCT 80		/* don't make greater than 99 */
+#define DBM_CACHE_MAX 63	/* cache 64 entries for dbm file */
+				/* (resident array acts as a write-thru cache)*/
+
+#define COEFFSIZE (16 * 8)	/* size of coeff array */
+
+typedef struct hentry HENT;
+
+struct hentry {
+    HENT	*hent_next;
+    char	*hent_key;
+    STR		*hent_val;
+    int		hent_hash;
+    int		hent_klen;
+};
+
+struct htbl {
+    HENT	**tbl_array;
+    int		tbl_max;	/* subscript of last element of tbl_array */
+    int		tbl_dosplit;	/* how full to get before splitting */
+    int		tbl_fill;	/* how full tbl_array currently is */
+    int		tbl_riter;	/* current root of iterator */
+    HENT	*tbl_eiter;	/* current entry of iterator */
+    SPAT 	*tbl_spatroot;	/* list of spats for this package */
+    char	*tbl_name;	/* name, if a symbol table */
+#ifdef SOME_DBM
+#ifdef HAS_GDBM
+    GDBM_FILE	tbl_dbm;
+#else
+#ifdef HAS_NDBM
+    DBM		*tbl_dbm;
+#else
+    int		tbl_dbm;
+#endif
+#endif
+#endif
+    unsigned char tbl_coeffsize;	/* is 0 for symbol tables */
+};
+
+STR *hfetch();
+bool hstore();
+STR *hdelete();
+HASH *hnew();
+void hclear();
+void hentfree();
+void hfree();
+int hiterinit();
+HENT *hiternext();
+char *hiterkey();
+STR *hiterval();
+bool hdbmopen();
+void hdbmclose();
+bool hdbmstore();
diff --git a/gnu/usr.bin/perl/perl/malloc.c b/gnu/usr.bin/perl/perl/malloc.c
new file mode 100644
index 000000000000..8bfee4064576
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/malloc.c
@@ -0,0 +1,510 @@
+/* $RCSfile: malloc.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:37 $
+ *
+ * $Log: malloc.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:37  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  14:28:38  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: hash tables now split only if the memory is available to do so
+ * patch20: realloc(0, size) now does malloc in case library routines call it
+ * 
+ * Revision 4.0.1.3  91/11/05  17:57:40  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * 
+ * Revision 4.0.1.2  91/06/07  11:20:45  lwall
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:48:31  lwall
+ * patch1: Configure now figures out malloc ptr type
+ * 
+ * Revision 4.0  91/03/20  01:28:52  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#ifndef lint
+/*SUPPRESS 592*/
+static char sccsid[] = "@(#)malloc.c	4.3 (Berkeley) 9/16/83";
+
+#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"
+
+static findbucket(), morecore();
+
+/* 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 ALIGN_BYTES > 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
+};
+
+#define	MAGIC		0xff		/* magic # on accounting info */
+#define OLDMAGIC	0x7f		/* same after a free() */
+#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 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
+
+#ifdef safemalloc
+static int an = 0;
+#endif
+
+MALLOCPTRTYPE *
+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);
+		exit(1);
+	}
+#endif /* MSDOS */
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+	    fatal("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);
+		    exit(1);
+		}
+#else
+  		return (NULL);
+#endif
+	}
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+    if (debug & 128)
+        fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
+#  else
+    if (debug & 128)
+        fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
+#  endif
+#endif
+#endif /* safemalloc */
+
+	/* remove from linked list */
+#ifdef RCHECK
+	if (*((int*)p) & (sizeof(union overhead) - 1))
+#if !(defined(I286) || defined(atarist))
+	    fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
+#else
+	    fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
+#endif
+#endif
+  	nextf[bucket] = p->ov_next;
+	p->ov_magic = MAGIC;
+	p->ov_index= bucket;
+#ifdef 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 ((MALLOCPTRTYPE *)(p + 1));
+}
+
+/*
+ * Allocate more memory to the indicated bucket.
+ */
+static
+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);
+  	}
+}
+
+void
+free(mp)
+	MALLOCPTRTYPE *mp;
+{   
+  	register MEM_SIZE size;
+	register union overhead *op;
+	char *cp = (char*)mp;
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+	if (debug & 128)
+		fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
+#  else
+	if (debug & 128)
+		fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++);
+#  endif
+#endif
+#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) {
+		warn("%s free() ignored",
+		    op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
+		return;				/* sanity */
+	}
+	op->ov_magic = OLDMAGIC;
+#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);
+#endif
+  	ASSERT(op->ov_index < NBUCKETS);
+  	size = op->ov_index;
+	op->ov_next = nextf[size];
+  	nextf[size] = op;
+#ifdef 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 */
+
+MALLOCPTRTYPE *
+realloc(mp, nbytes)
+	MALLOCPTRTYPE *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);
+		exit(1);
+	}
+#endif /* MSDOS */
+	if (!cp)
+		return malloc(nbytes);
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+		fatal("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 !(defined(I286) || defined(atarist))
+	if (debug & 128) {
+	    fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
+	    fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
+	}
+#  else
+	if (debug & 128) {
+	    fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
+	    fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
+	}
+#  endif
+#endif
+#endif /* safemalloc */
+  	return ((MALLOCPTRTYPE*)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 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
+mstats(s)
+	char *s;
+{
+  	register int i, j;
+  	register union overhead *p;
+  	int totfree = 0,
+  	totused = 0;
+
+  	fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
+  	for (i = 0; i < NBUCKETS; i++) {
+  		for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+  			;
+  		fprintf(stderr, " %d", j);
+  		totfree += j * (1 << (i + 3));
+  	}
+  	fprintf(stderr, "\nused:\t");
+  	for (i = 0; i < NBUCKETS; i++) {
+  		fprintf(stderr, " %d", nmalloc[i]);
+  		totused += nmalloc[i] * (1 << (i + 3));
+  	}
+  	fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
+	    totused, totfree);
+}
+#endif
+#endif /* lint */
diff --git a/gnu/usr.bin/perl/perl/patchlevel.h b/gnu/usr.bin/perl/perl/patchlevel.h
new file mode 100644
index 000000000000..d248b3566e5e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/patchlevel.h
@@ -0,0 +1 @@
+#define PATCHLEVEL 36
diff --git a/gnu/usr.bin/perl/perl/perl.1 b/gnu/usr.bin/perl/perl/perl.1
new file mode 100644
index 000000000000..d074e74d839a
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/perl.1
@@ -0,0 +1,6010 @@
+.rn '' }`
+''' $RCSfile: perl.man,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:37 $
+''' 
+''' $Log: perl.man,v $
+.\" Revision 1.1.1.1  1993/08/23  21:29:37  nate
+.\" PERL!
+.\"
+''' Revision 4.0.1.6  92/06/08  15:07:29  lwall
+''' patch20: documented that numbers may contain underline
+''' patch20: clarified that DATA may only be read from main script
+''' patch20: relaxed requirement for semicolon at the end of a block
+''' patch20: added ... as variant on ..
+''' patch20: documented need for 1; at the end of a required file
+''' patch20: extended bracket-style quotes to two-arg operators: s()() and tr()()
+''' patch20: paragraph mode now skips extra newlines automatically
+''' patch20: documented PERLLIB and PERLDB
+''' patch20: documented limit on size of regexp
+''' 
+''' Revision 4.0.1.5  91/11/11  16:42:00  lwall
+''' patch19: added little-endian pack/unpack options
+''' 
+''' Revision 4.0.1.4  91/11/05  18:11:05  lwall
+''' patch11: added sort {} LIST
+''' patch11: added eval {}
+''' patch11: documented meaning of scalar(%foo)
+''' patch11: sprintf() now supports any length of s field
+''' 
+''' Revision 4.0.1.3  91/06/10  01:26:02  lwall
+''' patch10: documented some newer features in addenda
+''' 
+''' Revision 4.0.1.2  91/06/07  11:41:23  lwall
+''' patch4: added global modifier for pattern matches
+''' patch4: default top-of-form format is now FILEHANDLE_TOP
+''' patch4: added $^P variable to control calling of perldb routines
+''' patch4: added $^F variable to specify maximum system fd, default 2
+''' patch4: changed old $^P to $^X
+''' 
+''' Revision 4.0.1.1  91/04/11  17:50:44  lwall
+''' patch1: fixed some typos
+''' 
+''' Revision 4.0  91/03/20  01:38:08  lwall
+''' 4.0 baseline.
+''' 
+''' 
+.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 PERL 1 "\*(RP"
+.UC
+.SH NAME
+perl \- Practical Extraction and Report Language
+.SH SYNOPSIS
+.B perl
+[options] filename args
+.SH DESCRIPTION
+.I 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).
+It combines (in the author's opinion, anyway) some of the best features of C,
+\fIsed\fR, \fIawk\fR, and \fIsh\fR,
+so people familiar with those languages should have little difficulty with it.
+(Language historians will also note some vestiges of \fIcsh\fR, Pascal, and
+even BASIC-PLUS.)
+Expression syntax corresponds quite closely to C expression syntax.
+Unlike most Unix utilities,
+.I perl
+does not arbitrarily limit the size of your data\*(--if you've got
+the memory,
+.I 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.
+.I Perl
+uses sophisticated pattern matching techniques to scan large amounts of
+data very quickly.
+Although optimized for scanning text,
+.I perl
+can also deal with binary data, and can make dbm files look like associative
+arrays (where dbm is available).
+Setuid
+.I 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 \fIsed\fR
+or \fIawk\fR or \fIsh\fR, but it
+exceeds their capabilities or must run a little faster,
+and you don't want to write the silly thing in C, then
+.I perl
+may be for you.
+There are also translators to turn your
+.I sed
+and
+.I awk
+scripts into
+.I perl
+scripts.
+OK, enough hype.
+.PP
+Upon startup,
+.I perl
+looks for your script in one of the following places:
+.Ip 1. 4 2
+Specified line by line via
+.B \-e
+switches on the command line.
+.Ip 2. 4 2
+Contained in the file specified by the first filename on the command line.
+(Note that systems supporting the #! notation invoke interpreters this way.)
+.Ip 3. 4 2
+Passed in implicitly via standard input.
+This only works if there are no filename arguments\*(--to pass
+arguments to a
+.I stdin
+script you must explicitly specify a \- for the script name.
+.PP
+After locating your script,
+.I perl
+compiles it to an internal form.
+If the script is syntactically correct, it is executed.
+.Sh "Options"
+Note: on first reading this section may not make much sense to you.  It's here
+at the front for easy reference.
+.PP
+A single-character option may be combined with the following option, if any.
+This is particularly useful when invoking a script using the #! construct which
+only allows one argument.  Example:
+.nf
+
+.ne 2
+	#!/usr/bin/perl \-spi.bak	# same as \-s \-p \-i.bak
+	.\|.\|.
+
+.fi
+Options include:
+.TP 5
+.BI \-0 digits
+specifies the record separator ($/) 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
+.I find
+which can print filenames terminated by the null character, you can say this:
+.nf
+
+    find . \-name '*.bak' \-print0 | perl \-n0e unlink
+
+.fi
+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.
+.TP 5
+.B \-a
+turns on autosplit mode when used with a
+.B \-n
+or
+.BR \-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
+.BR \-p .
+.nf
+
+	perl \-ane \'print pop(@F), "\en";\'
+
+is equivalent to
+
+	while (<>) {
+		@F = split(\' \');
+		print pop(@F), "\en";
+	}
+
+.fi
+.TP 5
+.B \-c
+causes
+.I perl
+to check the syntax of the script and then exit without executing it.
+.TP 5
+.BI \-d
+runs the script under the perl debugger.
+See the section on Debugging.
+.TP 5
+.BI \-D number
+sets debugging flags.
+To watch how it executes your script, use
+.BR \-D14 .
+(This only works if debugging is compiled into your
+.IR perl .)
+Another nice value is \-D1024, which lists your compiled syntax tree.
+And \-D512 displays compiled regular expressions.
+.TP 5
+.BI \-e " commandline"
+may be used to enter one line of script.
+Multiple
+.B \-e
+commands may be given to build up a multi-line script.
+If
+.B \-e
+is given,
+.I perl
+will not look for a script filename in the argument list.
+.TP 5
+.BI \-i extension
+specifies that files processed by the <> construct are to be edited
+in-place.
+It does this by renaming the input file, opening the output file by the
+same 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.
+Saying \*(L"perl \-p \-i.bak \-e "s/foo/bar/;" .\|.\|. \*(R" is the same as using
+the script:
+.nf
+
+.ne 2
+	#!/usr/bin/perl \-pi.bak
+	s/foo/bar/;
+
+which is equivalent to
+
+.ne 14
+	#!/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);
+
+.fi
+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
+.I STDOUT
+is restored as the default output filehandle after the loop.
+.Sp
+You can use eof to locate the end of each input file, in case you want
+to append to each file, or reset line numbering (see example under eof).
+.TP 5
+.BI \-I directory
+may be used in conjunction with
+.B \-P
+to tell the C preprocessor where to look for include files.
+By default /usr/include and /usr/lib/perl are searched.
+.TP 5
+.BI \-l octnum
+enables automatic line-ending processing.  It has two effects:
+first, it automatically chops the line terminator when used with
+.B \-n
+or
+.B \-p ,
+and second, it assigns $\e 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 $\e to the current value of $/.
+For instance, to trim lines to 80 columns:
+.nf
+
+	perl -lpe \'substr($_, 80) = ""\'
+
+.fi
+Note that the assignment $\e = $/ 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:
+.nf
+
+	gnufind / -print0 | perl -ln0e 'print "found $_" if -p'
+
+.fi
+This sets $\e to newline and then sets $/ to the null character.
+.TP 5
+.B \-n
+causes
+.I perl
+to assume the following loop around your script, which makes it iterate
+over filename arguments somewhat like \*(L"sed \-n\*(R" or \fIawk\fR:
+.nf
+
+.ne 3
+	while (<>) {
+		.\|.\|.		# your script goes here
+	}
+
+.fi
+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:
+.nf
+
+	find . \-mtime +7 \-print | perl \-nle \'unlink;\'
+
+.fi
+This is faster than using the \-exec switch of find because you don't have to
+start a process on every filename found.
+.TP 5
+.B \-p
+causes
+.I perl
+to assume the following loop around your script, which makes it iterate
+over filename arguments somewhat like \fIsed\fR:
+.nf
+
+.ne 5
+	while (<>) {
+		.\|.\|.		# your script goes here
+	} continue {
+		print;
+	}
+
+.fi
+Note that the lines are printed automatically.
+To suppress printing use the
+.B \-n
+switch.
+A
+.B \-p
+overrides a
+.B \-n
+switch.
+.TP 5
+.B \-P
+causes your script to be run through the C preprocessor before
+compilation by
+.IR 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 \*(L"if\*(R", \*(L"else\*(R" or \*(L"define\*(R".)
+.TP 5
+.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 \-\|\-).
+Any switch found there is removed from @ARGV and sets the corresponding variable in the
+.I perl
+script.
+The following script prints \*(L"true\*(R" if and only if the script is
+invoked with a \-xyz switch.
+.nf
+
+.ne 2
+	#!/usr/bin/perl \-s
+	if ($xyz) { print "true\en"; }
+
+.fi
+.TP 5
+.B \-S
+makes
+.I 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:
+.nf
+
+	#!/usr/bin/perl
+	eval "exec /usr/bin/perl \-S $0 $*"
+		if $running_under_some_shell;
+
+.fi
+The system ignores the first line and feeds the script to /bin/sh,
+which proceeds to try to execute the
+.I perl
+script as a shell script.
+The shell executes the second line as a normal shell command, and thus
+starts up the
+.I perl
+interpreter.
+On some systems $0 doesn't always contain the full pathname,
+so the
+.B \-S
+tells
+.I perl
+to search for the script if necessary.
+After
+.I 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 $* would be ${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:
+.nf
+
+.ne 3
+	eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	& eval 'exec /usr/bin/perl -S $0 $argv:q'
+		if 0;
+
+.fi
+.TP 5
+.B \-u
+causes
+.I 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 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 are going to run your executable as a set-id program then you
+should probably compile it using taintperl rather than normal perl.
+If you want to execute a portion of your script before dumping, use the
+dump operator instead.
+Note: availability of undump is platform specific and may not be available
+for a specific port of perl.
+.TP 5
+.B \-U
+allows
+.I perl
+to do unsafe operations.
+Currently the only \*(L"unsafe\*(R" operations are the unlinking of directories while
+running as superuser, and running setuid programs with fatal taint checks
+turned into warnings.
+.TP 5
+.B \-v
+prints the version and patchlevel of your
+.I perl
+executable.
+.TP 5
+.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 == on values that don't look like numbers, and if
+your subroutines recurse more than 100 deep.
+.TP 5
+.BI \-x directory
+tells
+.I 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 _\|_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).
+.Sh "Data Types and Objects"
+.PP
+.I Perl
+has three data types: scalars, arrays of scalars, and
+associative arrays of scalars.
+Normal arrays are indexed by number, and associative arrays by string.
+.PP
+The interpretation of operations and values in perl sometimes
+depends on the requirements
+of the context around the operation or value.
+There are three major contexts: string, numeric and array.
+Certain operations return array values
+in contexts wanting an array, and scalar values otherwise.
+(If this is true of an operation it will be mentioned in the documentation
+for that operation.)
+Operations which return scalars don't care whether the context is looking
+for a string or a number, but
+scalar variables and values are interpreted as strings or numbers
+as appropriate to the context.
+A scalar is interpreted as TRUE in the boolean sense if it is not the null
+string or 0.
+Booleans returned by operators are 1 for true and 0 or \'\' (the null
+string) for false.
+.PP
+There are actually two varieties of null string: defined and undefined.
+Undefined null strings 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 string may become defined the first time you access it, but
+prior to that you can use the defined() operator to determine whether the
+value is defined or not.
+.PP
+References to scalar variables always begin with \*(L'$\*(R', even when referring
+to a scalar that is part of an array.
+Thus:
+.nf
+
+.ne 3
+    $days	\h'|2i'# a simple scalar variable
+    $days[28]	\h'|2i'# 29th element of array @days
+    $days{\'Feb\'}\h'|2i'# one value from an associative array
+    $#days	\h'|2i'# last index of array @days
+
+but entire arrays or array slices are denoted by \*(L'@\*(R':
+
+    @days	\h'|2i'# ($days[0], $days[1],\|.\|.\|. $days[n])
+    @days[3,4,5]\h'|2i'# same as @days[3.\|.5]
+    @days{'a','c'}\h'|2i'# same as ($days{'a'},$days{'c'})
+
+and entire associative arrays are denoted by \*(L'%\*(R':
+
+    %days	\h'|2i'# (key1, val1, key2, val2 .\|.\|.)
+.fi
+.PP
+Any of these eight constructs may serve as an lvalue,
+that is, may be assigned to.
+(It also turns out that an assignment is itself an lvalue in
+certain contexts\*(--see examples under s, tr and chop.)
+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 an array context.
+.PP
+You may find the length of array @days by evaluating
+\*(L"$#days\*(R", as in
+.IR 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 $#days changes the length of the array.
+Shortening an array by this method does not actually destroy any values.
+Lengthening an array that was previously shortened recovers the values that
+were in those elements.
+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.
+This differs from assigning to $#whatever in that intervening values
+are set to null rather than recovered.)
+You can truncate an array down to nothing by assigning the null list () to
+it.
+The following are exactly equivalent
+.nf
+
+	@whatever = ();
+	$#whatever = $[ \- 1;
+
+.fi
+.PP
+If you evaluate an array in a scalar context, it returns the length of
+the array.
+The following is always true:
+.nf
+
+	scalar(@whatever) == $#whatever \- $[ + 1;
+
+.fi
+If you evaluate an associative array in a scalar context, it returns
+a value which is true if and only if the array contains any elements.
+(If there are any elements, the value returned is a string consisting
+of the number of used buckets and the number of allocated buckets, separated
+by a slash.)
+.PP
+Multi-dimensional arrays are not directly supported, but see the discussion
+of the $; variable later for a means of emulating multiple subscripts with
+an associative array.
+You could also write a subroutine to turn multiple subscripts into a single
+subscript.
+.PP
+Every data type has its own namespace.
+You can, without fear of conflict, use the same name for a scalar variable,
+an array, an associative array, a filehandle, a subroutine name, and/or
+a label.
+Since variable and array references always start with \*(L'$\*(R', \*(L'@\*(R',
+or \*(L'%\*(R', the \*(L"reserved\*(R" 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.
+Hint: you could say open(LOG,\'logfile\') rather than open(log,\'logfile\').
+Using uppercase filehandles also improves readability and protects you
+from conflict with future reserved words.)
+Case IS significant\*(--\*(L"FOO\*(R", \*(L"Foo\*(R" and \*(L"foo\*(R" are all
+different names.
+Names which start with a letter may also contain digits and underscores.
+Names which do not start with a letter are limited to one character,
+e.g. \*(L"$%\*(R" or \*(L"$$\*(R".
+(Most of the one character names have a predefined significance to
+.IR perl .
+More later.)
+.PP
+Numeric literals are specified in any of the usual floating point or
+integer formats:
+.nf
+
+.ne 6
+    12345
+    12345.67
+    .23E-10
+    0xffff	# hex
+    0377	# octal
+    4_294_967_296
+
+.fi
+String literals are 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 \e\' and \e\e).
+The usual backslash rules apply for making characters such as newline, tab,
+etc., as well as some more exotic forms:
+.nf
+
+	\et		tab
+	\en		newline
+	\er		return
+	\ef		form feed
+	\eb		backspace
+	\ea		alarm (bell)
+	\ee		escape
+	\e033		octal char
+	\ex1b		hex char
+	\ec[		control char
+	\el		lowercase next char
+	\eu		uppercase next char
+	\eL		lowercase till \eE
+	\eU		uppercase till \eE
+	\eE		end case modification
+
+.fi
+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
+.I 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, normal
+array values, 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 \*(L"The price is $100.\*(R"
+.nf
+
+.ne 2
+    $Price = \'$100\';\h'|3.5i'# not interpreted
+    print "The price is $Price.\e\|n";\h'|3.5i'# interpreted
+
+.fi
+Note that you can put curly brackets around the identifier to delimit it
+from following alphanumerics.
+Also note that a single quoted string must be separated from a preceding
+word by a space, since single quote is a valid character in an identifier
+(see Packages).
+.PP
+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_\|_.
+.PP
+A word that doesn't have any other interpretation in the grammar will be
+treated as if it had single quotes around it.
+For this purpose, a word consists only of alphanumeric characters and underline,
+and must start with an alphabetic character.
+As with filehandles and labels, a bare word 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.
+.PP
+Array values are interpolated into double-quoted strings by joining all the
+elements of the array with the delimiter specified in the $" variable,
+space by default.
+(Since in versions of perl prior to 3.0 the @ character was not a metacharacter
+in double-quoted strings, the interpolation of @array, $array[EXPR],
+@array[LIST], $array{EXPR}, or @array{LIST} only happens if array is
+referenced elsewhere in the program or is predefined.)
+The following are equivalent:
+.nf
+
+.ne 4
+	$temp = join($",@ARGV);
+	system "echo $temp";
+
+	system "echo @ARGV";
+
+.fi
+Within search patterns (which also undergo double-quotish substitution)
+there is a bad ambiguity:  Is /$foo[bar]/ to be
+interpreted as /${foo}[bar]/ (where [bar] is a character class for the
+regular expression) or as /${foo[bar]}/ (where [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 [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.
+.PP
+A line-oriented form of quoting is based on the shell here-is syntax.
+Following a << 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 << 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\*(--see Merry Christmas example below.)
+The terminating string must appear by itself (unquoted and with no surrounding
+whitespace) on the terminating line.
+.nf
+
+	print <<EOF;		# same as above
+The price is $Price.
+EOF
+
+	print <<"EOF";		# same as above
+The price is $Price.
+EOF
+
+	print << x 10;		# null identifier is delimiter
+Merry Christmas!
+
+	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
+
+.fi
+Array literals are denoted by separating individual values by commas, and
+enclosing the list in parentheses:
+.nf
+
+	(LIST)
+
+.fi
+In a context not requiring an array value, the value of the array literal
+is the value of the final element, as in the C comma operator.
+For example,
+.nf
+
+.ne 4
+    @foo = (\'cc\', \'\-E\', $bar);
+
+assigns the entire array value to array foo, but
+
+    $foo = (\'cc\', \'\-E\', $bar);
+
+.fi
+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:
+.nf
+
+.ne 2
+    @foo = (\'cc\', \'\-E\', $bar);
+    $foo = @foo;		# $foo gets 3
+
+.fi
+You may have an optional comma before the closing parenthesis of an
+array literal, so that you can say:
+.nf
+
+    @foo = (
+	1,
+	2,
+	3,
+    );
+
+.fi
+When a LIST is evaluated, each element of the list is evaluated in
+an array context, and the resulting array 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.
+.PP
+A list value may also be subscripted like a normal array.
+Examples:
+.nf
+
+	$time = (stat($file))[8];	# stat returns array value
+	$digit = ('a','b','c','d','e','f')[$digit-10];
+	return (pop(@foo),pop(@foo))[0];
+
+.fi
+.PP
+Array lists may be assigned to if and only if each element of the list
+is an lvalue:
+.nf
+
+    ($a, $b, $c) = (1, 2, 3);
+
+    ($map{\'red\'}, $map{\'blue\'}, $map{\'green\'}) = (0x00f, 0x0f0, 0xf00);
+
+The final element may be an array or an associative array:
+
+    ($a, $b, @rest) = split;
+    local($a, $b, %rest) = @_;
+
+.fi
+You can actually put an array anywhere in the list, but the first array
+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().
+.PP
+An associative array literal contains pairs of values to be interpreted
+as a key and a value:
+.nf
+
+.ne 2
+    # same as map assignment above
+    %map = ('red',0x00f,'blue',0x0f0,'green',0xf00);
+
+.fi
+Array assignment in a scalar context returns the number of elements
+produced by the expression on the right side of the assignment:
+.nf
+
+	$x = (($foo,$bar) = (3,2,1));	# set $x to 3, not 2
+
+.fi
+.PP
+There are several other pseudo-literals that you should know about.
+If a string is enclosed by backticks (grave accents), it 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 an array context, an array of values is returned, one for each line
+of output.
+(You can set $/ 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 $? (see Predefined Names
+for the interpretation of $?).
+Unlike in \f2csh\f1, 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.
+.PP
+Evaluating a filehandle in angle brackets yields the next line
+from that file (newline included, so it's never false until EOF, 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.
+If (and only if) the input symbol is the only thing inside the conditional of a
+.I while
+loop, the value is
+automatically assigned to the variable \*(L"$_\*(R".
+(This may seem like an odd thing to you, but you'll use the construct
+in almost every
+.I perl
+script you write.)
+Anyway, the following lines are equivalent to each other:
+.nf
+
+.ne 5
+    while ($_ = <STDIN>) { print; }
+    while (<STDIN>) { print; }
+    for (\|;\|<STDIN>;\|) { print; }
+    print while $_ = <STDIN>;
+    print while <STDIN>;
+
+.fi
+The filehandles
+.IR STDIN ,
+.I STDOUT
+and
+.I STDERR
+are predefined.
+(The filehandles
+.IR stdin ,
+.I stdout
+and
+.I 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
+.I open
+function.
+.PP
+If a <FILEHANDLE> is used in a context that is looking for an array, an array
+consisting of all the input lines is returned, one line per array element.
+It's easy to make a LARGE data space this way, so use with care.
+.PP
+The null filehandle <> is special and can be used to emulate the behavior of
+\fIsed\fR and \fIawk\fR.
+Input from <> comes either from standard input, or from each file listed on
+the command line.
+Here's how it works: the first time <> is evaluated, the ARGV array is checked,
+and if it is null, $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
+.nf
+
+.ne 3
+	while (<>) {
+		.\|.\|.			# code for each line
+	}
+
+.ne 10
+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
+		}
+	}
+
+.fi
+except that it isn't as 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 ARGV internally\*(--<> is just a synonym for
+<ARGV>, which is magical.
+(The pseudo code above doesn't work because it treats <ARGV> as non-magical.)
+.PP
+You can modify @ARGV before the first <> as long as the array ends up
+containing the list of filenames you really want.
+Line numbers ($.) continue as if the input was one big happy file.
+(But see example under eof for how to reset line numbers on each file.)
+.PP
+.ne 5
+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
+put a loop on the front like this:
+.nf
+
+.ne 10
+	while ($_ = $ARGV[0], /\|^\-/\|) {
+		shift;
+	    last if /\|^\-\|\-$\|/\|;
+		/\|^\-D\|(.*\|)/ \|&& \|($debug = $1);
+		/\|^\-v\|/ \|&& \|$verbose++;
+		.\|.\|.		# other switches
+	}
+	while (<>) {
+		.\|.\|.		# code for each line
+	}
+
+.fi
+The <> 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
+.IR STDIN .
+.PP
+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.
+.PP
+If the string inside angle brackets is not a filehandle, it is interpreted
+as a filename pattern to be globbed, and either an array 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 <$foo>
+because that's an indirect filehandle as explained in the previous
+paragraph.
+You could insert curly brackets to force interpretation as a
+filename glob: <${foo}>.
+Example:
+.nf
+
+.ne 3
+	while (<*.c>) {
+		chmod 0644, $_;
+	}
+
+is equivalent to
+
+.ne 5
+	open(foo, "echo *.c | tr \-s \' \et\er\ef\' \'\e\e012\e\e012\e\e012\e\e012\'|");
+	while (<foo>) {
+		chop;
+		chmod 0644, $_;
+	}
+
+.fi
+In fact, it's currently implemented that way.
+(Which means it will not work on filenames with spaces in them unless
+you have /bin/csh on your machine.)
+Of course, the shortest way to do the above is:
+.nf
+
+	chmod 0644, <*.c>;
+
+.fi
+.Sh "Syntax"
+.PP
+A
+.I perl
+script consists of a sequence of declarations and commands.
+The only things that need to be declared in
+.I 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.
+The sequence of commands is executed just once, unlike in
+.I sed
+and
+.I awk
+scripts, where the sequence of commands 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.)
+.PP
+A declaration can be put anywhere a command can, but has no effect on the
+execution of the primary sequence of commands\*(--declarations all take effect
+at compile time.
+Typically all the declarations are put at the beginning or the end of the script.
+.PP
+.I Perl
+is, for the most part, a free-form language.
+(The only exception to this is format declarations, for fairly obvious reasons.)
+Comments are indicated by the # character, and extend to the end of the line.
+If you attempt to use /* */ C comments, it will be interpreted either as
+division or pattern matching, depending on the context.
+So don't do that.
+.Sh "Compound statements"
+In
+.IR perl ,
+a sequence of commands may be treated as one command by enclosing it
+in curly brackets.
+We will call this a BLOCK.
+.PP
+The following compound commands may be used to control flow:
+.nf
+
+.ne 4
+	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 (ARRAY) BLOCK
+	LABEL BLOCK continue BLOCK
+
+.fi
+Note that, unlike C and Pascal, these are defined in terms of BLOCKs, not
+statements.
+This means that the curly brackets are \fIrequired\fR\*(--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:
+.nf
+
+.ne 5
+	if (!open(foo)) { die "Can't open $foo: $!"; }
+	die "Can't open $foo: $!" unless open(foo);
+	open(foo) || die "Can't open $foo: $!";	# foo or bust!
+	open(foo) ? \'hi mom\' : die "Can't open $foo: $!";
+				# a bit exotic, that last one
+
+.fi
+.PP
+The
+.I if
+statement is straightforward.
+Since BLOCKs are always bounded by curly brackets, there is never any
+ambiguity about which
+.I if
+an
+.I else
+goes with.
+If you use
+.I unless
+in place of
+.IR if ,
+the sense of the test is reversed.
+.PP
+The
+.I while
+statement executes the block as long as the expression is true
+(does not evaluate to the null string 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
+.IR next ,
+.IR last ,
+and
+.I redo
+(see below).
+If there is a
+.I continue
+BLOCK, it is always executed just before
+the conditional is about to be evaluated again, similarly to the third part
+of a
+.I for
+loop in C.
+Thus it can be used to increment a loop variable, even when the loop has
+been continued via the
+.I next
+statement (similar to the C \*(L"continue\*(R" statement).
+.PP
+If the word
+.I while
+is replaced by the word
+.IR until ,
+the sense of the test is reversed, but the conditional is still tested before
+the first iteration.
+.PP
+In either the
+.I if
+or the
+.I while
+statement, you may replace \*(L"(EXPR)\*(R" with a BLOCK, and the conditional
+is true if the value of the last command in that block is true.
+.PP
+The
+.I for
+loop works exactly like the corresponding
+.I while
+loop:
+.nf
+
+.ne 12
+	for ($i = 1; $i < 10; $i++) {
+		.\|.\|.
+	}
+
+is the same as
+
+	$i = 1;
+	while ($i < 10) {
+		.\|.\|.
+	} continue {
+		$i++;
+	}
+.fi
+.PP
+The foreach loop iterates over a normal array value and sets the variable
+VAR to be each element of the array in turn.
+The variable is implicitly local to the loop, and regains its former value
+upon exiting the loop.
+The \*(L"foreach\*(R" keyword is actually identical to the \*(L"for\*(R" keyword,
+so you can use \*(L"foreach\*(R" for readability or \*(L"for\*(R" for brevity.
+If VAR is omitted, $_ is set to each value.
+If ARRAY is an actual array (as opposed to an expression returning an array
+value), you can modify each element of the array
+by modifying VAR inside the loop.
+Examples:
+.nf
+
+.ne 5
+	for (@ary) { s/foo/bar/; }
+
+	foreach $elem (@elements) {
+		$elem *= 2;
+	}
+
+.ne 3
+	for ((10,9,8,7,6,5,4,3,2,1,\'BOOM\')) {
+		print $_, "\en"; sleep(1);
+	}
+
+	for (1..15) { print "Merry Christmas\en"; }
+
+.ne 3
+	foreach $item (split(/:[\e\e\en:]*/, $ENV{\'TERMCAP\'})) {
+		print "Item: $item\en";
+	}
+
+.fi
+.PP
+The BLOCK by itself (labeled or not) is 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.
+The
+.I continue
+block is optional.
+This construct is particularly nice for doing case structures.
+.nf
+
+.ne 6
+	foo: {
+		if (/^abc/) { $abc = 1; last foo; }
+		if (/^def/) { $def = 1; last foo; }
+		if (/^xyz/) { $xyz = 1; last foo; }
+		$nothing = 1;
+	}
+
+.fi
+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
+.nf
+
+.ne 6
+	foo: {
+		$abc = 1, last foo  if /^abc/;
+		$def = 1, last foo  if /^def/;
+		$xyz = 1, last foo  if /^xyz/;
+		$nothing = 1;
+	}
+
+or
+
+.ne 6
+	foo: {
+		/^abc/ && do { $abc = 1; last foo; };
+		/^def/ && do { $def = 1; last foo; };
+		/^xyz/ && do { $xyz = 1; last foo; };
+		$nothing = 1;
+	}
+
+or
+
+.ne 6
+	foo: {
+		/^abc/ && ($abc = 1, last foo);
+		/^def/ && ($def = 1, last foo);
+		/^xyz/ && ($xyz = 1, last foo);
+		$nothing = 1;
+	}
+
+or even
+
+.ne 8
+	if (/^abc/)
+		{ $abc = 1; }
+	elsif (/^def/)
+		{ $def = 1; }
+	elsif (/^xyz/)
+		{ $xyz = 1; }
+	else
+		{$nothing = 1;}
+
+.fi
+As it happens, these are all optimized internally to a switch structure,
+so perl jumps directly to the desired statement, and you needn't worry
+about perl executing a lot of unnecessary statements when you have a string
+of 50 elsifs, as long as you are testing the same simple scalar variable
+using ==, eq, or pattern matching as above.
+(If you're curious as to whether the optimizer has done this for a particular
+case statement, you can use the \-D1024 switch to list the syntax tree
+before execution.)
+.Sh "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.
+(Semicolon is still encouraged there if the block takes up more than one line).
+.PP
+Any simple statement may optionally be followed by a
+single modifier, just before the terminating semicolon.
+The possible modifiers are:
+.nf
+
+.ne 4
+	if EXPR
+	unless EXPR
+	while EXPR
+	until EXPR
+
+.fi
+The
+.I if
+and
+.I unless
+modifiers have the expected semantics.
+The
+.I while
+and
+.I until
+modifiers also have the expected semantics (conditional evaluated first),
+except when applied to a do-BLOCK or a do-SUBROUTINE command,
+in which case the block executes once before the conditional is evaluated.
+This is so that you can write loops like:
+.nf
+
+.ne 4
+	do {
+		$_ = <STDIN>;
+		.\|.\|.
+	} until $_ \|eq \|".\|\e\|n";
+
+.fi
+(See the
+.I do
+operator below.  Note also that the loop control commands described later will
+NOT work in this construct, since modifiers don't take loop labels.
+Sorry.)
+.Sh "Expressions"
+Since
+.I perl
+expressions work almost exactly like C expressions, only the differences
+will be mentioned here.
+.PP
+Here's what
+.I perl
+has that C doesn't:
+.Ip ** 8 2
+The exponentiation operator.
+.Ip **= 8
+The exponentiation assignment operator.
+.Ip (\|) 8 3
+The null list, used to initialize an array to null.
+.Ip . 8
+Concatenation of two strings.
+.Ip .= 8
+The concatenation assignment operator.
+.Ip eq 8
+String equality (== is numeric equality).
+For a mnemonic just think of \*(L"eq\*(R" as a string.
+(If you are used to the
+.I awk
+behavior of using == for either string or numeric equality
+based on the current form of the comparands, beware!
+You must be explicit here.)
+.Ip ne 8
+String inequality (!= is numeric inequality).
+.Ip lt 8
+String less than.
+.Ip gt 8
+String greater than.
+.Ip le 8
+String less than or equal.
+.Ip ge 8
+String greater than or equal.
+.Ip cmp 8
+String comparison, returning -1, 0, or 1.
+.Ip <=> 8
+Numeric comparison, returning -1, 0, or 1.
+.Ip =~ 8 2
+Certain operations search or modify the string \*(L"$_\*(R" 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 \*(L"$_\*(R".
+The return value indicates the success of the operation.
+(If the right argument is an expression other 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.)
+The precedence of this operator is lower than unary minus and autoincrement/decrement, but higher than everything else.
+.Ip !~ 8
+Just like =~ except the return value is negated.
+.Ip x 8
+The repetition operator.
+Returns a string consisting of the left operand repeated the
+number of times specified by the right operand.
+In an array context, if the left operand is a list in parens, it repeats
+the list.
+.nf
+
+	print \'\-\' x 80;		# print row of dashes
+	print \'\-\' x80;		# illegal, x80 is identifier
+
+	print "\et" x ($tab/8), \' \' x ($tab%8);	# tab over
+
+	@ones = (1) x 80;		# an array of 80 1's
+	@ones = (5) x @ones;		# set all elements to 5
+
+.fi
+.Ip x= 8
+The repetition assignment operator.
+Only works on scalars.
+.Ip .\|. 8
+The range operator, which is really two different operators depending
+on the context.
+In an array context, returns an array of values counting (by ones)
+from the left value to the right value.
+This is useful for writing \*(L"for (1..10)\*(R" loops and for doing
+slice operations on arrays.
+.Sp
+In a scalar context, .\|. returns a boolean value.
+The operator is bistable, like a flip-flop, and
+emulates the line-range (comma) operator of sed, 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,
+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 awk), but it still returns true once.
+If you don't want it to test the right operand till the next
+evaluation (as in sed), use three dots (.\|.\|.) instead of two.)
+The right operand is not evaluated while the operator is in the \*(L"false\*(R" state,
+and the left operand is not evaluated while the operator is in the \*(L"true\*(R" 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 static, that operand is implicitly compared
+to the $. variable, the current line number.
+Examples:
+.nf
+
+.ne 6
+As a scalar operator:
+    if (101 .\|. 200) { print; }	# print 2nd hundred lines
+
+    next line if (1 .\|. /^$/);	# skip header lines
+
+    s/^/> / if (/^$/ .\|. eof());	# quote body
+
+.ne 4
+As an array operator:
+    for (101 .\|. 200) { print; }	# print $_ 100 times
+
+    @foo = @foo[$[ .\|. $#foo];	# an expensive no-op
+    @foo = @foo[$#foo-4 .\|. $#foo];	# slice last 5 items
+
+.fi
+.Ip \-x 8
+A file test.
+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 \-t, which tests
+.IR STDIN .
+It returns 1 for true and \'\' for false, or the undefined value if the
+file doesn't exist.
+Precedence is higher than logical and relational operators, but lower than
+arithmetic operators.
+The operator may be any of:
+.nf
+	\-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.
+	\-u	File has setuid bit set.
+	\-g	File has setgid bit set.
+	\-k	File has sticky bit set.
+	\-t	Filehandle is opened to a tty.
+	\-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.
+
+.fi
+The interpretation of the file permission operators \-r, \-R, \-w, \-W, \-x and \-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, \-r, \-R, \-w and \-W always return 1, and 
+\-x and \-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.
+.Sp
+Example:
+.nf
+.ne 7
+	
+	while (<>) {
+		chop;
+		next unless \-f $_;	# ignore specials
+		.\|.\|.
+	}
+
+.fi
+Note that \-s/a/b/ does not do a negated substitution.
+Saying \-exp($foo) still works as expected, however\*(--only single letters
+following a minus are interpreted as file tests.
+.Sp
+The \-T and \-B switches work as follows.
+The first block or so of the file is examined for odd characters such as
+strange control codes or metacharacters.
+If too many odd characters (>10%) are found, it's a \-B file, otherwise it's a \-T file.
+Also, any file containing null in the first block is considered a binary file.
+If \-T or \-B is used on a filehandle, the current stdio buffer is examined
+rather than the first block.
+Both \-T and \-B return TRUE on a null file, or a file at EOF when testing
+a filehandle.
+.PP
+If any of the file tests (or either stat operator) 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 \-t, and you need to remember that lstat and -l
+will leave values in the stat structure for the symbolic link, not the
+real file.)
+Example:
+.nf
+
+	print "Can do.\en" if -r $a || -w _ || -x _;
+
+.ne 9
+	stat($filename);
+	print "Readable\en" if -r _;
+	print "Writable\en" if -w _;
+	print "Executable\en" if -x _;
+	print "Setuid\en" if -u _;
+	print "Setgid\en" if -g _;
+	print "Sticky\en" if -k _;
+	print "Text\en" if -T _;
+	print "Binary\en" if -B _;
+
+.fi
+.PP
+Here is what C has that
+.I perl
+doesn't:
+.Ip "unary &" 12
+Address-of operator.
+.Ip "unary *" 12
+Dereference-address operator.
+.Ip "(TYPE)" 12
+Type casting operator.
+.PP
+Like C,
+.I 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
+.nf
+
+.ne 2
+	\'Now is the time for all\' . "\|\e\|n" .
+	\'good men to come to.\'
+
+.fi
+and this all reduces to one string internally.
+.PP
+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 /^[a\-zA\-Z]*[0\-9]*$/, the increment is done
+as a string, preserving each character within its range, with carry:
+.nf
+
+	print ++($foo = \'99\');	# prints \*(L'100\*(R'
+	print ++($foo = \'a0\');	# prints \*(L'a1\*(R'
+	print ++($foo = \'Az\');	# prints \*(L'Ba\*(R'
+	print ++($foo = \'zz\');	# prints \*(L'aaa\*(R'
+
+.fi
+The autodecrement is not magical.
+.PP
+The range operator (in an array context) makes use of the magical
+autoincrement algorithm if the minimum and maximum 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.)
+.PP
+The || and && operators differ from C's in that, rather than returning 0 or 1,
+they return the last value evaluated. 
+Thus, a portable way to find out the home directory might be:
+.nf
+
+	$home = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
+	    (getpwuid($<))[7] || die "You're homeless!\en";
+
+.fi
+.PP
+Along with the literals and variables mentioned earlier,
+the operations in the following section can serve as terms in an expression.
+Some of these operations take a LIST as an argument.
+Such a list can consist of any combination of scalar arguments or array values;
+the array 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
+array value.
+Elements of the LIST should be separated by commas.
+If an operation is listed both with and without parentheses around its
+arguments, it means you can either use it as a unary operator or
+as a function call.
+To use it as a function call, the next token on the same line must
+be a left parenthesis.
+(There may be intervening white space.)
+Such a function then has highest precedence, as you would expect from
+a function.
+If any token other than a left parenthesis follows, then it is a
+unary operator, with a precedence depending only on whether it is a LIST
+operator or not.
+LIST operators have lowest precedence.
+All other unary operators have a precedence greater than relational operators
+but less than arithmetic operators.
+See the section on Precedence.
+.PP
+For operators that can be used in either a scalar or array context,
+failure is generally indicated in a scalar context by returning
+the undefined value, and in an array context by returning the null list.
+Remember though that
+THERE IS NO GENERAL RULE FOR CONVERTING A LIST INTO A SCALAR.
+Each operator decides which sort of scalar it would be most
+appropriate to return.
+Some operators return the length of the list
+that would have been returned in an array 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.
+.Ip "/PATTERN/" 8 4
+See m/PATTERN/.
+.Ip "?PATTERN?" 8 4
+This is just like the /pattern/ search, except that it matches only once between
+calls to the
+.I 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 ?? patterns local to the current package are reset.
+.Ip "accept(NEWSOCKET,GENERICSOCKET)" 8 2
+Does the same thing that the accept system call does.
+Returns true if it succeeded, false otherwise.
+See example in section on Interprocess Communication.
+.Ip "alarm(SECONDS)" 8 4
+.Ip "alarm SECONDS" 8
+Arranges to have a SIGALRM delivered to this process after the specified number
+of seconds (minus 1, actually) have elapsed.  Thus, alarm(15) will cause
+a SIGALRM at some point more than 14 seconds in the future.
+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.
+.Ip "atan2(Y,X)" 8 2
+Returns the arctangent of Y/X in the range
+.if t \-\(*p to \(*p.
+.if n \-PI to PI.
+.Ip "bind(SOCKET,NAME)" 8 2
+Does the same thing that the bind system call does.
+Returns true if it succeeded, false otherwise.
+NAME should be a packed address of the proper type for the socket.
+See example in section on Interprocess Communication.
+.Ip "binmode(FILEHANDLE)" 8 4
+.Ip "binmode FILEHANDLE" 8 4
+Arranges for the file to be read in \*(L"binary\*(R" mode in operating systems
+that distinguish between binary and text files.
+Files that are not read 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.
+If FILEHANDLE is an expression, the value is taken as the name of
+the filehandle.
+.Ip "caller(EXPR)"
+.Ip "caller"
+Returns the context of the current subroutine call:
+.nf
+
+	($package,$filename,$line) = caller;
+
+.fi
+With EXPR, 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.
+.Ip "chdir(EXPR)" 8 2
+.Ip "chdir EXPR" 8 2
+Changes the working directory to EXPR, if possible.
+If EXPR is omitted, changes to home directory.
+Returns 1 upon success, 0 otherwise.
+See example under
+.IR die .
+.Ip "chmod(LIST)" 8 2
+.Ip "chmod LIST" 8 2
+Changes the permissions of a list of files.
+The first element of the list must be the numerical mode.
+Returns the number of files successfully changed.
+.nf
+
+.ne 2
+	$cnt = chmod 0755, \'foo\', \'bar\';
+	chmod 0755, @executables;
+
+.fi
+.Ip "chop(LIST)" 8 7
+.Ip "chop(VARIABLE)" 8
+.Ip "chop VARIABLE" 8
+.Ip "chop" 8
+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 s/\en// because it neither scans nor copies
+the string.
+If VARIABLE is omitted, chops $_.
+Example:
+.nf
+
+.ne 5
+	while (<>) {
+		chop;	# avoid \en on last field
+		@array = split(/:/);
+		.\|.\|.
+	}
+
+.fi
+You can actually chop anything that's an lvalue, including an assignment:
+.nf
+
+	chop($cwd = \`pwd\`);
+	chop($answer = <STDIN>);
+
+.fi
+If you chop a list, each element is chopped.
+Only the value of the last chop is returned.
+.Ip "chown(LIST)" 8 2
+.Ip "chown LIST" 8 2
+Changes the owner (and group) of a list of files.
+The first two elements of the list must be the NUMERICAL uid and gid,
+in that order.
+Returns the number of files successfully changed.
+.nf
+
+.ne 2
+	$cnt = chown $uid, $gid, \'foo\', \'bar\';
+	chown $uid, $gid, @filenames;
+
+.fi
+.ne 23
+Here's an example that looks up non-numeric uids in the passwd file:
+.nf
+
+	print "User: ";
+	$user = <STDIN>;
+	chop($user);
+	print "Files: "
+	$pattern = <STDIN>;
+	chop($pattern);
+.ie t \{\
+	open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
+'br\}
+.el \{\
+	open(pass, \'/etc/passwd\')
+		|| die "Can't open passwd: $!\en";
+'br\}
+	while (<pass>) {
+		($login,$pass,$uid,$gid) = split(/:/);
+		$uid{$login} = $uid;
+		$gid{$login} = $gid;
+	}
+	@ary = <${pattern}>;	# get filenames
+	if ($uid{$user} eq \'\') {
+		die "$user not in passwd file";
+	}
+	else {
+		chown $uid{$user}, $gid{$user}, @ary;
+	}
+
+.fi
+.Ip "chroot(FILENAME)" 8 5
+.Ip "chroot FILENAME" 8
+Does the same as the system call of that name.
+If you don't know what it does, don't worry about it.
+If FILENAME is omitted, does chroot to $_.
+.Ip "close(FILEHANDLE)" 8 5
+.Ip "close FILEHANDLE" 8
+Closes the file or pipe associated with the file handle.
+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
+.IR open .)
+However, an explicit close on an input file resets the line counter ($.), while
+the implicit close done by
+.I 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 $?.
+Example:
+.nf
+
+.ne 4
+	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
+
+.fi
+FILEHANDLE may be an expression whose value gives the real filehandle name.
+.Ip "closedir(DIRHANDLE)" 8 5
+.Ip "closedir DIRHANDLE" 8
+Closes a directory opened by opendir().
+.Ip "connect(SOCKET,NAME)" 8 2
+Does the same thing that the connect system call does.
+Returns true if it succeeded, false otherwise.
+NAME should be a package address of the proper type for the socket.
+See example in section on Interprocess Communication.
+.Ip "cos(EXPR)" 8 6
+.Ip "cos EXPR" 8 6
+Returns the cosine of EXPR (expressed in radians).
+If EXPR is omitted takes cosine of $_.
+.Ip "crypt(PLAINTEXT,SALT)" 8 6
+Encrypts a string exactly like the crypt() function in the C library.
+Useful for checking the password file for lousy passwords.
+Only the guys wearing white hats should do this.
+.Ip "dbmclose(ASSOC_ARRAY)" 8 6
+.Ip "dbmclose ASSOC_ARRAY" 8
+Breaks the binding between a dbm file and an associative array.
+The values remaining in the associative array are meaningless unless
+you happen to want to know what was in the cache for the dbm file.
+This function is only useful if you have ndbm.
+.Ip "dbmopen(ASSOC,DBNAME,MODE)" 8 6
+This binds a dbm or ndbm file to an associative array.
+ASSOC is the name of the associative array.
+(Unlike normal open, the first argument is NOT a filehandle, even though
+it looks like one).
+DBNAME is the name of the database (without the .dir or .pag extension).
+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.
+If your system has neither dbm nor ndbm, calling dbmopen produces a fatal
+error.
+.Sp
+Values assigned to the associative array prior to the dbmopen are lost.
+A certain number of values from the dbm file are cached in memory.
+By default this number is 64, but you can increase it by preallocating
+that number of garbage entries in the associative array before the dbmopen.
+You can flush the cache if necessary with the reset command.
+.Sp
+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.
+.Sp
+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:
+.nf
+
+.ne 6
+	# print out history file offsets
+	dbmopen(HIST,'/usr/lib/news/history',0666);
+	while (($key,$val) = each %HIST) {
+		print $key, ' = ', unpack('L',$val), "\en";
+	}
+	dbmclose(HIST);
+
+.fi
+.Ip "defined(EXPR)" 8 6
+.Ip "defined EXPR" 8
+Returns a boolean value saying whether the lvalue 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 string
+and a defined null string with operations that might return a real null
+string, in particular referencing elements of an array.
+You may also check to see if arrays or subroutines exist.
+Use on predefined variables is not guaranteed to produce intuitive results.
+Examples:
+.nf
+
+.ne 7
+	print if defined $switch{'D'};
+	print "$val\en" 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"; }
+
+.fi
+See also undef.
+.Ip "delete $ASSOC{KEY}" 8 6
+Deletes the specified value from the specified associative array.
+Returns the deleted value, or the undefined value if nothing was deleted.
+Deleting from $ENV{} modifies the environment.
+Deleting from an array bound to a dbm file deletes the entry from the dbm
+file.
+.Sp
+The following deletes all the values of an associative array:
+.nf
+
+.ne 3
+	foreach $key (keys %ARRAY) {
+		delete $ARRAY{$key};
+	}
+
+.fi
+(But it would be faster to use the
+.I reset
+command.
+Saying undef %ARRAY is faster yet.)
+.Ip "die(LIST)" 8
+.Ip "die LIST" 8
+Outside of an eval, prints the value of LIST to
+.I STDERR
+and exits with the current value of $!
+(errno).
+If $! is 0, exits with the value of ($? >> 8) (\`command\` status).
+If ($? >> 8) is 0, exits with 255.
+Inside an eval, the error message is stuffed into $@ and the eval is terminated
+with the undefined value.
+.Sp
+Equivalent examples:
+.nf
+
+.ne 3
+.ie t \{\
+	die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\';
+'br\}
+.el \{\
+	die "Can't cd to spool: $!\en"
+		unless chdir \'/usr/spool/news\';
+'br\}
+
+	chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en" 
+
+.fi
+.Sp
+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 \*(L", stopped\*(R" to your message will cause it to make
+better sense when the string \*(L"at foo line 123\*(R" is appended.
+Suppose you are running script \*(L"canasta\*(R".
+.nf
+
+.ne 7
+	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.
+
+.fi
+See also
+.IR exit .
+.Ip "do BLOCK" 8 4
+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.)
+.Ip "do SUBROUTINE (LIST)" 8 3
+Executes a SUBROUTINE declared by a
+.I sub
+declaration, and returns the value
+of the last expression evaluated in SUBROUTINE.
+If there is no subroutine by that name, produces a fatal error.
+(You may use the \*(L"defined\*(R" operator to determine if a subroutine
+exists.)
+If you pass arrays as part of LIST you may wish to pass the length
+of the array in front of each array.
+(See the section on subroutines later on.)
+The parentheses are required to avoid confusion with the \*(L"do EXPR\*(R"
+form.
+.Sp
+SUBROUTINE may also be a single scalar variable, in which case
+the name of the subroutine to execute is taken from the variable.
+.Sp
+As an alternate (and preferred) form,
+you may call a subroutine by prefixing the name with
+an ampersand: &foo(@args).
+If you aren't passing any arguments, you don't have to use parentheses.
+If you omit the parentheses, no @_ array is passed to the subroutine.
+The & form is also used to specify subroutines to the defined and undef
+operators:
+.nf
+
+	if (defined &$var) { &$var($parm); undef &$var; }
+
+.fi
+.Ip "do EXPR" 8 3
+Uses the value of EXPR as a filename and executes the contents of the file
+as a
+.I perl
+script.
+Its primary use is to include subroutines from a
+.I perl
+subroutine library.
+.nf
+
+	do \'stat.pl\';
+
+is just like
+
+	eval \`cat stat.pl\`;
+
+.fi
+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 Predefined Names).
+It's the same, however, in that it does reparse the file every time you
+call it, so if you are going to use the file inside a loop you might prefer
+to use \-P and #include, at the expense of a little more startup time.
+(The main problem with #include is that cpp doesn't grok # comments\*(--a
+workaround is to use \*(L";#\*(R" for standalone comments.)
+Note that the following are NOT equivalent:
+.nf
+
+.ne 2
+	do $foo;	# eval a file
+	do $foo();	# call a subroutine
+
+.fi
+Note that inclusion of library routines is better done with
+the \*(L"require\*(R" operator.
+.Ip "dump LABEL" 8 6
+This causes an immediate core dump.
+Primarily this is so that you can use the 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 "goto LABEL"
+(with all the restrictions that 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 \-u.
+.Sp
+Example:
+.nf
+
+.ne 16
+	#!/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:
+	do Getopt('f');
+
+.fi
+.Ip "each(ASSOC_ARRAY)" 8 6
+.Ip "each ASSOC_ARRAY" 8
+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 must not modify the array while 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 program, only
+in a different order:
+.nf
+
+.ne 3
+	while (($key,$value) = each %ENV) {
+		print "$key=$value\en";
+	}
+
+.fi
+See also keys() and values().
+.Ip "eof(FILEHANDLE)" 8 8
+.Ip "eof()" 8
+.Ip "eof" 8
+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.)
+An eof without an argument returns the eof status for the last file read.
+Empty parentheses () may be used to indicate the pseudo file formed of the
+files listed on the command line, i.e. eof() is reasonable to use inside
+a while (<>) loop to detect the end of only the last file.
+Use eof(ARGV) or eof without the parentheses to test EACH file in a while (<>) loop.
+Examples:
+.nf
+
+.ne 7
+	# insert dashes just before last line of last file
+	while (<>) {
+		if (eof()) {
+			print "\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\en";
+		}
+		print;
+	}
+
+.ne 7
+	# reset line numbering on each input file
+	while (<>) {
+		print "$.\et$_";
+		if (eof) {	# Not eof().
+			close(ARGV);
+		}
+	}
+
+.fi
+.Ip "eval(EXPR)" 8 6
+.Ip "eval EXPR" 8 6
+.Ip "eval BLOCK" 8 6
+EXPR is parsed and executed as if it were a little
+.I perl
+program.
+It is executed in the context of the current
+.I perl
+program, so that
+any variable settings, subroutine or format definitions remain afterwards.
+The value returned is the value of the last expression evaluated, 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 $@ is set to the error message.
+If there was no error, $@ is guaranteed to be a null string.
+If EXPR is omitted, evaluates $_.
+The final semicolon, if any, may be omitted from the expression.
+.Sp
+Note that, since eval traps otherwise-fatal errors, it is useful for
+determining whether a particular feature
+(such as dbmopen or symlink) is implemented.
+It is also Perl's exception trapping mechanism, where the die operator is
+used to raise exceptions.
+.Sp
+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 $@.
+Evaluating a single-quoted string (as EXPR) has the same effect, except that
+the eval-EXPR form reports syntax errors at run time via $@, whereas the
+eval-BLOCK form reports syntax errors at compile time.  The eval-EXPR form
+is optimized to eval-BLOCK the first time it succeeds.  (Since the replacement
+side of a substitution is considered a single-quoted string when you
+use the e modifier, the same optimization occurs there.)  Examples:
+.nf
+
+.ne 11
+	# make divide-by-zero non-fatal
+	eval { $answer = $a / $b; }; warn $@ if $@;
+
+	# optimized to same thing after first use
+	eval '$answer = $a / $b'; warn $@ if $@;
+
+	# a compile-time error
+	eval { $answer = };
+
+	# a run-time error
+	eval '$answer =';	# sets $@
+
+.fi
+.Ip "exec(LIST)" 8 8
+.Ip "exec LIST" 8 6
+If there is more than one argument in LIST, or if LIST is an array with
+more than one value,
+calls execvp() 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 \*(L"/bin/sh \-c\*(R" 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 $| to avoid lost output.
+Examples:
+.nf
+
+	exec \'/bin/echo\', \'Your arguments are: \', @ARGV;
+	exec "sort $outfile | uniq";
+
+.fi
+.Sp
+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 by assigning that to a variable and
+putting the name of the variable in front of the LIST without a comma.
+(This always forces interpretation of the LIST as a multi-valued list, even
+if there is only a single scalar in the list.)
+Example:
+.nf
+
+.ne 2
+	$shell = '/bin/csh';
+	exec $shell '-sh';		# pretend it's a login shell
+
+.fi
+.Ip "exit(EXPR)" 8 6
+.Ip "exit EXPR" 8
+Evaluates EXPR and exits immediately with that value.
+Example:
+.nf
+
+.ne 2
+	$ans = <STDIN>;
+	exit 0 \|if \|$ans \|=~ \|/\|^[Xx]\|/\|;
+
+.fi
+See also
+.IR die .
+If EXPR is omitted, exits with 0 status.
+.Ip "exp(EXPR)" 8 3
+.Ip "exp EXPR" 8
+Returns
+.I e
+to the power of EXPR.
+If EXPR is omitted, gives exp($_).
+.Ip "fcntl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
+Implements the fcntl(2) function.
+You'll probably have to say
+.nf
+
+	require "fcntl.ph";	# probably /usr/local/lib/perl/fcntl.ph
+
+.fi
+first to get the correct function definitions.
+If fcntl.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 <sys/fcntl.h>.
+(There is a perl script called h2ph that comes with the perl kit
+which may help you in this.)
+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).
+.Ip "fileno(FILEHANDLE)" 8 4
+.Ip "fileno FILEHANDLE" 8 4
+Returns the file descriptor for a filehandle.
+Useful for constructing bitmaps for select().
+If FILEHANDLE is an expression, the value is taken as the name of
+the filehandle.
+.Ip "flock(FILEHANDLE,OPERATION)" 8 4
+Calls flock(2) on FILEHANDLE.
+See manual page for 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
+flock(2).
+Here's a mailbox appender for BSD systems.
+.nf
+
+.ne 20
+	$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'}")
+		|| die "Can't open mailbox: $!";
+
+	do lock();
+	print MBOX $msg,"\en\en";
+	do unlock();
+
+.fi
+.Ip "fork" 8 4
+Does a fork() call.
+Returns the child pid to the parent process and 0 to the child process.
+Note: unflushed buffers remain unflushed in both processes, which means
+you may need to set $| to avoid duplicate output.
+.Ip "getc(FILEHANDLE)" 8 4
+.Ip "getc FILEHANDLE" 8
+.Ip "getc" 8
+Returns the next character from the input file attached to FILEHANDLE, or
+a null string at EOF.
+If FILEHANDLE is omitted, reads from STDIN.
+.Ip "getlogin" 8 3
+Returns the current login from /etc/utmp, if any.
+If null, use getpwuid.
+
+	$login = getlogin || (getpwuid($<))[0] || "Somebody";
+
+.Ip "getpeername(SOCKET)" 8 3
+Returns the packed sockaddr address of other end of the SOCKET connection.
+.nf
+
+.ne 4
+	# An internet sockaddr
+	$sockaddr = 'S n a4 x8';
+	$hersockaddr = getpeername(S);
+.ie t \{\
+	($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
+'br\}
+.el \{\
+	($family, $port, $heraddr) =
+			unpack($sockaddr,$hersockaddr);
+'br\}
+
+.fi
+.Ip "getpgrp(PID)" 8 4
+.Ip "getpgrp PID" 8
+Returns 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
+getpgrp(2).
+If EXPR is omitted, returns process group of current process.
+.Ip "getppid" 8 4
+Returns the process id of the parent process.
+.Ip "getpriority(WHICH,WHO)" 8 4
+Returns the current priority for a process, a process group, or a user.
+(See getpriority(2).)
+Will produce a fatal error if used on a machine that doesn't implement
+getpriority(2).
+.Ip "getpwnam(NAME)" 8
+.Ip "getgrnam(NAME)" 8
+.Ip "gethostbyname(NAME)" 8
+.Ip "getnetbyname(NAME)" 8
+.Ip "getprotobyname(NAME)" 8
+.Ip "getpwuid(UID)" 8
+.Ip "getgrgid(GID)" 8
+.Ip "getservbyname(NAME,PROTO)" 8
+.Ip "gethostbyaddr(ADDR,ADDRTYPE)" 8
+.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
+.Ip "getprotobynumber(NUMBER)" 8
+.Ip "getservbyport(PORT,PROTO)" 8
+.Ip "getpwent" 8
+.Ip "getgrent" 8
+.Ip "gethostent" 8
+.Ip "getnetent" 8
+.Ip "getprotoent" 8
+.Ip "getservent" 8
+.Ip "setpwent" 8
+.Ip "setgrent" 8
+.Ip "sethostent(STAYOPEN)" 8
+.Ip "setnetent(STAYOPEN)" 8
+.Ip "setprotoent(STAYOPEN)" 8
+.Ip "setservent(STAYOPEN)" 8
+.Ip "endpwent" 8
+.Ip "endgrent" 8
+.Ip "endhostent" 8
+.Ip "endnetent" 8
+.Ip "endprotoent" 8
+.Ip "endservent" 8
+These routines perform the same functions as their counterparts in the
+system library.
+Within an array context,
+the return values from the various get routines are as follows:
+.nf
+
+	($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.\|.\|.
+
+.fi
+(If the entry doesn't exist you get a null list.)
+.Sp
+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:
+.nf
+
+	$uid = getpwnam
+	$name = getpwuid
+	$name = getpwent
+	$gid = getgrnam
+	$name = getgrgid
+	$name = getgrent
+	etc.
+
+.fi
+The $members value returned by getgr.\|.\|. is a space separated list
+of the login names of the members of the group.
+.Sp
+For the gethost.\|.\|. functions, if the h_errno variable is supported in C,
+it will be returned to you via $? 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:
+.nf
+
+	($a,$b,$c,$d) = unpack('C4',$addr[0]);
+
+.fi
+.Ip "getsockname(SOCKET)" 8 3
+Returns the packed sockaddr address of this end of the SOCKET connection.
+.nf
+
+.ne 4
+	# An internet sockaddr
+	$sockaddr = 'S n a4 x8';
+	$mysockaddr = getsockname(S);
+.ie t \{\
+	($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
+'br\}
+.el \{\
+	($family, $port, $myaddr) =
+			unpack($sockaddr,$mysockaddr);
+'br\}
+
+.fi
+.Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
+Returns the socket option requested, or undefined if there is an error.
+.Ip "gmtime(EXPR)" 8 4
+.Ip "gmtime EXPR" 8
+Converts a time as returned by the time function to a 9-element array with
+the time analyzed for the Greenwich timezone.
+Typically used as follows:
+.nf
+
+.ne 3
+.ie t \{\
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
+'br\}
+.el \{\
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+						gmtime(time);
+'br\}
+
+.fi
+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 gmtime(time).
+.Ip "goto LABEL" 8 6
+Finds the statement labeled with LABEL and resumes execution there.
+Currently you may only go to statements in the main body of the program
+that are not nested inside a do {} construct.
+This statement is not implemented very efficiently, and is here only to make
+the
+.IR sed -to- perl
+translator easier.
+I may change its semantics at any time, consistent with support for translated
+.I sed
+scripts.
+Use it at your own risk.
+Better yet, don't use it at all.
+.Ip "grep(EXPR,LIST)" 8 4
+Evaluates EXPR for each element of LIST (locally setting $_ to each element)
+and returns the array 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.
+.nf
+
+	@foo = grep(!/^#/, @bar);    # weed out comments
+
+.fi
+Note that, since $_ is a reference into the array 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.
+.Ip "hex(EXPR)" 8 4
+.Ip "hex EXPR" 8
+Returns the decimal value of EXPR interpreted as an hex string.
+(To interpret strings that might start with 0 or 0x see oct().)
+If EXPR is omitted, uses $_.
+.Ip "index(STR,SUBSTR,POSITION)" 8 4
+.Ip "index(STR,SUBSTR)" 8 4
+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.
+If the substring is not found, returns one less than the base, ordinarily \-1.
+.Ip "int(EXPR)" 8 4
+.Ip "int EXPR" 8
+Returns the integer portion of EXPR.
+If EXPR is omitted, uses $_.
+.Ip "ioctl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
+Implements the ioctl(2) function.
+You'll probably have to say
+.nf
+
+	require "ioctl.ph";	# probably /usr/local/lib/perl/ioctl.ph
+
+.fi
+first to get the correct function definitions.
+If 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 <sys/ioctl.h>.
+(There is a perl script called h2ph that comes with the perl kit
+which may help you in this.)
+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.
+.nf
+
+.ne 9
+	require 'ioctl.ph';
+	$sgttyb_t = "ccccs";		# 4 chars and a short
+	if (ioctl(STDIN,$TIOCGETP,$sgttyb)) {
+		@ary = unpack($sgttyb_t,$sgttyb);
+		$ary[2] = 127;
+		$sgttyb = pack($sgttyb_t,@ary);
+		ioctl(STDIN,$TIOCSETP,$sgttyb)
+			|| die "Can't ioctl: $!";
+	}
+
+.fi
+The return value of ioctl (and fcntl) is as follows:
+.nf
+
+.ne 4
+	if OS returns:\h'|3i'perl returns:
+	  -1\h'|3i'  undefined value
+	  0\h'|3i'  string "0 but true"
+	  anything else\h'|3i'  that number
+
+.fi
+Thus perl returns true on success and false on failure, yet you can still
+easily determine the actual value returned by the operating system:
+.nf
+
+	($retval = ioctl(...)) || ($retval = -1);
+	printf "System returned %d\en", $retval;
+.fi
+.Ip "join(EXPR,LIST)" 8 8
+.Ip "join(EXPR,ARRAY)" 8
+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:
+.nf
+    
+.ie t \{\
+    $_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
+.el \{\
+    $_ = join(\|\':\',
+		$login,$passwd,$uid,$gid,$gcos,$home,$shell);
+'br\}
+
+.fi
+See
+.IR split .
+.Ip "keys(ASSOC_ARRAY)" 8 6
+.Ip "keys ASSOC_ARRAY" 8
+Returns a normal array consisting of all the keys of the named associative
+array.
+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:
+.nf
+
+.ne 5
+	@keys = keys %ENV;
+	@values = values %ENV;
+	while ($#keys >= 0) {
+		print pop(@keys), \'=\', pop(@values), "\en";
+	}
+
+or how about sorted by key:
+
+.ne 3
+	foreach $key (sort(keys %ENV)) {
+		print $key, \'=\', $ENV{$key}, "\en";
+	}
+
+.fi
+.Ip "kill(LIST)" 8 8
+.Ip "kill LIST" 8 2
+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.
+.nf
+
+	$cnt = kill 1, $child1, $child2;
+	kill 9, @goners;
+
+.fi
+If the signal is negative, kills process groups instead of processes.
+(On System V, a negative \fIprocess\fR number will also kill process groups,
+but that's not portable.)
+You may use a signal name in quotes.
+.Ip "last LABEL" 8 8
+.Ip "last" 8
+The
+.I last
+command is like the
+.I 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
+.I continue
+block, if any, is not executed:
+.nf
+
+.ne 4
+	line: while (<STDIN>) {
+		last line if /\|^$/;	# exit when done with header
+		.\|.\|.
+	}
+
+.fi
+.Ip "length(EXPR)" 8 4
+.Ip "length EXPR" 8
+Returns the length in characters of the value of EXPR.
+If EXPR is omitted, returns length of $_.
+.Ip "link(OLDFILE,NEWFILE)" 8 2
+Creates a new filename linked to the old filename.
+Returns 1 for success, 0 otherwise.
+.Ip "listen(SOCKET,QUEUESIZE)" 8 2
+Does the same thing that the listen system call does.
+Returns true if it succeeded, false otherwise.
+See example in section on Interprocess Communication.
+.Ip "local(LIST)" 8 4
+Declares the listed variables to be local to the enclosing block,
+subroutine, eval or \*(L"do\*(R".
+All the listed elements must be legal lvalues.
+This operator works by saving the current values of those variables in 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 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:
+.nf
+
+.ne 13
+	sub RANGEVAL {
+		local($min, $max, $thunk) = @_;
+		local($result) = \'\';
+		local($i);
+
+		# Presumably $thunk makes reference to $i
+
+		for ($i = $min; $i < $max; $i++) {
+			$result .= eval $thunk;
+		}
+
+		$result;
+	}
+
+.ne 6
+	if ($sw eq \'-v\') {
+	    # init local array with global array
+	    local(@ARGV) = @ARGV;
+	    unshift(@ARGV,\'echo\');
+	    system @ARGV;
+	}
+	# @ARGV restored
+
+.ne 6
+	# temporarily add to digits associative array
+	if ($base12) {
+		# (NOTE: not claiming this is efficient!)
+		local(%digits) = (%digits,'t',10,'e',11);
+		do parse_num();
+	}
+
+.fi
+Note that local() is a run-time command, and so gets executed every time
+through a loop, using up more stack storage each time until it's all
+released at once when the loop is exited.
+.Ip "localtime(EXPR)" 8 4
+.Ip "localtime EXPR" 8
+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:
+.nf
+
+.ne 3
+.ie t \{\
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
+'br\}
+.el \{\
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+						localtime(time);
+'br\}
+
+.fi
+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).
+.Ip "log(EXPR)" 8 4
+.Ip "log EXPR" 8
+Returns logarithm (base
+.IR e )
+of EXPR.
+If EXPR is omitted, returns log of $_.
+.Ip "lstat(FILEHANDLE)" 8 6
+.Ip "lstat FILEHANDLE" 8
+.Ip "lstat(EXPR)" 8
+.Ip "lstat SCALARVARIABLE" 8
+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.
+.Ip "m/PATTERN/gio" 8 4
+.Ip "/PATTERN/gio" 8
+Searches a string for a pattern match, and returns true (1) or false (\'\').
+If no string is specified via the =~ or !~ operator,
+the $_ string is searched.
+(The string specified with =~ need not be an lvalue\*(--it may be the result of an expression evaluation, but remember the =~ binds rather tightly.)
+See also the section on regular expressions.
+.Sp
+If / is the delimiter then the initial \*(L'm\*(R' is optional.
+With the \*(L'm\*(R' you can use any pair of non-alphanumeric characters
+as delimiters.
+This is particularly useful for matching Unix path names that contain \*(L'/\*(R'.
+If the final delimiter is followed by the optional letter \*(L'i\*(R', the matching is
+done in a case-insensitive manner.
+PATTERN may contain references to scalar variables, which will be interpolated
+(and the pattern recompiled) every time the pattern search is evaluated.
+(Note that $) and $| may not be interpolated because they look like end-of-string tests.)
+If you want such a pattern to be compiled only once, add an \*(L"o\*(R" 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.
+If the PATTERN evaluates to a null string, the most recent successful
+regular expression is used instead.
+.Sp
+If used in a context that requires an array value, a pattern match returns an
+array consisting of the subexpressions matched by the parentheses in the
+pattern,
+i.e. ($1, $2, $3.\|.\|.).
+It does NOT actually set $1, $2, etc. in this case, nor does it set $+, $`, $&
+or $'.
+If the match fails, a null array is returned.
+If the match succeeds, but there were no parentheses, an array value of (1)
+is returned.
+.Sp
+Examples:
+.nf
+
+.ne 4
+    open(tty, \'/dev/tty\');
+    <tty> \|=~ \|/\|^y\|/i \|&& \|do foo(\|);	# do foo if desired
+
+    if (/Version: \|*\|([0\-9.]*\|)\|/\|) { $version = $1; }
+
+    next if m#^/usr/spool/uucp#;
+
+.ne 5
+    # poor man's grep
+    $arg = shift;
+    while (<>) {
+	    print if /$arg/o;	# compile only once
+    }
+
+    if (($F1, $F2, $Etc) = ($foo =~ /^(\eS+)\es+(\eS+)\es*(.*)/))
+
+.fi
+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.
+.Sp
+The \*(L"g\*(R" modifier specifies global pattern matching\*(--that is,
+matching as many times as possible within the string.  How it behaves
+depends on the context.  In an array 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,
+it 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.)  It
+presumes that you have not modified the string since the last match.
+Modifying the string between matches may result in undefined behavior.
+(You can actually get away with in-place modifications via substr()
+that do not change the length of the entire string.  In general, however,
+you should be using s///g for such modifications.)  Examples:
+.nf
+
+	# array context
+	($one,$five,$fifteen) = (\`uptime\` =~ /(\ed+\e.\ed+)/g);
+
+	# scalar context
+	$/ = ""; $* = 1;
+	while ($paragraph = <>) {
+	    while ($paragraph =~ /[a-z][\'")]*[.!?]+[\'")]*\es/g) {
+		$sentences++;
+	    }
+	}
+	print "$sentences\en";
+
+.fi
+.Ip "mkdir(FILENAME,MODE)" 8 3
+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).
+.Ip "msgctl(ID,CMD,ARG)" 8 4
+Calls the System V IPC function msgctl.  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.
+.Ip "msgget(KEY,FLAGS)" 8 4
+Calls the System V IPC function msgget.  Returns the message queue id,
+or the undefined value if there is an error.
+.Ip "msgsnd(ID,MSG,FLAGS)" 8 4
+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 pack("L", $type).  Returns true if
+successful, or false if there is an error.
+.Ip "msgrcv(ID,VAR,SIZE,TYPE,FLAGS)" 8 4
+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.
+.Ip "next LABEL" 8 8
+.Ip "next" 8
+The
+.I next
+command is like the
+.I continue
+statement in C; it starts the next iteration of the loop:
+.nf
+
+.ne 4
+	line: while (<STDIN>) {
+		next line if /\|^#/;	# discard comments
+		.\|.\|.
+	}
+
+.fi
+Note that if there were a
+.I 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.
+.Ip "oct(EXPR)" 8 4
+.Ip "oct EXPR" 8
+Returns the decimal value of EXPR interpreted as an octal string.
+(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 notation:
+.nf
+
+	$val = oct($val) if $val =~ /^0/;
+
+.fi
+If EXPR is omitted, uses $_.
+.Ip "open(FILEHANDLE,EXPR)" 8 8
+.Ip "open(FILEHANDLE)" 8
+.Ip "open FILEHANDLE" 8
+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 \*(L"<\*(R" or nothing, the file is opened for
+input.
+If the filename begins with \*(L">\*(R", the file is opened for output.
+If the filename begins with \*(L">>\*(R", 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.)
+If the filename begins with \*(L"|\*(R", the filename is interpreted
+as a command to which output is to be piped, and if the filename ends
+with a \*(L"|\*(R", the filename is interpreted as command which pipes
+input to us.
+(You may not have a command that pipes both in and out.)
+Opening \'\-\' opens
+.I STDIN
+and opening \'>\-\' opens
+.IR 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.
+Examples:
+.nf
+    
+.ne 3
+	$article = 100;
+	open article || die "Can't find article $article: $!\en";
+	while (<article>) {\|.\|.\|.
+
+.ie t \{\
+	open(LOG, \'>>/usr/spool/news/twitlog\'\|);	# (log is reserved)
+'br\}
+.el \{\
+	open(LOG, \'>>/usr/spool/news/twitlog\'\|);
+					# (log is reserved)
+'br\}
+
+.ie t \{\
+	open(article, "caesar <$article |"\|);		# decrypt article
+'br\}
+.el \{\
+	open(article, "caesar <$article |"\|);
+					# decrypt article
+'br\}
+
+.ie t \{\
+	open(extract, "|sort >/tmp/Tmp$$"\|);		# $$ is our process#
+'br\}
+.el \{\
+	open(extract, "|sort >/tmp/Tmp$$"\|);
+					# $$ is our process#
+'br\}
+
+.ne 7
+	# process argument list of files along with any includes
+
+	foreach $file (@ARGV) {
+		do process($file, \'fh00\');	# no pun intended
+	}
+
+	sub process {
+		local($filename, $input) = @_;
+		$input++;		# this is a string increment
+		unless (open($input, $filename)) {
+			print STDERR "Can't open $filename: $!\en";
+			return;
+		}
+.ie t \{\
+		while (<$input>) {		# note the use of indirection
+'br\}
+.el \{\
+		while (<$input>) {		# note use of indirection
+'br\}
+			if (/^#include "(.*)"/) {
+				do process($1, $input);
+				next;
+			}
+			.\|.\|.		# whatever
+		}
+	}
+
+.fi
+You may also, in the Bourne shell tradition, specify an EXPR beginning
+with \*(L">&\*(R", 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.
+Here is a script that saves, redirects, and restores
+.I STDOUT
+and
+.IR STDERR :
+.nf
+
+.ne 21
+	#!/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\en";	# this works for
+	print STDERR "stderr 1\en"; 	# subprocesses too
+
+	close(STDOUT);
+	close(STDERR);
+
+	open(STDOUT, ">&SAVEOUT");
+	open(STDERR, ">&SAVEERR");
+
+	print STDOUT "stdout 2\en";
+	print STDERR "stderr 2\en";
+
+.fi
+If you open a pipe on the command \*(L"\-\*(R", i.e. either \*(L"|\-\*(R" or \*(L"\-|\*(R",
+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 if the open was successful.)
+The filehandle behaves normally for the parent, but i/o to that
+filehandle is piped from/to the
+.IR STDOUT / STDIN
+of the child process.
+In the child process the filehandle isn't opened\*(--i/o happens from/to
+the new
+.I STDOUT
+or
+.IR 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:
+.nf
+
+.ne 5
+	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;
+
+.fi
+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.
+.Sp
+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:
+.nf
+
+.ne 2
+        $file =~ s#^(\es)#./$1#;
+        open(FOO, "< $file\e0");
+
+.fi
+.Ip "opendir(DIRHANDLE,EXPR)" 8 3
+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.
+.Ip "ord(EXPR)" 8 4
+.Ip "ord EXPR" 8
+Returns the numeric ascii value of the first character of EXPR.
+If EXPR is omitted, uses $_.
+''' Comments on f & d by gnb@melba.bby.oz.au	22/11/89
+.Ip "pack(TEMPLATE,LIST)" 8 4
+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:
+.nf
+
+	A	An ascii string, will be space padded.
+	a	An ascii string, will be null padded.
+	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 \*(L"network\*(R" order.
+	N	A long in \*(L"network\*(R" order.
+	f	A single-precision float in the native format.
+	d	A double-precision float in the native format.
+	p	A pointer to a string.
+	v	A short in \*(L"VAX\*(R" (little-endian) order.
+	V	A long in \*(L"VAX\*(R" (little-endian) order.
+	x	A null byte.
+	X	Back up a byte.
+	@	Null fill to absolute position.
+	u	A uuencoded string.
+	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).
+
+.fi
+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",
+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.
+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 \*(L"network\*(R" 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 -> float -> double will lose precision (i.e. unpack("f",
+pack("f", $foo)) will not in general equal $foo).
+.br
+Examples:
+.nf
+
+	$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\e0\e0CD"
+
+	$foo = pack("s2",1,2);
+	# "\e1\e0\e2\e0" on little-endian
+	# "\e0\e1\e0\e2" on big-endian
+
+	$foo = pack("a4","abcd","x","y","z");
+	# "abcd"
+
+	$foo = pack("aaaa","abcd","x","y","z");
+	# "axyz"
+
+	$foo = pack("a14","abcdefg");
+	# "abcdefg\e0\e0\e0\e0\e0\e0\e0"
+
+	$foo = pack("i9pl", gmtime);
+	# a real struct tm (on my system anyway)
+
+	sub bintodec {
+	    unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
+	}
+.fi
+The same template may generally also be used in the unpack function.
+.Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3
+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.
+[Requires version 3.0 patchlevel 9.]
+.Ip "pop(ARRAY)" 8
+.Ip "pop ARRAY" 8 6
+Pops and returns the last value of the array, shortening the array by 1.
+Has the same effect as
+.nf
+
+	$tmp = $ARRAY[$#ARRAY\-\|\-];
+
+.fi
+If there are no elements in the array, returns the undefined value.
+.Ip "print(FILEHANDLE LIST)" 8 10
+.Ip "print(LIST)" 8
+.Ip "print FILEHANDLE LIST" 8
+.Ip "print LIST" 8
+.Ip "print" 8
+Prints a string or a comma-separated list of strings.
+Returns non-zero if successful.
+FILEHANDLE may be a scalar variable name, in which case the variable contains
+the name of 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
+.IR STDOUT .
+To set the default output channel to something other than
+.I STDOUT
+use the select operation.
+Note that, because print takes a LIST, anything in the LIST is evaluated
+in an array context, and any subroutine that you call will have one or more
+of its expressions evaluated in an array 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.
+.Ip "printf(FILEHANDLE LIST)" 8 10
+.Ip "printf(LIST)" 8
+.Ip "printf FILEHANDLE LIST" 8
+.Ip "printf LIST" 8
+Equivalent to a \*(L"print FILEHANDLE sprintf(LIST)\*(R".
+.Ip "push(ARRAY,LIST)" 8 7
+Treats ARRAY (@ is optional) 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
+.nf
+
+    for $value (LIST) {
+	    $ARRAY[++$#ARRAY] = $value;
+    }
+
+.fi
+but is more efficient.
+.Ip "q/STRING/" 8 5
+.Ip "qq/STRING/" 8
+.Ip "qx/STRING/" 8
+These are not really functions, but simply syntactic sugar to let you
+avoid putting too many backslashes into quoted strings.
+The q operator is a generalized single quote, and the qq operator a
+generalized double quote.
+The qx operator is a generalized backquote.
+Any non-alphanumeric delimiter can be used in place of /, including newline.
+If the delimiter is an opening bracket or parenthesis, the final delimiter
+will be the corresponding closing bracket or parenthesis.
+(Embedded occurrences of the closing bracket need to be backslashed as usual.)
+Examples:
+.nf
+
+.ne 5
+	$foo = q!I said, "You said, \'She said it.\'"!;
+	$bar = q(\'This is it.\');
+	$today = qx{ date };
+	$_ .= qq
+*** The previous line contains the naughty word "$&".\en
+		if /(ibm|apple|awk)/;      # :-)
+
+.fi
+.Ip "rand(EXPR)" 8 8
+.Ip "rand EXPR" 8
+.Ip "rand" 8
+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.
+See also srand().
+.Ip "read(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
+.Ip "read(FILEHANDLE,SCALAR,LENGTH)" 8 5
+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.
+.Ip "readdir(DIRHANDLE)" 8 3
+.Ip "readdir DIRHANDLE" 8
+Returns the next directory entry for a directory opened by opendir().
+If used in an array 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 an array context.
+.Ip "readlink(EXPR)" 8 6
+.Ip "readlink EXPR" 8
+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 $_.
+.Ip "recv(SOCKET,SCALAR,LEN,FLAGS)" 8 4
+Receives a message on a socket.
+Attempts to receive LENGTH bytes of data into variable SCALAR from the specified
+SOCKET filehandle.
+Returns the address of the sender, or 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.
+.Ip "redo LABEL" 8 8
+.Ip "redo" 8
+The
+.I redo
+command restarts the loop block without evaluating the conditional again.
+The
+.I 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:
+.nf
+
+.ne 16
+	# 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;
+	}
+
+.fi
+.Ip "rename(OLDNAME,NEWNAME)" 8 2
+Changes the name of a file.
+Returns 1 for success, 0 otherwise.
+Will not work across filesystem boundaries.
+.Ip "require(EXPR)" 8 6
+.Ip "require EXPR" 8
+.Ip "require" 8
+Includes the library file specified by EXPR, or by $_ if EXPR is not supplied.
+Has semantics similar to the following subroutine:
+.nf
+
+	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 \e@INC";
+	    }
+	    die $@ if $@;
+	    die "$filename did not return true value" unless $result;
+	    $INC{$filename} = $realfilename;
+	    $result;
+	}
+
+.fi
+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 \*(L"1;\*(R" unless you're sure it'll return true otherwise.
+.Ip "reset(EXPR)" 8 6
+.Ip "reset EXPR" 8
+.Ip "reset" 8
+Generally used in a
+.I 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:
+.nf
+
+.ne 3
+    reset \'X\';	\h'|2i'# reset all X variables
+    reset \'a\-z\';\h'|2i'# reset lower case variables
+    reset;	\h'|2i'# just reset ?? searches
+
+.fi
+Note: resetting \*(L"A\-Z\*(R" is not recommended since you'll wipe out your ARGV and ENV
+arrays.
+.Sp
+The use of reset on dbm associative arrays does not change the dbm file.
+(It does, however, flush any entries cached by perl, which may be useful if
+you are sharing the dbm file.
+Then again, maybe not.)
+.Ip "return LIST" 8 3
+Returns from a subroutine with the value specified.
+(Note that a subroutine can automatically return
+the value of the last expression evaluated.
+That's the preferred method\*(--use of an explicit
+.I return
+is a bit slower.)
+.Ip "reverse(LIST)" 8 4
+.Ip "reverse LIST" 8
+In an array context, returns an array 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.
+.Ip "rewinddir(DIRHANDLE)" 8 5
+.Ip "rewinddir DIRHANDLE" 8
+Sets the current position to the beginning of the directory for the readdir() routine on DIRHANDLE.
+.Ip "rindex(STR,SUBSTR,POSITION)" 8 6
+.Ip "rindex(STR,SUBSTR)" 8 4
+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.
+.Ip "rmdir(FILENAME)" 8 4
+.Ip "rmdir FILENAME" 8
+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 $_.
+.Ip "s/PATTERN/REPLACEMENT/gieo" 8 3
+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).
+The \*(L"g\*(R" is optional, and if present, indicates that all occurrences
+of the pattern are to be replaced.
+The \*(L"i\*(R" is also optional, and if present, indicates that matching
+is to be done in a case-insensitive manner.
+The \*(L"e\*(R" is likewise optional, and if present, indicates that
+the replacement string is to be evaluated as an expression rather than just
+as a double-quoted string.
+Any non-alphanumeric delimiter may replace the slashes;
+if single quotes are used, no
+interpretation is done on the replacement string (the 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.
+s(foo)(bar) or s<foo>/bar/.
+If no string is specified via the =~ or !~ operator,
+the $_ string is searched and modified.
+(The string specified with =~ must be a scalar variable, an array element,
+or an assignment to one of those, i.e. an lvalue.)
+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, add an \*(L"o\*(R" at the end.
+If the PATTERN evaluates to a null string, the most recent successful
+regular expression is used instead.
+See also the section on regular expressions.
+Examples:
+.nf
+
+    s/\|\e\|bgreen\e\|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/bar/foo/;
+
+    $_ = \'abc123xyz\';
+    s/\ed+/$&*2/e;		# yields \*(L'abc246xyz\*(R'
+    s/\ed+/sprintf("%5d",$&)/e;	# yields \*(L'abc  246xyz\*(R'
+    s/\ew/$& x 2/eg;		# yields \*(L'aabbcc  224466xxyyzz\*(R'
+
+    s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/;	# reverse 1st two fields
+
+.fi
+(Note the use of $ instead of \|\e\| in the last example.  See section
+on regular expressions.)
+.Ip "scalar(EXPR)" 8 3
+Forces EXPR to be interpreted in a scalar context and returns the value
+of EXPR.
+.Ip "seek(FILEHANDLE,POSITION,WHENCE)" 8 3
+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.
+Returns 1 upon success, 0 otherwise.
+.Ip "seekdir(DIRHANDLE,POS)" 8 3
+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.
+.Ip "select(FILEHANDLE)" 8 3
+.Ip "select" 8 3
+Returns the currently selected filehandle.
+Sets the current default filehandle for output, if FILEHANDLE is supplied.
+This has two effects: first, a
+.I write
+or a
+.I 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:
+.nf
+
+.ne 4
+	select(REPORT1);
+	$^ = \'report1_top\';
+	select(REPORT2);
+	$^ = \'report2_top\';
+
+.fi
+FILEHANDLE may be an expression whose value gives the name of the actual filehandle.
+Thus:
+.nf
+
+	$oldfh = select(STDERR); $| = 1; select($oldfh);
+
+.fi
+.Ip "select(RBITS,WBITS,EBITS,TIMEOUT)" 8 3
+This calls the select system call with the bitmasks specified, which can
+be constructed using fileno() and vec(), along these lines:
+.nf
+
+	$rin = $win = $ein = '';
+	vec($rin,fileno(STDIN),1) = 1;
+	vec($win,fileno(STDOUT),1) = 1;
+	$ein = $rin | $win;
+
+.fi
+If you want to select on many filehandles you might wish to write a subroutine:
+.nf
+
+	sub fhbits {
+	    local(@fhlist) = split(' ',$_[0]);
+	    local($bits);
+	    for (@fhlist) {
+		vec($bits,fileno($_),1) = 1;
+	    }
+	    $bits;
+	}
+	$rin = &fhbits('STDIN TTY SOCK');
+
+.fi
+The usual idiom is:
+.nf
+
+	($nfound,$timeleft) =
+	  select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
+
+or to block until something becomes ready:
+
+.ie t \{\
+	$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
+'br\}
+.el \{\
+	$nfound = select($rout=$rin, $wout=$win,
+				$eout=$ein, undef);
+'br\}
+
+.fi
+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.
+.Ip "semctl(ID,SEMNUM,CMD,ARG)" 8 4
+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.
+.Ip "semget(KEY,NSEMS,SIZE,FLAGS)" 8 4
+Calls the System V IPC function semget.  Returns the semaphore id, or
+the undefined value if there is an error.
+.Ip "semop(KEY,OPSTRING)" 8 4
+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
+\&'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:
+.nf
+
+	$semop = pack("sss", $semnum, -1, 0);
+	die "Semaphore trouble: $!\en" unless semop($semid, $semop);
+
+.fi
+To signal the semaphore, replace "-1" with "1".
+.Ip "send(SOCKET,MSG,FLAGS,TO)" 8 4
+.Ip "send(SOCKET,MSG,FLAGS)" 8
+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.
+Returns the number of characters sent, or the undefined value if
+there is an error.
+.Ip "setpgrp(PID,PGRP)" 8 4
+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).
+.Ip "setpriority(WHICH,WHO,PRIORITY)" 8 4
+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).
+.Ip "setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)" 8 3
+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.
+.Ip "shift(ARRAY)" 8 6
+.Ip "shift ARRAY" 8
+.Ip "shift" 8
+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.
+.Ip "shmctl(ID,CMD,ARG)" 8 4
+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.
+.Ip "shmget(KEY,SIZE,FLAGS)" 8 4
+Calls the System V IPC function shmget.  Returns the shared memory
+segment id, or the undefined value if there is an error.
+.Ip "shmread(ID,VAR,POS,SIZE)" 8 4
+.Ip "shmwrite(ID,STRING,POS,SIZE)" 8
+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.
+.Ip "shutdown(SOCKET,HOW)" 8 3
+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.
+.Ip "sin(EXPR)" 8 4
+.Ip "sin EXPR" 8
+Returns the sine of EXPR (expressed in radians).
+If EXPR is omitted, returns sine of $_.
+.Ip "sleep(EXPR)" 8 6
+.Ip "sleep EXPR" 8
+.Ip "sleep" 8
+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().
+.Ip "socket(SOCKET,DOMAIN,TYPE,PROTOCOL)" 8 3
+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 may need to run h2ph on sys/socket.h to get the proper values handy
+in a perl library file.
+Return true if successful.
+See the example in the section on Interprocess Communication.
+.Ip "socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)" 8 3
+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.
+Return true if successful.
+.Ip "sort(SUBROUTINE LIST)" 8 9
+.Ip "sort(LIST)" 8
+.Ip "sort SUBROUTINE LIST" 8
+.Ip "sort BLOCK LIST" 8
+.Ip "sort LIST" 8
+Sorts the LIST and returns the sorted array value.
+Nonexistent values of arrays are stripped out.
+If SUBROUTINE or BLOCK is omitted, sorts in standard string comparison order.
+If SUBROUTINE is specified, 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.)
+SUBROUTINE may be a scalar variable name, in which case the value provides
+the name of the subroutine to use.
+In place of a SUBROUTINE name, you can provide a BLOCK as an anonymous,
+in-line sort subroutine.
+.Sp
+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 $a and $b (see example below).
+They are passed by reference so don't modify $a and $b.
+.Sp
+Examples:
+.nf
+
+.ne 2
+	# sort lexically
+	@articles = sort @files;
+
+.ne 2
+	# same thing, but with explicit sort routine
+	@articles = sort {$a cmp $b} @files;
+
+.ne 2
+	# same thing in reversed order
+	@articles = sort {$b cmp $a} @files;
+
+.ne 2
+	# sort numerically ascending
+	@articles = sort {$a <=> $b} @files;
+
+.ne 2
+	# sort numerically descending
+	@articles = sort {$b <=> $a} @files;
+
+.ne 5
+	# sort using explicit subroutine name
+	sub byage {
+	    $age{$a} <=> $age{$b};	# presuming integers
+	}
+	@sortedclass = sort byage @class;
+
+.ne 9
+	sub reverse { $b cmp $a; }
+	@harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\');
+	@george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\');
+	print sort @harry;
+		# prints AbelCaincatdogx
+	print sort reverse @harry;
+		# prints xdogcatCainAbel
+	print sort @george, \'to\', @harry;
+		# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
+
+.fi
+.Ip "splice(ARRAY,OFFSET,LENGTH,LIST)" 8 8
+.Ip "splice(ARRAY,OFFSET,LENGTH)" 8
+.Ip "splice(ARRAY,OFFSET)" 8
+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):
+.nf
+
+	push(@a,$x,$y)\h'|3.5i'splice(@a,$#a+1,0,$x,$y)
+	pop(@a)\h'|3.5i'splice(@a,-1)
+	shift(@a)\h'|3.5i'splice(@a,0,1)
+	unshift(@a,$x,$y)\h'|3.5i'splice(@a,0,0,$x,$y)
+	$a[$x] = $y\h'|3.5i'splice(@a,$x,1,$y);
+
+Example, assuming array lengths are passed before arrays:
+	
+	sub aeq {	# compare two array 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)) { ... }
+
+.fi
+.Ip "split(/PATTERN/,EXPR,LIMIT)" 8 8
+.Ip "split(/PATTERN/,EXPR)" 8 8
+.Ip "split(/PATTERN/)" 8
+.Ip "split" 8
+Splits a string into an array of strings, and returns it.
+(If not in an array context, returns the number of fields found and splits
+into the @_ array.
+(In an array context, you can force the split into @_
+by using ?? as the pattern delimiters, but it still returns the array value.))
+If EXPR is omitted, splits the $_ string.
+If PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/).
+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, 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).
+A pattern matching the null string (not to be confused with a null pattern //,
+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:
+.nf
+
+	print join(\':\', split(/ */, \'hi there\'));
+
+.fi
+produces the output \*(L'h:i:t:h:e:r:e\*(R'.
+.Sp
+The LIMIT parameter can be used to partially split a line
+.nf
+
+	($login, $passwd, $remainder) = split(\|/\|:\|/\|, $_, 3);
+
+.fi
+(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.)
+.Sp
+If the PATTERN contains parentheses, additional array elements are created
+from each matching substring in the delimiter.
+.Sp
+	split(/([,-])/,"1-10,20");
+.Sp
+produces the array value
+.Sp
+	(1,'-',10,',',20)
+.Sp
+The pattern /PATTERN/ may be replaced with an expression to specify patterns
+that vary at runtime.
+(To do runtime compilation only once, use /$variable/o.)
+As a special case, specifying a space (\'\ \') will split on white space
+just as split with no arguments does, but leading white space does NOT
+produce a null first field.
+Thus, split(\'\ \') can be used to emulate
+.IR awk 's
+default behavior, whereas
+split(/\ /) will give you as many null initial fields as there are
+leading spaces.
+.Sp
+Example:
+.nf
+
+.ne 5
+	open(passwd, \'/etc/passwd\');
+	while (<passwd>) {
+.ie t \{\
+		($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(\|/\|:\|/\|);
+'br\}
+.el \{\
+		($login, $passwd, $uid, $gid, $gcos, $home, $shell)
+			= split(\|/\|:\|/\|);
+'br\}
+		.\|.\|.
+	}
+
+.fi
+(Note that $shell above will still have a newline on it.  See chop().)
+See also
+.IR join .
+.Ip "sprintf(FORMAT,LIST)" 8 4
+Returns a string formatted by the usual printf conventions.
+The * character is not supported.
+.Ip "sqrt(EXPR)" 8 4
+.Ip "sqrt EXPR" 8
+Return the square root of EXPR.
+If EXPR is omitted, returns square root of $_.
+.Ip "srand(EXPR)" 8 4
+.Ip "srand EXPR" 8
+Sets the random number seed for the
+.I rand
+operator.
+If EXPR is omitted, does srand(time).
+.Ip "stat(FILEHANDLE)" 8 8
+.Ip "stat FILEHANDLE" 8
+.Ip "stat(EXPR)" 8
+.Ip "stat SCALARVARIABLE" 8
+Returns a 13-element array giving the statistics 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:
+.nf
+
+.ne 3
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+           = stat($filename);
+
+.fi
+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:
+.nf
+
+.ne 3
+	if (-x $file && (($d) = stat(_)) && $d < 0) {
+		print "$file is executable NFS file\en";
+	}
+
+.fi
+(This only works on machines for which the device number is negative under NFS.)
+.Ip "study(SCALAR)" 8 6
+.Ip "study SCALAR" 8
+.Ip "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 \*(L"unstudied\*(R".
+(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 \*(L'k\*(R' 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 \*(L"rarest\*(R" character are examined.)
+.Sp
+For example, here is a loop which inserts index producing entries before any line
+containing a certain pattern:
+.nf
+
+.ne 8
+	while (<>) {
+		study;
+		print ".IX foo\en" if /\ebfoo\eb/;
+		print ".IX bar\en" if /\ebbar\eb/;
+		print ".IX blurfl\en" if /\ebblurfl\eb/;
+		.\|.\|.
+		print;
+	}
+
+.fi
+In searching for /\ebfoo\eb/, only those locations in $_ that contain \*(L'f\*(R'
+will be looked at, because \*(L'f\*(R' is rarer than \*(L'o\*(R'.
+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.
+.Sp
+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.
+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:
+.nf
+
+.ne 12
+	$search = \'while (<>) { study;\';
+	foreach $word (@words) {
+	    $search .= "++\e$seen{\e$ARGV} if /\e\eb$word\e\eb/;\en";
+	}
+	$search .= "}";
+	@ARGV = @files;
+	undef $/;
+	eval $search;		# this screams
+	$/ = "\en";		# put back to normal input delim
+	foreach $file (sort keys(%seen)) {
+	    print $file, "\en";
+	}
+
+.fi
+.Ip "substr(EXPR,OFFSET,LEN)" 8 2
+.Ip "substr(EXPR,OFFSET)" 8 2
+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.
+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().
+.Ip "symlink(OLDFILE,NEWFILE)" 8 2
+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:
+.nf
+
+	$symlink_exists = (eval \'symlink("","");\', $@ eq \'\');
+
+.fi
+.Ip "syscall(LIST)" 8 6
+.Ip "syscall LIST" 8
+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.
+.nf
+
+	require 'syscall.ph';		# may need to run h2ph
+	syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9);
+
+.fi
+.Ip "sysread(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
+.Ip "sysread(FILEHANDLE,SCALAR,LENGTH)" 8 5
+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.
+.Ip "system(LIST)" 8 6
+.Ip "system LIST" 8
+Does exactly the same thing as \*(L"exec LIST\*(R" 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
+.IR exec .
+.Ip "syswrite(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
+.Ip "syswrite(FILEHANDLE,SCALAR,LENGTH)" 8 5
+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 place the read data at some other place
+than the beginning of the string.
+.Ip "tell(FILEHANDLE)" 8 6
+.Ip "tell FILEHANDLE" 8 6
+.Ip "tell" 8
+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.
+.Ip "telldir(DIRHANDLE)" 8 5
+.Ip "telldir DIRHANDLE" 8
+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.
+.Ip "time" 8 4
+Returns the number of non-leap seconds since 00:00:00 UTC, January 1, 1970.
+Suitable for feeding to gmtime() and localtime().
+.Ip "times" 8 4
+Returns a four-element array giving the user and system times, in seconds, for this
+process and the children of this process.
+.Sp
+    ($user,$system,$cuser,$csystem) = times;
+.Sp
+.Ip "tr/SEARCHLIST/REPLACEMENTLIST/cds" 8 5
+.Ip "y/SEARCHLIST/REPLACEMENTLIST/cds" 8
+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
+.I sed
+devotees,
+.I y
+is provided as a synonym for
+.IR 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.
+tr[A-Z][a-z] or tr(+-*/)/ABCD/.
+.Sp
+If the c modifier is specified, the SEARCHLIST character set is complemented.
+If the d modifier is specified, any characters specified by SEARCHLIST that
+are not found in REPLACEMENTLIST are deleted.
+(Note that this is slightly more flexible than the behavior of some
+.I tr
+programs, which delete anything they find in the SEARCHLIST, period.)
+If the s modifier is specified, sequences of characters that were translated
+to the same character are squashed down to 1 instance of the character.
+.Sp
+If the d modifier was 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.
+.Sp
+Examples:
+.nf
+
+    $ARGV[1] \|=~ \|y/A\-Z/a\-z/;	\h'|3i'# canonicalize to lower case
+
+    $cnt = tr/*/*/;		\h'|3i'# count the stars in $_
+
+    $cnt = tr/0\-9//;		\h'|3i'# count the digits in $_
+
+    tr/a\-zA\-Z//s;	\h'|3i'# bookkeeper \-> bokeper
+
+    ($HOST = $host) =~ tr/a\-z/A\-Z/;
+
+    y/a\-zA\-Z/ /cs;	\h'|3i'# change non-alphas to single space
+
+    tr/\e200\-\e377/\e0\-\e177/;\h'|3i'# delete 8th bit
+
+.fi
+.Ip "truncate(FILEHANDLE,LENGTH)" 8 4
+.Ip "truncate(EXPR,LENGTH)" 8
+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.
+.Ip "umask(EXPR)" 8 4
+.Ip "umask EXPR" 8
+.Ip "umask" 8
+Sets the umask for the process and returns the old one.
+If EXPR is omitted, merely returns current umask.
+.Ip "undef(EXPR)" 8 6
+.Ip "undef EXPR" 8
+.Ip "undef" 8
+Undefines the value of EXPR, which must be an lvalue.
+Use only on a scalar value, an entire array, or a subroutine name (using &).
+(Undef will probably not do what you expect on most predefined variables or
+dbm array values.)
+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:
+.nf
+
+.ne 6
+	undef $foo;
+	undef $bar{'blurfl'};
+	undef @ary;
+	undef %assoc;
+	undef &mysub;
+	return (wantarray ? () : undef) if $they_blew_it;
+
+.fi
+.Ip "unlink(LIST)" 8 4
+.Ip "unlink LIST" 8
+Deletes a list of files.
+Returns the number of files successfully deleted.
+.nf
+
+.ne 2
+	$cnt = unlink \'a\', \'b\', \'c\';
+	unlink @goners;
+	unlink <*.bak>;
+
+.fi
+Note: unlink will not delete directories unless you are superuser and the
+.B \-U
+flag is supplied to
+.IR perl .
+Even if these conditions are met, be warned that unlinking a directory
+can inflict damage on your filesystem.
+Use rmdir instead.
+.Ip "unpack(TEMPLATE,EXPR)" 8 4
+Unpack does the reverse of pack: it takes a string representing
+a structure and expands it out into an array 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:
+.nf
+
+.ne 4
+	sub substr {
+		local($what,$where,$howmuch) = @_;
+		unpack("x$where a$howmuch", $what);
+	}
+
+.ne 3
+and then there's
+
+	sub ord { unpack("c",$_[0]); }
+
+.fi
+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:
+.nf
+
+.ne 4
+	while (<>) {
+	    $checksum += unpack("%16C*", $_);
+	}
+	$checksum %= 65536;
+
+.fi
+.Ip "unshift(ARRAY,LIST)" 8 4
+Does the opposite of a
+.IR shift .
+Or the opposite of a
+.IR push ,
+depending on how you look at it.
+Prepends list to the front of the array, and returns the number of elements
+in the new array.
+.nf
+
+	unshift(ARGV, \'\-e\') unless $ARGV[0] =~ /^\-/;
+
+.fi
+.Ip "utime(LIST)" 8 2
+.Ip "utime LIST" 8 2
+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 \*(L"touch\*(R" command:
+.nf
+
+.ne 3
+	#!/usr/bin/perl
+	$now = time;
+	utime $now, $now, @ARGV;
+
+.fi
+.Ip "values(ASSOC_ARRAY)" 8 6
+.Ip "values ASSOC_ARRAY" 8
+Returns a normal array consisting of all the values of the named associative
+array.
+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() and each().
+.Ip "vec(EXPR,OFFSET,BITS)" 8 2
+Treats a string as a vector of unsigned integers, and returns the value
+of the bitfield specified.
+May also be assigned to.
+BITS must be a power of two from 1 to 32.
+.Sp
+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.
+This interpretation is not enabled unless there is at least one vec() in
+your program, to protect older programs.
+.Sp
+To transform a bit vector into a string or array of 0's and 1's, use these:
+.nf
+
+	$bits = unpack("b*", $vector);
+	@bits = split(//, unpack("b*", $vector));
+
+.fi
+If you know the exact length in bits, it can be used in place of the *.
+.Ip "wait" 8 6
+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 $?.
+.Ip "waitpid(PID,FLAGS)" 8 6
+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
+.nf
+
+	require "sys/wait.h";
+	.\|.\|.
+	waitpid(-1,&WNOHANG);
+
+.fi
+then you can do a non-blocking wait for any process.  Non-blocking wait
+is only available on machines supporting either the
+.I waitpid (2)
+or
+.I 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.)
+.Ip "wantarray" 8 4
+Returns true if the context of the currently executing subroutine
+is looking for an array value.
+Returns false if the context is looking for a scalar.
+.nf
+
+	return wantarray ? () : undef;
+
+.fi
+.Ip "warn(LIST)" 8 4
+.Ip "warn LIST" 8
+Produces a message on STDERR just like \*(L"die\*(R", but doesn't exit.
+.Ip "write(FILEHANDLE)" 8 6
+.Ip "write(EXPR)" 8
+.Ip "write" 8
+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
+.IR select )
+may be set explicitly
+by assigning the name of the format to the $~ variable.
+.Sp
+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
+\*(L"_TOP\*(R" appended, but it may be dynamicallly 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.
+.Sp
+If FILEHANDLE is unspecified, output goes to the current default output channel,
+which starts out as
+.I STDOUT
+but may be changed by the
+.I 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 the section on formats later on.
+.Sp
+Note that write is NOT the opposite of read.
+.Sh "Precedence"
+.I Perl
+operators have the following associativity and precedence:
+.nf
+
+nonassoc\h'|1i'print printf exec system sort reverse
+\h'1.5i'chmod chown kill unlink utime die return
+left\h'|1i',
+right\h'|1i'= += \-= *= etc.
+right\h'|1i'?:
+nonassoc\h'|1i'.\|.
+left\h'|1i'||
+left\h'|1i'&&
+left\h'|1i'| ^
+left\h'|1i'&
+nonassoc\h'|1i'== != <=> eq ne cmp
+nonassoc\h'|1i'< > <= >= lt gt le ge
+nonassoc\h'|1i'chdir exit eval reset sleep rand umask
+nonassoc\h'|1i'\-r \-w \-x etc.
+left\h'|1i'<< >>
+left\h'|1i'+ \- .
+left\h'|1i'* / % x
+left\h'|1i'=~ !~ 
+right\h'|1i'! ~ and unary minus
+right\h'|1i'**
+nonassoc\h'|1i'++ \-\|\-
+left\h'|1i'\*(L'(\*(R'
+
+.fi
+As mentioned earlier, if any list operator (print, etc.) or
+any unary operator (chdir, etc.)
+is followed by a left parenthesis as the next token on the same line,
+the operator and arguments within parentheses are taken to
+be of highest precedence, just like a normal function call.
+Examples:
+.nf
+
+	chdir $foo || die;\h'|3i'# (chdir $foo) || die
+	chdir($foo) || die;\h'|3i'# (chdir $foo) || die
+	chdir ($foo) || die;\h'|3i'# (chdir $foo) || die
+	chdir +($foo) || die;\h'|3i'# (chdir $foo) || die
+
+but, because * is higher precedence than ||:
+
+	chdir $foo * 20;\h'|3i'# chdir ($foo * 20)
+	chdir($foo) * 20;\h'|3i'# (chdir $foo) * 20
+	chdir ($foo) * 20;\h'|3i'# (chdir $foo) * 20
+	chdir +($foo) * 20;\h'|3i'# chdir ($foo * 20)
+
+	rand 10 * 20;\h'|3i'# rand (10 * 20)
+	rand(10) * 20;\h'|3i'# (rand 10) * 20
+	rand (10) * 20;\h'|3i'# (rand 10) * 20
+	rand +(10) * 20;\h'|3i'# rand (10 * 20)
+
+.fi
+In the absence of parentheses,
+the precedence of list operators such as print, sort or 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
+.nf
+
+	@ary = (1, 3, sort 4, 2);
+	print @ary;		# prints 1324
+
+.fi
+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:
+.nf
+
+.ne 3
+	# These evaluate exit before doing the print:
+	print($foo, exit);	# Obviously not what you want.
+	print $foo, exit;	# Nor is this.
+
+.ne 4
+	# 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, "\en";
+
+.fi
+probably doesn't do what you expect at first glance.
+.Sh "Subroutines"
+A subroutine may be declared as follows:
+.nf
+
+    sub NAME BLOCK
+
+.fi
+.PP
+Any arguments passed to the routine come in as array @_,
+that is ($_[0], $_[1], .\|.\|.).
+The array @_ is a local array, but its values are references to the
+actual scalar parameters.
+The return value of the subroutine is the value of the last expression
+evaluated, and can be either an array value or a scalar value.
+Alternately, a return statement may be used to specify the returned value and
+exit the subroutine.
+To create local variables see the
+.I local
+operator.
+.PP
+A subroutine is called using the
+.I do
+operator or the & operator.
+.nf
+
+.ne 12
+Example:
+
+	sub MAX {
+		local($max) = pop(@_);
+		foreach $foo (@_) {
+			$max = $foo \|if \|$max < $foo;
+		}
+		$max;
+	}
+
+	.\|.\|.
+	$bestday = &MAX($mon,$tue,$wed,$thu,$fri);
+
+.ne 21
+Example:
+
+	# get a line, combining continuation lines
+	#  that start with whitespace
+	sub get_line {
+		$thisline = $lookahead;
+		line: while ($lookahead = <STDIN>) {
+			if ($lookahead \|=~ \|/\|^[ \^\e\|t]\|/\|) {
+				$thisline \|.= \|$lookahead;
+			}
+			else {
+				last line;
+			}
+		}
+		$thisline;
+	}
+
+	$lookahead = <STDIN>;	# get first line
+	while ($_ = do get_line(\|)) {
+		.\|.\|.
+	}
+
+.fi
+.nf
+.ne 6
+Use array assignment to a local list to name your formal arguments:
+
+	sub maybeset {
+		local($key, $value) = @_;
+		$foo{$key} = $value unless $foo{$key};
+	}
+
+.fi
+This also has the effect of turning call-by-reference into call-by-value,
+since the assignment copies the values.
+.Sp
+Subroutines may be called recursively.
+If a subroutine is called using the & form, the argument list is optional.
+If omitted, no @_ array is set up for the subroutine; the @_ array at the
+time of the call is visible to subroutine instead.
+.nf
+
+	do foo(1,2,3);		# pass three arguments
+	&foo(1,2,3);		# the same
+
+	do foo();		# pass a null list
+	&foo();			# the same
+	&foo;			# pass no arguments\*(--more efficient
+
+.fi
+.Sh "Passing By Reference"
+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 the objects of a particular name by prefixing
+the name with a star: *foo.
+When evaluated, it produces a scalar value that represents all the objects
+of that name, including any filehandle, format or subroutine.
+When assigned to within a local() operation, it causes the name mentioned
+to refer to whatever * value was assigned to it.
+Example:
+.nf
+
+	sub doubleary {
+	    local(*someary) = @_;
+	    foreach $elem (@someary) {
+		$elem *= 2;
+	    }
+	}
+	do doubleary(*foo);
+	do doubleary(*bar);
+
+.fi
+Assignment to *name is currently recommended only inside a local().
+You can actually assign to *name anywhere, but the previous referent of
+*name may be stranded forever.
+This may or may not bother you.
+.Sp
+Note that scalars are already passed by reference, so you can modify scalar
+arguments without using this mechanism by referring explicitly to the $_[nnn]
+in question.
+You can modify all the elements of an array by passing all the elements
+as scalars, but you have to use the * mechanism to push, pop or change the
+size of an array.
+The * mechanism will probably be more efficient in any case.
+.Sp
+Since a *name value contains unprintable binary data, if it is used as
+an argument in a print, or as a %s argument in a printf or sprintf, it
+then has the value '*name', just so it prints out pretty.
+.Sp
+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.
+.Sh "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 from Henry Spencer's freely redistributable
+reimplementation of the V8 routines.)
+In addition, \ew matches an alphanumeric character (including \*(L"_\*(R") and \eW a nonalphanumeric.
+Word boundaries may be matched by \eb, and non-boundaries by \eB.
+A whitespace character is matched by \es, non-whitespace by \eS.
+A numeric character is matched by \ed, non-numeric by \eD.
+You may use \ew, \es and \ed within character classes.
+Also, \en, \er, \ef, \et and \eNNN have their normal interpretations.
+Within character classes \eb represents backspace rather than a word boundary.
+Alternatives may be separated by |.
+The bracketing construct \|(\ .\|.\|.\ \|) may also be used, in which case \e<digit>
+matches the digit'th substring.
+(Outside of the pattern, always use $ instead of \e in front of the digit.
+The scope of $<digit> (and $\`, $& and $\')
+extends to the end of the enclosing BLOCK or eval string, or to
+the next pattern match with subexpressions.
+The \e<digit> notation sometimes works outside the current pattern, but should
+not be relied upon.)
+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, \e10, \e11,
+etc. refer back to substrings if there have been at least that many left parens
+before the backreference.  Otherwise (for backward compatibilty) \e10
+is the same as \e010, a backspace,
+and \e11 the same as \e011, a tab.
+And so on.
+(\e1 through \e9 are always backreferences.)
+.PP
+$+ returns whatever the last bracket match matched.
+$& returns the entire matched string.
+($0 used to return the same thing, but not any more.)
+$\` returns everything before the matched string.
+$\' returns everything after the matched string.
+Examples:
+.nf
+    
+	s/\|^\|([^ \|]*\|) \|*([^ \|]*\|)\|/\|$2 $1\|/;	# swap first two words
+
+.ne 5
+	if (/\|Time: \|(.\|.\|):\|(.\|.\|):\|(.\|.\|)\|/\|) {
+		$hours = $1;
+		$minutes = $2;
+		$seconds = $3;
+	}
+
+.fi
+By default, the ^ character is only guaranteed to match at the beginning
+of the string,
+the $ character only at the end (or before the newline at the end)
+and
+.I perl
+does certain optimizations with the assumption that the string contains
+only one line.
+The behavior of ^ and $ on embedded newlines will be inconsistent.
+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 setting the variable
+$* to 1.
+Setting it back to 0 makes
+.I perl
+revert to its old behavior.
+.PP
+To facilitate multi-line substitutions, the . character never matches a newline
+(even when $* is 0).
+In particular, the following leaves a newline on the $_ string:
+.nf
+
+	$_ = <STDIN>;
+	s/.*(some_string).*/$1/;
+
+If the newline is unwanted, try one of
+
+	s/.*(some_string).*\en/$1/;
+	s/.*(some_string)[^\e000]*/$1/;
+	s/.*(some_string)(.|\en)*/$1/;
+	chop; s/.*(some_string).*/$1/;
+	/(some_string)/ && ($_ = $1);
+
+.fi
+Any item of a regular expression may be followed with digits in curly brackets
+of the form {n,m}, where n gives the minimum number of times to match the item
+and m gives the maximum.
+The form {n} is equivalent to {n,n} and matches exactly n times.
+The form {n,} matches n or more times.
+(If a curly bracket occurs in any other context, it is treated as a regular
+character.)
+The * modifier is equivalent to {0,}, the + modifier to {1,} and the ? modifier
+to {0,1}.
+There is no limit to the size of n or m, but large numbers will chew up
+more memory.
+.Sp
+You will note that all backslashed metacharacters in
+.I perl
+are alphanumeric,
+such as \eb, \ew, \en.
+Unlike some other regular expression languages, there are no backslashed
+symbols that aren't alphanumeric.
+So anything that looks like \e\e, \e(, \e), \e<, \e>, \e{, or \e} 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:
+.nf
+
+	$pattern =~ s/(\eW)/\e\e$1/g;
+
+.fi
+.Sh "Formats"
+Output record formats for use with the
+.I write
+operator may declared as follows:
+.nf
+
+.ne 3
+    format NAME =
+    FORMLIST
+    .
+
+.fi
+If name is omitted, format \*(L"STDOUT\*(R" is defined.
+FORMLIST consists of a sequence of lines, each of which may be of one of three
+types:
+.Ip 1. 4
+A comment.
+.Ip 2. 4
+A \*(L"picture\*(R" line giving the format for one output line.
+.Ip 3. 4
+An argument line supplying values to plug into a picture line.
+.PP
+Picture lines are printed exactly as they look, except for certain fields
+that substitute values into the line.
+Each picture field starts with either @ or ^.
+The @ field (not to be confused with the array marker @) is the normal
+case; ^ 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.
+As an alternate form of right justification,
+you may also use # characters (with an optional .) to specify a numeric field.
+(Use of ^ instead of @ causes the field to be blanked if undefined.)
+If any of the values supplied for these fields contains a newline, only
+the text up to the newline is printed.
+The special field @* can be used for printing multi-line values.
+It should appear by itself on a line.
+.PP
+The values are specified on the following line, in the same order as
+the picture fields.
+The values should be separated by commas.
+.PP
+Picture fields that begin with ^ rather than @ are treated specially.
+The value supplied must be a scalar variable name which contains a text
+string.
+.I 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.
+Normally you would use a sequence of fields in a vertical stack to print
+out a block of text.
+If you like, you can end the final field with .\|.\|., 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 $: to a list of the desired characters.
+.PP
+Since use of ^ fields can produce variable length records if the text to be
+formatted is short, you can suppress blank lines by putting the tilde (~)
+character anywhere in the line.
+(Normally you should put it in the front if possible, for visibility.)
+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 @ variety, the expression you supply had better
+not give the same value every time forever!)
+.PP
+Examples:
+.nf
+.lg 0
+.cs R 25
+.ft C
+
+.ne 10
+# 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
+\&.
+
+.ne 29
+# 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
+\&.
+
+.ft R
+.cs R
+.lg
+.fi
+It is possible to intermix prints with writes on the same output channel,
+but you'll have to handle $\- (lines left on the page) yourself.
+.PP
+If you are printing lots of fields that are usually blank, you should consider
+using the reset operator between records.
+Not only is it more efficient, but it can prevent the bug of adding another
+field and forgetting to zero it.
+.Sh "Interprocess Communication"
+The IPC facilities of perl are built on the Berkeley socket mechanism.
+If you don't have sockets, you can ignore this section.
+The calls have the same names as the corresponding system calls,
+but the arguments tend to differ, for two reasons.
+First, perl file handles work differently than C file descriptors.
+Second, perl already knows the length of its strings, so you don't need
+to pass that information.
+Here is a sample client (untested):
+.nf
+
+	($them,$port) = @ARGV;
+	$port = 2345 unless $port;
+	$them = 'localhost' unless $them;
+
+	$SIG{'INT'} = 'dokill';
+	sub dokill { kill 9,$child if $child; }
+
+	require 'sys/socket.ph';
+
+	$sockaddr = 'S n a4 x8';
+	chop($hostname = `hostname`);
+
+	($name, $aliases, $proto) = getprotobyname('tcp');
+	($name, $aliases, $port) = getservbyname($port, 'tcp')
+		unless $port =~ /^\ed+$/;
+.ie t \{\
+	($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
+'br\}
+.el \{\
+	($name, $aliases, $type, $len, $thisaddr) =
+					gethostbyname($hostname);
+'br\}
+	($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
+
+	$this = pack($sockaddr, &AF_INET, 0, $thisaddr);
+	$that = pack($sockaddr, &AF_INET, $port, $thataddr);
+
+	socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
+	bind(S, $this) || die "bind: $!";
+	connect(S, $that) || die "connect: $!";
+
+	select(S); $| = 1; select(stdout);
+
+	if ($child = fork) {
+		while (<>) {
+			print S;
+		}
+		sleep 3;
+		do dokill();
+	}
+	else {
+		while (<S>) {
+			print;
+		}
+	}
+
+.fi
+And here's a server:
+.nf
+
+	($port) = @ARGV;
+	$port = 2345 unless $port;
+
+	require 'sys/socket.ph';
+
+	$sockaddr = 'S n a4 x8';
+
+	($name, $aliases, $proto) = getprotobyname('tcp');
+	($name, $aliases, $port) = getservbyname($port, 'tcp')
+		unless $port =~ /^\ed+$/;
+
+	$this = pack($sockaddr, &AF_INET, $port, "\e0\e0\e0\e0");
+
+	select(NS); $| = 1; select(stdout);
+
+	socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
+	bind(S, $this) || die "bind: $!";
+	listen(S, 5) || die "connect: $!";
+
+	select(S); $| = 1; select(stdout);
+
+	for (;;) {
+		print "Listening again\en";
+		($addr = accept(NS,S)) || die $!;
+		print "accept ok\en";
+
+		($af,$port,$inetaddr) = unpack($sockaddr,$addr);
+		@inetaddr = unpack('C4',$inetaddr);
+		print "$af $port @inetaddr\en";
+
+		while (<NS>) {
+			print;
+			print NS;
+		}
+	}
+
+.fi
+.Sh "Predefined Names"
+The following names have special meaning to
+.IR perl .
+I could have used alphabetic symbols for some of these, but I didn't want
+to take the chance that someone would say reset \*(L"a\-zA\-Z\*(R" and wipe them all
+out.
+You'll just have to suffer along with these silly symbols.
+Most of them have reasonable mnemonics, or analogues in one of the shells.
+.Ip $_ 8
+The default input and pattern-searching space.
+The following pairs are equivalent:
+.nf
+
+.ne 2
+	while (<>) {\|.\|.\|.	# only equivalent in while!
+	while ($_ = <>) {\|.\|.\|.
+
+.ne 2
+	/\|^Subject:/
+	$_ \|=~ \|/\|^Subject:/
+
+.ne 2
+	y/a\-z/A\-Z/
+	$_ =~ y/a\-z/A\-Z/
+
+.ne 2
+	chop
+	chop($_)
+
+.fi 
+(Mnemonic: underline is understood in certain operations.)
+.Ip $. 8
+The current input line number of the last filehandle that was read.
+Readonly.
+Remember that only an explicit close on the filehandle resets the line number.
+Since <> never does an explicit close, line numbers increase across ARGV files
+(but see examples under eof).
+(Mnemonic: many programs use . to mean the current line number.)
+.Ip $/ 8
+The input record separator, newline by default.
+Works like
+.IR 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 "\en\en" means something slightly different
+than setting it to "", if the file contains consecutive blank lines.
+Setting it to "" will treat two or more consecutive blank lines as a single
+blank line.
+Setting it to "\en\en" 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.)
+.Ip $, 8
+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
+.IR awk ,
+set this variable as you would set
+.IR awk 's
+OFS variable to specify what is printed between fields.
+(Mnemonic: what is printed when there is a , in your print statement.)
+.Ip $"" 8
+This is like $, 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.)
+.Ip $\e 8
+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
+.IR awk ,
+set this variable as you would set
+.IR awk 's
+ORS variable to specify what is printed at the end of the print.
+(Mnemonic: you set $\e instead of adding \en at the end of the print.
+Also, it's just like /, but it's what you get \*(L"back\*(R" from
+.IR perl .)
+.Ip $# 8
+The output format for printed numbers.
+This variable is a half-hearted attempt to emulate
+.IR awk 's
+OFMT variable.
+There are times, however, when
+.I awk
+and
+.I perl
+have differing notions of what
+is in fact numeric.
+Also, the initial value is %.20g rather than %.6g, so you need to set $#
+explicitly to get
+.IR awk 's
+value.
+(Mnemonic: # is the number sign.)
+.Ip $% 8
+The current page number of the currently selected output channel.
+(Mnemonic: % is page number in nroff.)
+.Ip $= 8
+The current page length (printable lines) of the currently selected output
+channel.
+Default is 60.
+(Mnemonic: = has horizontal lines.)
+.Ip $\- 8
+The number of lines left on the page of the currently selected output channel.
+(Mnemonic: lines_on_page \- lines_printed.)
+.Ip $~ 8
+The name of the current report format for the currently selected output
+channel.
+Default is name of the filehandle.
+(Mnemonic: brother to $^.)
+.Ip $^ 8
+The name of the current top-of-page format for the currently selected output
+channel.
+Default is name of the filehandle with \*(L"_TOP\*(R" appended.
+(Mnemonic: points to top of page.)
+.Ip $| 8
+If set to nonzero, forces a flush after every write or print on the currently
+selected output channel.
+Default is 0.
+Note that
+.I 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
+.I perl
+script under rsh and want to see the
+output as it's happening.
+(Mnemonic: when you want your pipes to be piping hot.)
+.Ip $$ 8
+The process number of the
+.I perl
+running this script.
+(Mnemonic: same as shells.)
+.Ip $? 8
+The status returned by the last pipe close, backtick (\`\`) command or
+.I system
+operator.
+Note that this is the status word returned by the wait() system
+call, so the exit value of the subprocess is actually ($? >> 8).
+$? & 255 gives which signal, if any, the process died from, and whether
+there was a core dump.
+(Mnemonic: similar to sh and ksh.)
+.Ip $& 8 4
+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.)
+.Ip $\` 8 4
+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.)
+.Ip $\' 8 4
+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:
+.nf
+
+.ne 3
+	$_ = \'abcdefghi\';
+	/def/;
+	print "$\`:$&:$\'\en";  	# prints abc:def:ghi
+
+.fi
+.Ip $+ 8 4
+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:
+.nf
+
+    /Version: \|(.*\|)|Revision: \|(.*\|)\|/ \|&& \|($rev = $+);
+
+.fi
+(Mnemonic: be positive and forward looking.)
+.Ip $* 8 2
+Set to 1 to do multiline matching within a string, 0 to tell
+.I 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 $* is 0.
+Default is 0.
+(Mnemonic: * matches multiple things.)
+Note that this variable only influences the interpretation of ^ and $.
+A literal newline can be searched for even when $* == 0.
+.Ip $0 8
+Contains the name of the file containing the
+.I perl
+script being executed.
+Assigning to $0 modifies the argument area that the ps(1) program sees.
+(Mnemonic: same as sh and ksh.)
+.Ip $<digit> 8
+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 \edigit.)
+.Ip $[ 8 2
+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
+.I perl
+behave more like
+.I awk
+(or Fortran)
+when subscripting and when evaluating the index() and substr() functions.
+(Mnemonic: [ begins subscripts.)
+.Ip $] 8 2
+The string printed out when you say \*(L"perl -v\*(R".
+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:
+.nf
+
+.ne 8
+	# see if getc is available
+        ($version,$patchlevel) =
+		 $] =~ /(\ed+\e.\ed+).*\enPatch level: (\ed+)/;
+        print STDERR "(No filename completion available.)\en"
+		 if $version * 1000 + $patchlevel < 2016;
+
+or, used numerically,
+
+	warn "No checksumming!\en" if $] < 3.019;
+
+.fi
+(Mnemonic: Is this version of perl in the right bracket?)
+.Ip $; 8 2
+The subscript separator for multi-dimensional array emulation.
+If you refer to an associative array element as
+.nf
+	$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})
+
+.fi
+Default is "\e034", the same as SUBSEP in
+.IR awk .
+Note that if your keys contain binary data there might not be any safe
+value for $;.
+(Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon.
+Yeah, I know, it's pretty lame, but $, is already taken for something more
+important.)
+.Ip $! 8 2
+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 $! 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 $! in order to set errno
+if, for instance, you want $! to return the string for error n, or you want
+to set the exit value for the die operator.
+(Mnemonic: What just went bang?)
+.Ip $@ 8 2
+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 \*(L"at\*(R"?)
+.Ip $< 8 2
+The real uid of this process.
+(Mnemonic: it's the uid you came FROM, if you're running setuid.)
+.Ip $> 8 2
+The effective uid of this process.
+Example:
+.nf
+
+.ne 2
+	$< = $>;	# set real uid to the effective uid
+	($<,$>) = ($>,$<);	# swap real and effective uid
+
+.fi
+(Mnemonic: it's the uid you went TO, if you're running setuid.)
+Note: $< and $> can only be swapped on machines supporting setreuid().
+.Ip $( 8 2
+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 GROUP things.
+The real gid is the group you LEFT, if you're running setgid.)
+.Ip $) 8 2
+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 GROUP things.
+The effective gid is the group that's RIGHT for you, if you're running setgid.)
+.Sp
+Note: $<, $>, $( and $) can only be set on machines that support the
+corresponding set[re][ug]id() routine.
+$( and $) can only be swapped on machines supporting setregid().
+.Ip $: 8 2
+The current set of characters after which a string may be broken to
+fill continuation fields (starting with ^) in a format.
+Default is "\ \en-", to break on whitespace or hyphens.
+(Mnemonic: a \*(L"colon\*(R" in poetry is a part of a line.)
+.Ip $^D 8 2
+The current value of the debugging flags.
+(Mnemonic: value of
+.B \-D
+switch.)
+.Ip $^F 8 2
+The maximum system file descriptor, ordinarily 2.  System file descriptors
+are passed to subprocesses, while higher file descriptors are not.
+During an open, system file descriptors are preserved even if the open
+fails.  Ordinary file descriptors are closed before the open is attempted.
+.Ip $^I 8 2
+The current value of the inplace-edit extension.
+Use undef to disable inplace editing.
+(Mnemonic: value of
+.B \-i
+switch.)
+.Ip $^L 8 2
+What formats output to perform a formfeed.  Default is \ef.
+.Ip $^P 8 2
+The internal flag that the debugger clears so that it doesn't
+debug itself.  You could conceivable disable debugging yourself
+by clearing it.
+.Ip $^T 8 2
+The time at which the script began running, in seconds since the epoch.
+The values returned by the
+.B \-M ,
+.B \-A
+and
+.B \-C
+filetests are based on this value.
+.Ip $^W 8 2
+The current value of the warning switch.
+(Mnemonic: related to the
+.B \-w
+switch.)
+.Ip $^X 8 2
+The name that Perl itself was executed as, from argv[0].
+.Ip $ARGV 8 3
+contains the name of the current file when reading from <>.
+.Ip @ARGV 8 3
+The array ARGV contains the command line arguments intended for the script.
+Note that $#ARGV is the generally number of arguments minus one, since
+$ARGV[0] is the first argument, NOT the command name.
+See $0 for the command name.
+.Ip @INC 8 3
+The array INC contains the list of places to look for
+.I perl
+scripts to be
+evaluated by the \*(L"do EXPR\*(R" command or the \*(L"require\*(R" command.
+It initially consists of the arguments to any
+.B \-I
+command line switches, followed
+by the default
+.I perl
+library, probably \*(L"/usr/local/lib/perl\*(R",
+followed by \*(L".\*(R", to represent the current directory.
+.Ip %INC 8 3
+The associative array INC contains entries for each filename that has
+been included via \*(L"do\*(R" or \*(L"require\*(R".
+The key is the filename you specified, and the value is the location of
+the file actually found.
+The \*(L"require\*(R" command uses this array to determine whether
+a given file has already been included.
+.Ip $ENV{expr} 8 2
+The associative array ENV contains your current environment.
+Setting a value in ENV changes the environment for child processes.
+.Ip $SIG{expr} 8 2
+The associative array SIG is used to set signal handlers for various signals.
+Example:
+.nf
+
+.ne 12
+	sub handler {	# 1st argument is signal name
+		local($sig) = @_;
+		print "Caught a SIG$sig\-\|\-shutting down\en";
+		close(LOG);
+		exit(0);
+	}
+
+	$SIG{\'INT\'} = \'handler\';
+	$SIG{\'QUIT\'} = \'handler\';
+	.\|.\|.
+	$SIG{\'INT\'} = \'DEFAULT\';	# restore default action
+	$SIG{\'QUIT\'} = \'IGNORE\';	# ignore SIGQUIT
+
+.fi
+The SIG array only contains values for the signals actually set within
+the perl script.
+.Sh "Packages"
+Perl provides a mechanism for alternate namespaces to protect packages from
+stomping on each others variables.
+By default, a perl script starts compiling into the package known as \*(L"main\*(R".
+By use of the
+.I package
+declaration, you can switch namespaces.
+The scope of the package declaration is from the declaration itself to the end
+of the enclosing block (the same scope as the local() operator).
+Typically it would be the first declaration in a file to be included by
+the \*(L"require\*(R" 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 single quote.
+If the package name is null, the \*(L"main\*(R" package as assumed.
+.PP
+Only identifiers starting with letters are stored in the packages symbol
+table.
+All other symbols are kept in package \*(L"main\*(R".
+In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC
+and SIG are forced to be in package \*(L"main\*(R", even when used for
+other purposes than their built-in one.
+Note also that, if you have a package called \*(L"m\*(R", \*(L"s\*(R"
+or \*(L"y\*(R", the you can't use the qualified form of an identifier since it
+will be interpreted instead as a pattern match, a substitution
+or a translation.
+.PP
+Eval'ed strings are compiled in the package in which the eval was compiled
+in.
+(Assignments to $SIG{}, however, assume the signal handler specified is in the
+main package.
+Qualify the signal handler name if you wish to have a signal handler in
+a package.)
+For an example, examine perldb.pl in the perl library.
+It initially switches to the 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 main package
+to evaluate various expressions in the context of the main package.
+.PP
+The symbol table for a package happens to be stored in the associative array
+of that name prepended with an underscore.
+The value in each entry of the associative array is
+what you are referring to when you use the *name notation.
+In fact, the following have the same effect (in package main, anyway),
+though the first is more
+efficient because it does the symbol table lookups at compile time:
+.nf
+
+.ne 2
+	local(*foo) = *bar;
+	local($_main{'foo'}) = $_main{'bar'};
+
+.fi
+You can use this to print out all the variables in a package, for instance.
+Here is dumpvar.pl from the perl library:
+.nf
+.ne 11
+	package dumpvar;
+
+	sub main'dumpvar {
+	\&    ($package) = @_;
+	\&    local(*stab) = eval("*_$package");
+	\&    while (($key,$val) = each(%stab)) {
+	\&        {
+	\&            local(*entry) = $val;
+	\&            if (defined $entry) {
+	\&                print "\e$$key = '$entry'\en";
+	\&            }
+.ne 7
+	\&            if (defined @entry) {
+	\&                print "\e@$key = (\en";
+	\&                foreach $num ($[ .. $#entry) {
+	\&                    print "  $num\et'",$entry[$num],"'\en";
+	\&                }
+	\&                print ")\en";
+	\&            }
+.ne 10
+	\&            if ($key ne "_$package" && defined %entry) {
+	\&                print "\e%$key = (\en";
+	\&                foreach $key (sort keys(%entry)) {
+	\&                    print "  $key\et'",$entry{$key},"'\en";
+	\&                }
+	\&                print ")\en";
+	\&            }
+	\&        }
+	\&    }
+	}
+
+.fi
+Note that, even though the subroutine is compiled in package dumpvar, the
+name of the subroutine is qualified so that its name is inserted into package
+\*(L"main\*(R".
+.Sh "Style"
+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.
+.Ip 1. 4 4
+Just because you CAN do something a particular way doesn't mean that
+you SHOULD do it that way.
+.I 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\en" if $verbose;
+
+is better than
+
+	$verbose && print "Starting analysis\en";
+
+since the main point isn't whether the user typed -v or not.
+.Sp
+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.
+.Sp
+Along the same lines, just because you
+.I can
+omit parentheses in many places doesn't mean that you ought to:
+.nf
+
+	return print reverse sort num values array;
+	return print(reverse(sort num (values(%array))));
+
+.fi
+When in doubt, parenthesize.
+At the very least it will let some poor schmuck bounce on the % key in vi.
+.Sp
+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.
+.Ip 2. 4 4
+Don't go through silly contortions to exit a loop at the top or the
+bottom, when
+.I perl
+provides the "last" operator so you can exit in the middle.
+Just outdent it a little to make it more visible:
+.nf
+
+.ne 7
+    line:
+	for (;;) {
+	    statements;
+	last line if $foo;
+	    next line if /^#/;
+	    statements;
+	}
+
+.fi
+.Ip 3. 4 4
+Don't be afraid to use loop labels\*(--they're there to enhance readability as
+well as to allow multi-level loop breaks.
+See last example.
+.Ip 4. 4 4
+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 $] to see if it will be there.
+.Ip 5. 4 4
+Choose mnemonic identifiers.
+.Ip 6. 4 4
+Be consistent.
+.Sh "Debugging"
+If you invoke
+.I perl
+with a
+.B \-d
+switch, your script will be run under a debugging monitor.
+It will halt before the first executable statement and ask you for a
+command, such as:
+.Ip "h" 12 4
+Prints out a help message.
+.Ip "T" 12 4
+Stack trace.
+.Ip "s" 12 4
+Single step.
+Executes until it reaches the beginning of another statement.
+.Ip "n" 12 4
+Next.
+Executes over subroutine calls, until it reaches the beginning of the 
+next statement.
+.Ip "f" 12 4
+Finish.
+Executes statements until it has finished the current subroutine.
+.Ip "c" 12 4
+Continue.
+Executes until the next breakpoint is reached.
+.Ip "c line" 12 4
+Continue to the specified line.
+Inserts a one-time-only breakpoint at the specified line.
+.Ip "<CR>" 12 4
+Repeat last n or s.
+.Ip "l min+incr" 12 4
+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.
+.Ip "l min-max" 12 4
+List lines in the indicated range.
+.Ip "l line" 12 4
+List just the indicated line.
+.Ip "l" 12 4
+List next window.
+.Ip "-" 12 4
+List previous window.
+.Ip "w line" 12 4
+List window around line.
+.Ip "l subname" 12 4
+List subroutine.
+If it's a long subroutine it just lists the beginning.
+Use \*(L"l\*(R" to list more.
+.Ip "/pattern/" 12 4
+Regular expression search forward for pattern; the final / is optional.
+.Ip "?pattern?" 12 4
+Regular expression search backward for pattern; the final ? is optional.
+.Ip "L" 12 4
+List lines that have breakpoints or actions.
+.Ip "S" 12 4
+Lists the names of all subroutines.
+.Ip "t" 12 4
+Toggle trace mode on or off.
+.Ip "b line condition" 12 4
+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.
+.Ip "b subname condition" 12 4
+Set breakpoint at first executable line of subroutine.
+.Ip "d line" 12 4
+Delete breakpoint.
+If line is omitted, deletes the breakpoint on the 
+line that is about to be executed.
+.Ip "D" 12 4
+Delete all breakpoints.
+.Ip "a line command" 12 4
+Set an action for line.
+A multi-line command may be entered by backslashing the newlines.
+.Ip "A" 12 4
+Delete all line actions.
+.Ip "< command" 12 4
+Set an action to happen before every debugger prompt.
+A multi-line command may be entered by backslashing the newlines.
+.Ip "> command" 12 4
+Set an action to happen after the prompt when you've just given a command
+to return to executing the script.
+A multi-line command may be entered by backslashing the newlines.
+.Ip "V package" 12 4
+List all variables in package.
+Default is main package.
+.Ip "! number" 12 4
+Redo a debugging command.
+If number is omitted, redoes the previous command.
+.Ip "! -number" 12 4
+Redo the command that was that many commands ago.
+.Ip "H -number" 12 4
+Display last n commands.
+Only commands longer than one character are listed.
+If number is omitted, lists them all.
+.Ip "q or ^D" 12 4
+Quit.
+.Ip "command" 12 4
+Execute command as a perl statement.
+A missing semicolon will be supplied.
+.Ip "p expr" 12 4
+Same as \*(L"print DB'OUT expr\*(R".
+The DB'OUT filehandle is opened to /dev/tty, regardless of where STDOUT
+may be redirected to.
+.PP
+If you want to modify the debugger, copy perldb.pl from the perl library
+to your current directory and modify it as necessary.
+(You'll also have to put -I. on your command line.)
+You can do some customization by setting up a .perldb file which contains
+initialization code.
+For instance, you could make aliases like these:
+.nf
+
+    $DB'alias{'len'} = 's/^len(.*)/p length($1)/';
+    $DB'alias{'stop'} = 's/^stop (at|in)/b/';
+    $DB'alias{'.'} =
+      's/^\e./p "\e$DB\e'sub(\e$DB\e'line):\et",\e$DB\e'line[\e$DB\e'line]/';
+
+.fi
+.Sh "Setuid Scripts"
+.I 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,
+.I perl
+uses a more conventional evaluation scheme with fewer hidden \*(L"gotchas\*(R".
+Additionally, since the language has more built-in functionality, it
+has to rely less upon external (and possibly untrustworthy) programs to
+accomplish its purposes.
+.PP
+In an unpatched 4.2 or 4.3bsd kernel, setuid scripts are intrinsically
+insecure, but this kernel feature can be disabled.
+If it is,
+.I perl
+can emulate the setuid and setgid mechanism when it notices the otherwise
+useless setuid/gid bits on perl scripts.
+If the kernel feature isn't disabled,
+.I 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.
+.PP
+When perl is executing a setuid script, it 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
+\*(L"tainted\*(R", 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:
+.nf
+
+.ne 5
+	$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
+
+.ne 4
+	system "echo $foo";		# Insecure
+	system "/bin/echo", $foo;	# Secure (doesn't use sh)
+	system "echo $bar";		# Insecure
+	system "echo $abc";		# Insecure until PATH set
+
+.ne 5
+	$ENV{\'PATH\'} = \'/bin:/usr/bin\';
+	$ENV{\'IFS\'} = \'\' if $ENV{\'IFS\'} ne \'\';
+
+	$path = $ENV{\'PATH\'};	# Not tainted
+	system "echo $abc";		# Is secure now!
+
+.ne 5
+	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
+
+.ne 3
+	exec "echo $foo";		# Insecure
+	exec "echo", $foo;		# Secure (doesn't use sh)
+	exec "sh", \'-c\', $foo;	# Considered secure, alas
+
+.fi
+The taintedness is associated with each scalar value, so some elements
+of an array can be tainted, and others not.
+.PP
+If you try to do something insecure, you will get a fatal error saying 
+something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R".
+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\*(--\c
+.I perl
+presumes that if you reference a substring using $1, $2, etc, you knew
+what you were doing when you wrote the pattern:
+.nf
+
+	$ARGV[0] =~ /^\-P(\ew+)$/;
+	$printer = $1;		# Not tainted
+
+.fi
+This is fairly secure since \ew+ doesn't match shell metacharacters.
+Use of .+ would have been insecure, but
+.I perl
+doesn't check for that, so you must be careful with your patterns.
+This is the ONLY mechanism for untainting user supplied filenames if you
+want to do file operations on them (unless you make $> equal to $<).
+.PP
+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 $> = $<.
+.I 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.
+.SH ENVIRONMENT
+.Ip HOME 12 4
+Used if chdir has no argument.
+.Ip LOGDIR 12 4
+Used if chdir has no argument and HOME is not set.
+.Ip PATH 12 4
+Used in executing subprocesses, and in finding the script if \-S
+is used.
+.Ip PERLLIB 12 4
+A colon-separated list of directories in which to look for Perl library
+files before looking in the standard library and the current directory.
+.Ip PERLDB 12 4
+The command used to get the debugger code.  If unset, uses
+.br
+
+	require 'perldb.pl'
+
+.PP
+Apart from these,
+.I 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:
+.nf
+
+.ne 3
+    $ENV{\'PATH\'} = \'/bin:/usr/bin\';    # or whatever you need
+    $ENV{\'SHELL\'} = \'/bin/sh\' if $ENV{\'SHELL\'} ne \'\';
+    $ENV{\'IFS\'} = \'\' if $ENV{\'IFS\'} ne \'\';
+
+.fi
+.SH AUTHOR
+Larry Wall <lwall@netlabs.com>
+.br
+MS-DOS port by Diomidis Spinellis <dds@cc.ic.ac.uk>
+.SH FILES
+/tmp/perl\-eXXXXXX	temporary file for
+.B \-e
+commands.
+.SH SEE ALSO
+a2p	awk to perl translator
+.br
+s2p	sed to perl translator
+.SH 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
+.I perl
+via
+.B \-e
+switches, each
+.B \-e
+is counted as one line.)
+.PP
+Setuid scripts have additional constraints that can produce error messages
+such as \*(L"Insecure dependency\*(R".
+See the section on setuid scripts.
+.SH TRAPS
+Accustomed
+.IR awk
+users should take special note of the following:
+.Ip * 4 2
+Semicolons are required after all simple statements in
+.I perl
+(except at the end of a block).
+Newline is not a statement delimiter.
+.Ip * 4 2
+Curly brackets are required on ifs and whiles.
+.Ip * 4 2
+Variables begin with $ or @ in
+.IR perl .
+.Ip * 4 2
+Arrays index from 0 unless you set $[.
+Likewise string positions in substr() and index().
+.Ip * 4 2
+You have to decide whether your array has numeric or string indices.
+.Ip * 4 2
+Associative array values do not spring into existence upon mere reference.
+.Ip * 4 2
+You have to decide whether you want to use string or numeric comparisons.
+.Ip * 4 2
+Reading an input line does not split it for you.  You get to split it yourself
+to an array.
+And the
+.I split
+operator has different arguments.
+.Ip * 4 2
+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.)
+.Ip * 4 2
+$<digit> does not refer to fields\*(--it refers to substrings matched by the last
+match pattern.
+.Ip * 4 2
+The
+.I print
+statement does not add field and record separators unless you set
+$, and $\e.
+.Ip * 4 2
+You must open your files before you print to them.
+.Ip * 4 2
+The range operator is \*(L".\|.\*(R", not comma.
+(The comma operator works as in C.)
+.Ip * 4 2
+The match operator is \*(L"=~\*(R", not \*(L"~\*(R".
+(\*(L"~\*(R" is the one's complement operator, as in C.)
+.Ip * 4 2
+The exponentiation operator is \*(L"**\*(R", not \*(L"^\*(R".
+(\*(L"^\*(R" is the XOR operator, as in C.)
+.Ip * 4 2
+The concatenation operator is \*(L".\*(R", not the null string.
+(Using the null string would render \*(L"/pat/ /pat/\*(R" 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.)
+.Ip * 4 2
+.IR Next ,
+.I exit
+and
+.I continue
+work differently.
+.Ip * 4 2
+The following variables work differently
+.nf
+
+	  Awk	\h'|2.5i'Perl
+	  ARGC	\h'|2.5i'$#ARGV
+	  ARGV[0]	\h'|2.5i'$0
+	  FILENAME\h'|2.5i'$ARGV
+	  FNR	\h'|2.5i'$. \- something
+	  FS	\h'|2.5i'(whatever you like)
+	  NF	\h'|2.5i'$#Fld, or some such
+	  NR	\h'|2.5i'$.
+	  OFMT	\h'|2.5i'$#
+	  OFS	\h'|2.5i'$,
+	  ORS	\h'|2.5i'$\e
+	  RLENGTH	\h'|2.5i'length($&)
+	  RS	\h'|2.5i'$/
+	  RSTART	\h'|2.5i'length($\`)
+	  SUBSEP	\h'|2.5i'$;
+
+.fi
+.Ip * 4 2
+When in doubt, run the
+.I awk
+construct through a2p and see what it gives you.
+.PP
+Cerebral C programmers should take note of the following:
+.Ip * 4 2
+Curly brackets are required on ifs and whiles.
+.Ip * 4 2
+You should use \*(L"elsif\*(R" rather than \*(L"else if\*(R"
+.Ip * 4 2
+.I Break
+and
+.I continue
+become
+.I last
+and
+.IR next ,
+respectively.
+.Ip * 4 2
+There's no switch statement.
+.Ip * 4 2
+Variables begin with $ or @ in
+.IR perl .
+.Ip * 4 2
+Printf does not implement *.
+.Ip * 4 2
+Comments begin with #, not /*.
+.Ip * 4 2
+You can't take the address of anything.
+.Ip * 4 2
+ARGV must be capitalized.
+.Ip * 4 2
+The \*(L"system\*(R" calls link, unlink, rename, etc. return nonzero for success, not 0.
+.Ip * 4 2
+Signal handlers deal with signal names, not numbers.
+.PP
+Seasoned
+.I sed
+programmers should take note of the following:
+.Ip * 4 2
+Backreferences in substitutions use $ rather than \e.
+.Ip * 4 2
+The pattern matching metacharacters (, ), and | do not have backslashes in front.
+.Ip * 4 2
+The range operator is .\|. rather than comma.
+.PP
+Sharp shell programmers should take note of the following:
+.Ip * 4 2
+The backtick operator does variable interpretation without regard to the
+presence of single quotes in the command.
+.Ip * 4 2
+The backtick operator does no translation of the return value, unlike csh.
+.Ip * 4 2
+Shells (especially csh) do several levels of substitution on each command line.
+.I Perl
+does substitution only in certain constructs such as double quotes,
+backticks, angle brackets and search patterns.
+.Ip * 4 2
+Shells interpret scripts a little bit at a time.
+.I Perl
+compiles the whole program before executing it.
+.Ip * 4 2
+The arguments are available via @ARGV, not $1, $2, etc.
+.Ip * 4 2
+The environment is not automatically made available as variables.
+.SH ERRATA\0AND\0ADDENDA
+The Perl book,
+.I Programming\0Perl ,
+has the following omissions and goofs.
+.PP
+On page 5, the examples which read
+.nf
+
+	eval "/usr/bin/perl
+
+should read
+
+	eval "exec /usr/bin/perl
+
+.fi
+.PP
+On page 195, the equivalent to the System V sum program only works for
+very small files.  To do larger files, use
+.nf
+
+	undef $/;
+	$checksum = unpack("%32C*",<>) % 32767;
+
+.fi
+.PP
+The descriptions of alarm and sleep refer to signal SIGALARM.  These
+should refer to SIGALRM.
+.PP
+The
+.B \-0
+switch to set the initial value of $/ was added to Perl after the book
+went to press.
+.PP
+The
+.B \-l
+switch now does automatic line ending processing.
+.PP
+The qx// construct is now a synonym for backticks.
+.PP
+$0 may now be assigned to set the argument displayed by
+.I ps (1).
+.PP
+The new @###.## format was omitted accidentally from the description
+on formats.
+.PP
+It wasn't known at press time that s///ee caused multiple evaluations of
+the replacement expression.  This is to be construed as a feature.
+.PP
+(LIST) x $count now does array replication.
+.PP
+There is now no limit on the number of parentheses in a regular expression.
+.PP
+In double-quote context, more escapes are supported: \ee, \ea, \ex1b, \ec[,
+\el, \eL, \eu, \eU, \eE.  The latter five control up/lower case translation.
+.PP
+The
+.B $/
+variable may now be set to a multi-character delimiter.
+.PP
+There is now a g modifier on ordinary pattern matching that causes it
+to iterate through a string finding multiple matches.
+.PP
+All of the $^X variables are new except for $^T.
+.PP
+The default top-of-form format for FILEHANDLE is now FILEHANDLE_TOP rather
+than top.
+.PP
+The eval {} and sort {} constructs were added in version 4.018.
+.PP
+The v and V (little-endian) template options for pack and unpack were
+added in 4.019.
+.SH BUGS
+.PP
+.I Perl
+is at the mercy of your machine's definitions of various operations
+such as type casting, atof() and sprintf().
+.PP
+If your stdio requires an seek or eof between reads and writes on a particular
+stream, so does
+.IR perl .
+(This doesn't apply to sysread() and syswrite().)
+.PP
+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 \-S.
+A regular expression may not compile to more than 32767 bytes internally.
+.PP
+.I Perl
+actually stands for Pathologically Eclectic Rubbish Lister, but don't tell
+anyone I said that.
+.rn }` ''
diff --git a/gnu/usr.bin/perl/perl/perl.c b/gnu/usr.bin/perl/perl/perl.c
new file mode 100644
index 000000000000..a963db8b0e77
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/perl.c
@@ -0,0 +1,1449 @@
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:37 $\nPatch level: ###\n";
+/*
+ *    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: perl.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:37  nate
+ * PERL!
+ *
+ * Revision 4.0.1.8  1993/02/05  19:39:30  lwall
+ * patch36: the taintanyway code wasn't tainting anyway
+ * patch36: Malformed cmd links core dump apparently fixed
+ *
+ * Revision 4.0.1.7  92/06/08  14:50:39  lwall
+ * patch20: PERLLIB now supports multiple directories
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * patch20: -e 'cmd' no longer fails silently if /tmp runs out of space
+ * patch20: perl -P now uses location of sed determined by Configure
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: eval "1 #comment" didn't work
+ * patch20: couldn't require . files
+ * patch20: semantic compilation errors didn't abort execution
+ * 
+ * Revision 4.0.1.6  91/11/11  16:38:45  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * patch19: op/regexp.t failed from missing arg to bcmp()
+ * 
+ * Revision 4.0.1.5  91/11/05  18:03:32  lwall
+ * patch11: random cleanup
+ * patch11: $0 was being truncated at times
+ * patch11: cppstdin now installed outside of source directory
+ * patch11: -P didn't allow use of #elif or #undef
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: added eval {}
+ * patch11: eval confused by string containing null
+ * 
+ * Revision 4.0.1.4  91/06/10  01:23:07  lwall
+ * patch10: perl -v printed incorrect copyright notice
+ * 
+ * Revision 4.0.1.3  91/06/07  11:40:18  lwall
+ * patch4: changed old $^P to $^X
+ * 
+ * Revision 4.0.1.2  91/06/07  11:26:16  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: debugger lost track of lines in eval
+ * 
+ * Revision 4.0.1.1  91/04/11  17:49:05  lwall
+ * patch1: fixed undefined environ problem
+ * 
+ * Revision 4.0  91/03/20  01:37:44  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+/*SUPPRESS 560*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+#include "patchlevel.h"
+
+char *getenv();
+
+#ifdef IAMSUID
+#ifndef DOSUID
+#define DOSUID
+#endif
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef DOSUID
+#undef DOSUID
+#endif
+#endif
+
+static char* moreswitches();
+static void incpush();
+static char* cddir;
+static bool minus_c;
+static char patchlevel[6];
+static char *nrs = "\n";
+static int nrschar = '\n';      /* final char of rs, or 0777 if none */
+static int nrslen = 1;
+
+main(argc,argv,env)
+register int argc;
+register char **argv;
+register char **env;
+{
+    register STR *str;
+    register char *s;
+    char *scriptname;
+    char *getenv();
+    bool dosearch = FALSE;
+#ifdef DOSUID
+    char *validarg = "";
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef IAMSUID
+#undef IAMSUID
+    fatal("suidperl is no longer needed since the kernel can now execute\n\
+setuid perl scripts securely.\n");
+#endif
+#endif
+
+    origargv = argv;
+    origargc = argc;
+    origenviron = environ;
+    uid = (int)getuid();
+    euid = (int)geteuid();
+    gid = (int)getgid();
+    egid = (int)getegid();
+    sprintf(patchlevel,"%3.3s%2.2d", index(rcsid,'4'), PATCHLEVEL);
+#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
+    if (do_undump) {
+	origfilename = savestr(argv[0]);
+	do_undump = 0;
+	loop_ptr = -1;		/* start label stack again */
+	goto just_doit;
+    }
+#ifdef TAINT
+#ifndef DOSUID
+    if (uid == euid && gid == egid)
+	taintanyway = TRUE;		/* running taintperl explicitly */
+#endif
+#endif
+    (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
+    linestr = Str_new(65,80);
+    str_nset(linestr,"",0);
+    str = str_make("",0);		/* first used for -I flags */
+    curstash = defstash = hnew(0);
+    curstname = str_make("main",4);
+    stab_xhash(stabent("_main",TRUE)) = defstash;
+    defstash->tbl_name = "main";
+    incstab = hadd(aadd(stabent("INC",TRUE)));
+    incstab->str_pok |= SP_MULTI;
+    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 'a':
+	case 'c':
+	case 'd':
+	case 'D':
+	case 'i':
+	case 'l':
+	case 'n':
+	case 'p':
+	case 'u':
+	case 'U':
+	case 'v':
+	case 'w':
+	    if (s = moreswitches(s))
+		goto reswitch;
+	    break;
+
+	case 'e':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -e allowed in setuid scripts");
+#endif
+	    if (!e_fp) {
+	        e_tmpname = savestr(TMPPATH);
+		(void)mktemp(e_tmpname);
+		if (!*e_tmpname)
+		    fatal("Can't mktemp()");
+		e_fp = fopen(e_tmpname,"w");
+		if (!e_fp)
+		    fatal("Cannot open temporary file");
+	    }
+	    if (argv[1]) {
+		fputs(argv[1],e_fp);
+		argc--,argv++;
+	    }
+	    (void)putc('\n', e_fp);
+	    break;
+	case 'I':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -I allowed in setuid scripts");
+#endif
+	    str_cat(str,"-");
+	    str_cat(str,s);
+	    str_cat(str," ");
+	    if (*++s) {
+		(void)apush(stab_array(incstab),str_make(s,0));
+	    }
+	    else if (argv[1]) {
+		(void)apush(stab_array(incstab),str_make(argv[1],0));
+		str_cat(str,argv[1]);
+		argc--,argv++;
+		str_cat(str," ");
+	    }
+	    break;
+	case 'P':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -P allowed in setuid scripts");
+#endif
+	    preprocess = TRUE;
+	    s++;
+	    goto reswitch;
+	case 's':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -s allowed in setuid scripts");
+#endif
+	    doswitches = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'S':
+#ifdef TAINT
+	    if (euid != uid || egid != gid)
+		fatal("No -S allowed in setuid scripts");
+#endif
+	    dosearch = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'x':
+	    doextract = TRUE;
+	    s++;
+	    if (*s)
+		cddir = savestr(s);
+	    break;
+	case '-':
+	    argc--,argv++;
+	    goto switch_end;
+	case 0:
+	    break;
+	default:
+	    fatal("Unrecognized switch: -%s",s);
+	}
+    }
+  switch_end:
+    scriptname = argv[0];
+    if (e_fp) {
+	if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+	    fatal("Can't write to temp file for -e: %s", strerror(errno));
+	argc++,argv--;
+	scriptname = e_tmpname;
+    }
+
+#ifdef DOSISH
+#define PERLLIB_SEP ';'
+#else
+#define PERLLIB_SEP ':'
+#endif
+#ifndef TAINT		/* Can't allow arbitrary PERLLIB in setuid script */
+    incpush(getenv("PERLLIB"));
+#endif /* TAINT */
+
+#ifndef PRIVLIB
+#define PRIVLIB "/usr/local/lib/perl"
+#endif
+    incpush(PRIVLIB);
+    (void)apush(stab_array(incstab),str_make(".",1));
+
+    str_set(&str_no,No);
+    str_set(&str_yes,Yes);
+
+    /* open script */
+
+    if (scriptname == Nullch)
+#ifdef MSDOS
+    {
+	if ( isatty(fileno(stdin)) )
+	  moreswitches("v");
+	scriptname = "-";
+    }
+#else
+	scriptname = "-";
+#endif
+    if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
+	char *xfound = Nullch, *xfailed = Nullch;
+	int len;
+
+	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);
+#ifdef DEBUGGING
+	    if (debug & 1)
+		fprintf(stderr,"Looking for %s\n",tokenbuf);
+#endif
+	    if (stat(tokenbuf,&statbuf) < 0)		/* not there? */
+		continue;
+	    if (S_ISREG(statbuf.st_mode)
+	     && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
+		xfound = tokenbuf;              /* bingo! */
+		break;
+	    }
+	    if (!xfailed)
+		xfailed = savestr(tokenbuf);
+	}
+	if (!xfound)
+	    fatal("Can't execute %s", xfailed ? xfailed : scriptname );
+	if (xfailed)
+	    Safefree(xfailed);
+	scriptname = savestr(xfound);
+    }
+
+    fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
+    pidstatus = hnew(COEFFSIZE);/* for remembering status of dead pids */
+
+    origfilename = savestr(scriptname);
+    curcmd->c_filestab = fstab(origfilename);
+    if (strEQ(origfilename,"-"))
+	scriptname = "";
+    if (preprocess) {
+	char *cpp = CPPSTDIN;
+
+	if (strEQ(cpp,"cppstdin"))
+	    sprintf(tokenbuf, "%s/%s", SCRIPTDIR, cpp);
+	else
+	    sprintf(tokenbuf, "%s", cpp);
+	str_cat(str,"-I");
+	str_cat(str,PRIVLIB);
+#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, str_get(str), CPPMINUS);
+#ifdef DEBUGGING
+	if (debug & 64) {
+	    fputs(buf,stderr);
+	    fputs("\n",stderr);
+	}
+#endif
+	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(-1, uid);
+#else
+	    setuid(uid);
+#endif
+#endif
+	    if (geteuid() != uid)
+		fatal("Can't do seteuid!\n");
+	}
+#endif /* IAMSUID */
+	rsfp = mypopen(buf,"r");
+    }
+    else if (!*scriptname) {
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("Can't take set-id script from stdin");
+#endif
+	rsfp = stdin;
+    }
+    else
+	rsfp = fopen(scriptname,"r");
+    if ((FILE*)rsfp == Nullfp) {
+#ifdef DOSUID
+#ifndef IAMSUID		/* in case script is not readable before setuid */
+	if (euid && stat(stab_val(curcmd->c_filestab)->str_ptr,&statbuf) >= 0 &&
+	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
+	    execv(buf, origargv);	/* try again */
+	    fatal("Can't do setuid\n");
+	}
+#endif
+#endif
+	fatal("Can't open perl script \"%s\": %s\n",
+	  stab_val(curcmd->c_filestab)->str_ptr, strerror(errno));
+    }
+    str_free(str);		/* free -I directories */
+    str = Nullstr;
+
+    /* 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.
+     *
+     * There is also the possibility of have a script which is running
+     * set-id due to a C wrapper.  We want to do the TAINT checks
+     * on these set-id scripts, but don't want to have the overhead of
+     * them in normal perl, and can't use suidperl because it will lose
+     * the effective uid info, so we have an additional non-setuid root
+     * version called taintperl or tperlN.NNN that just does the TAINT checks.
+     */
+
+#ifdef DOSUID
+    if (fstat(fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
+	fatal("Can't stat script \"%s\"",origfilename);
+    if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	int 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(stab_val(curcmd->c_filestab)->str_ptr,1))	/*double check*/
+	    fatal("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 (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
+		fatal("Can't swap uid and euid");	/* really paranoid */
+	    if (stat(stab_val(curcmd->c_filestab)->str_ptr,&tmpstatbuf) < 0)
+		fatal("Permission denied");	/* testing full pathname here */
+	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
+		tmpstatbuf.st_ino != statbuf.st_ino) {
+		(void)fclose(rsfp);
+		if (rsfp = mypopen("/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,
+			stab_val(curcmd->c_filestab)->str_ptr,
+			statbuf.st_uid, statbuf.st_gid);
+		    (void)mypclose(rsfp);
+		}
+		fatal("Permission denied\n");
+	    }
+	    if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
+		fatal("Can't reswap uid and euid");
+	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
+		fatal("Permission denied\n");
+	}
+#endif /* HAS_SETREUID */
+#endif /* IAMSUID */
+
+	if (!S_ISREG(statbuf.st_mode))
+	    fatal("Permission denied");
+	if (statbuf.st_mode & S_IWOTH)
+	    fatal("Setuid/gid script is writable by world");
+	doswitches = FALSE;		/* -s is insecure in suid */
+	curcmd->c_line++;
+	if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
+	  strnNE(tokenbuf,"#!",2) )	/* required even on Sys V */
+	    fatal("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 */
+	    fatal("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]))
+	    fatal("Args must match #! line");
+
+#ifndef IAMSUID
+	if (euid != uid && (statbuf.st_mode & S_ISUID) &&
+	    euid == statbuf.st_uid)
+	    if (!do_undump)
+		fatal("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
+	    fatal("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((GIDTYPE)-1,statbuf.st_gid);
+#else
+	    setgid(statbuf.st_gid);
+#endif
+#endif
+	    if (getegid() != statbuf.st_gid)
+		fatal("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((UIDTYPE)-1,statbuf.st_uid);
+#else
+		setuid(statbuf.st_uid);
+#endif
+#endif
+	    if (geteuid() != statbuf.st_uid)
+		fatal("Can't do seteuid!\n");
+	}
+	else if (uid) {			/* oops, mustn't run as root */
+#ifdef HAS_SETEUID
+	    (void)seteuid((UIDTYPE)uid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)-1,(UIDTYPE)uid);
+#else
+	    setuid((UIDTYPE)uid);
+#endif
+#endif
+	    if (geteuid() != uid)
+		fatal("Can't do seteuid!\n");
+	}
+	uid = (int)getuid();
+	euid = (int)geteuid();
+	gid = (int)getgid();
+	egid = (int)getegid();
+	if (!cando(S_IXUSR,TRUE,&statbuf))
+	    fatal("Permission denied\n");	/* they can't do this */
+    }
+#ifdef IAMSUID
+    else if (preprocess)
+	fatal("-P not allowed for setuid/setgid script\n");
+    else
+	fatal("Script is not setuid/setgid in suidperl\n");
+#else
+#ifndef TAINT		/* we aren't taintperl or suidperl */
+    /* script has a wrapper--can't run suidperl or we lose euid */
+    else if (euid != uid || egid != gid) {
+	(void)fclose(rsfp);
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
+	execv(buf, origargv);	/* try again */
+	fatal("Can't run setuid script with taint checks");
+    }
+#endif /* TAINT */
+#endif /* IAMSUID */
+#else /* !DOSUID */
+#ifndef TAINT		/* we aren't taintperl or suidperl */
+    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)
+		fatal("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 */
+	(void)fclose(rsfp);
+	(void)sprintf(buf, "%s/tperl%s", BIN, patchlevel);
+	execv(buf, origargv);	/* try again */
+	fatal("Can't run setuid script with taint checks");
+    }
+#endif /* TAINT */
+#endif /* DOSUID */
+
+#if !defined(IAMSUID) && !defined(TAINT)
+
+    /* skip forward in input to the real script? */
+
+    while (doextract) {
+	if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
+	    fatal("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)
+		fatal("Can't chdir to %s",cddir);
+	}
+    }
+#endif /* !defined(IAMSUID) && !defined(TAINT) */
+
+    defstab = stabent("_",TRUE);
+
+    subname = str_make("main",4);
+    if (perldb) {
+	debstash = hnew(0);
+	stab_xhash(stabent("_DB",TRUE)) = debstash;
+	curstash = debstash;
+	dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
+	tmpstab->str_pok |= SP_MULTI;
+	dbargs->ary_flags = 0;
+	DBstab = stabent("DB",TRUE);
+	DBstab->str_pok |= SP_MULTI;
+	DBline = stabent("dbline",TRUE);
+	DBline->str_pok |= SP_MULTI;
+	DBsub = hadd(tmpstab = stabent("sub",TRUE));
+	tmpstab->str_pok |= SP_MULTI;
+	DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	DBtrace = stab_val((tmpstab = stabent("trace",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	DBsignal = stab_val((tmpstab = stabent("signal",TRUE)));
+	tmpstab->str_pok |= SP_MULTI;
+	curstash = defstash;
+    }
+
+    /* init tokener */
+
+    bufend = bufptr = str_get(linestr);
+
+    savestack = anew(Nullstab);		/* for saving non-local values */
+    stack = anew(Nullstab);		/* for saving non-local values */
+    stack->ary_flags = 0;		/* not a real array */
+    afill(stack,63); afill(stack,-1);	/* preextend stack */
+    afill(savestack,63); afill(savestack,-1);
+
+    /* now parse the script */
+
+    error_count = 0;
+    if (yyparse() || error_count) {
+	if (minus_c)
+	    fatal("%s had compilation errors.\n", origfilename);
+	else {
+	    fatal("Execution of %s aborted due to compilation errors.\n",
+		origfilename);
+	}
+    }
+
+    New(50,loop_stack,128,struct loop);
+#ifdef DEBUGGING
+    if (debug) {
+	New(51,debname,128,char);
+	New(52,debdelim,128,char);
+    }
+#endif
+    curstash = defstash;
+
+    preprocess = FALSE;
+    if (e_fp) {
+	e_fp = Nullfp;
+	(void)UNLINK(e_tmpname);
+    }
+
+    /* initialize everything that won't change if we undump */
+
+    if (sigstab = stabent("SIG",allstabs)) {
+	sigstab->str_pok |= SP_MULTI;
+	(void)hadd(sigstab);
+    }
+
+    magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
+    userinit();		/* in case linked C routines want magical variables */
+
+    amperstab = stabent("&",allstabs);
+    leftstab = stabent("`",allstabs);
+    rightstab = stabent("'",allstabs);
+    sawampersand = (amperstab || leftstab || rightstab);
+    if (tmpstab = stabent(":",allstabs))
+	str_set(stab_val(tmpstab),chopset);
+    if (tmpstab = stabent("\024",allstabs))
+	time(&basetime);
+
+    /* these aren't necessarily magical */
+    if (tmpstab = stabent("\014",allstabs)) {
+	str_set(stab_val(tmpstab),"\f");
+	formfeed = stab_val(tmpstab);
+    }
+    if (tmpstab = stabent(";",allstabs))
+	str_set(STAB_STR(tmpstab),"\034");
+    if (tmpstab = stabent("]",allstabs)) {
+	str = STAB_STR(tmpstab);
+	str_set(str,rcsid);
+	str->str_u.str_nval = atof(patchlevel);
+	str->str_nok = 1;
+    }
+    str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
+
+    stdinstab = stabent("STDIN",TRUE);
+    stdinstab->str_pok |= SP_MULTI;
+    if (!stab_io(stdinstab))
+	stab_io(stdinstab) = stio_new();
+    stab_io(stdinstab)->ifp = stdin;
+    tmpstab = stabent("stdin",TRUE);
+    stab_io(tmpstab) = stab_io(stdinstab);
+    tmpstab->str_pok |= SP_MULTI;
+
+    tmpstab = stabent("STDOUT",TRUE);
+    tmpstab->str_pok |= SP_MULTI;
+    if (!stab_io(tmpstab))
+	stab_io(tmpstab) = stio_new();
+    stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
+    defoutstab = tmpstab;
+    tmpstab = stabent("stdout",TRUE);
+    stab_io(tmpstab) = stab_io(defoutstab);
+    tmpstab->str_pok |= SP_MULTI;
+
+    curoutstab = stabent("STDERR",TRUE);
+    curoutstab->str_pok |= SP_MULTI;
+    if (!stab_io(curoutstab))
+	stab_io(curoutstab) = stio_new();
+    stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
+    tmpstab = stabent("stderr",TRUE);
+    stab_io(tmpstab) = stab_io(curoutstab);
+    tmpstab->str_pok |= SP_MULTI;
+    curoutstab = defoutstab;		/* switch back to STDOUT */
+
+    statname = Str_new(66,0);		/* last filename we did stat on */
+
+    /* now that script is parsed, we can modify record separator */
+
+    rs = nrs;
+    rslen = nrslen;
+    rschar = nrschar;
+    rspara = (nrslen == 2);
+    str_nset(stab_val(stabent("/", TRUE)), rs, rslen);
+
+    if (do_undump)
+	my_unexec();
+
+  just_doit:		/* come here if running an undumped a.out */
+    argc--,argv++;	/* skip name of script */
+    if (doswitches) {
+	for (; argc > 0 && **argv == '-'; argc--,argv++) {
+	    if (argv[0][1] == '-') {
+		argc--,argv++;
+		break;
+	    }
+	    if (s = index(argv[0], '=')) {
+		*s++ = '\0';
+		str_set(stab_val(stabent(argv[0]+1,TRUE)),s);
+	    }
+	    else
+		str_numset(stab_val(stabent(argv[0]+1,TRUE)),(double)1.0);
+	}
+    }
+#ifdef TAINT
+    tainted = 1;
+#endif
+    if (tmpstab = stabent("0",allstabs)) {
+	str_set(stab_val(tmpstab),origfilename);
+	magicname("0", Nullch, 0);
+    }
+    if (tmpstab = stabent("\030",allstabs))
+	str_set(stab_val(tmpstab),origargv[0]);
+    if (argvstab = stabent("ARGV",allstabs)) {
+	argvstab->str_pok |= SP_MULTI;
+	(void)aadd(argvstab);
+	aclear(stab_array(argvstab));
+	for (; argc > 0; argc--,argv++) {
+	    (void)apush(stab_array(argvstab),str_make(argv[0],0));
+	}
+    }
+#ifdef TAINT
+    (void) stabent("ENV",TRUE);		/* must test PATH and IFS */
+#endif
+    if (envstab = stabent("ENV",allstabs)) {
+	envstab->str_pok |= SP_MULTI;
+	(void)hadd(envstab);
+	hclear(stab_hash(envstab), FALSE);
+	if (env != environ)
+	    environ[0] = Nullch;
+	for (; *env; env++) {
+	    if (!(s = index(*env,'=')))
+		continue;
+	    *s++ = '\0';
+	    str = str_make(s--,0);
+	    str_magic(str, envstab, 'E', *env, s - *env);
+	    (void)hstore(stab_hash(envstab), *env, s - *env, str, 0);
+	    *s = '=';
+	}
+    }
+#ifdef TAINT
+    tainted = 0;
+#endif
+    if (tmpstab = stabent("$",allstabs))
+	str_numset(STAB_STR(tmpstab),(double)getpid());
+
+    if (dowarn) {
+	stab_check('A','Z');
+	stab_check('a','z');
+    }
+
+    if (setjmp(top_env))	/* sets goto_targ on longjump */
+	loop_ptr = -1;		/* start label stack again */
+
+#ifdef DEBUGGING
+    if (debug & 1024)
+	dump_all();
+    if (debug)
+	fprintf(stderr,"\nEXECUTING...\n\n");
+#endif
+
+    if (minus_c) {
+	fprintf(stderr,"%s syntax OK\n", origfilename);
+	exit(0);
+    }
+
+    /* do it */
+
+    (void) cmd_exec(main_root,G_SCALAR,-1);
+
+    if (goto_targ)
+	fatal("Can't find label \"%s\"--aborting",goto_targ);
+    exit(0);
+    /* NOTREACHED */
+}
+
+void
+magicalize(list)
+register char *list;
+{
+    char sym[2];
+
+    sym[1] = '\0';
+    while (*sym = *list++)
+	magicname(sym, Nullch, 0);
+}
+
+void
+magicname(sym,name,namlen)
+char *sym;
+char *name;
+int namlen;
+{
+    register STAB *stab;
+
+    if (stab = stabent(sym,allstabs)) {
+	stab_flags(stab) = SF_VMAGIC;
+	str_magic(stab_val(stab), stab, 0, name, namlen);
+    }
+}
+
+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 */
+	    /* (void)apush(stab_array(incstab), str_make(".", 1)); */
+	    p++;
+	}
+	if ( (s = index(p, PERLLIB_SEP)) != Nullch ) {
+	    (void)apush(stab_array(incstab), str_make(p, (int)(s - p)));
+	    p = s + 1;
+	} else {
+	    (void)apush(stab_array(incstab), str_make(p, 0));
+	    break;
+	}
+    }
+}
+
+void
+savelines(array, str)
+ARRAY *array;
+STR *str;
+{
+    register char *s = str->str_ptr;
+    register char *send = str->str_ptr + str->str_cur;
+    register char *t;
+    register int line = 1;
+
+    while (s && s < send) {
+	STR *tmpstr = Str_new(85,0);
+
+	t = index(s, '\n');
+	if (t)
+	    t++;
+	else
+	    t = send;
+
+	str_nset(tmpstr, s, t - s);
+	astore(array, line++, tmpstr);
+	s = t;
+    }
+}
+
+/* this routine is in perl.c by virtue of being sort of an alternate main() */
+
+int
+do_eval(str,optype,stash,savecmd,gimme,arglast)
+STR *str;
+int optype;
+HASH *stash;
+int savecmd;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    int retval;
+    CMD *myroot = Nullcmd;
+    ARRAY *ar;
+    int i;
+    CMD * VOLATILE oldcurcmd = curcmd;
+    VOLATILE int oldtmps_base = tmps_base;
+    VOLATILE int oldsave = savestack->ary_fill;
+    VOLATILE int oldperldb = perldb;
+    SPAT * VOLATILE oldspat = curspat;
+    SPAT * VOLATILE oldlspat = lastspat;
+    static char *last_eval = Nullch;
+    static long last_elen = 0;
+    static CMD *last_root = Nullcmd;
+    VOLATILE int sp = arglast[0];
+    char *specfilename;
+    char *tmpfilename;
+    int parsing = 1;
+
+    tmps_base = tmps_max;
+    if (curstash != stash) {
+	(void)savehptr(&curstash);
+	curstash = stash;
+    }
+    str_set(stab_val(stabent("@",TRUE)),"");
+    if (curcmd->c_line == 0)		/* don't debug debugger... */
+	perldb = FALSE;
+    curcmd = &compiling;
+    if (optype == O_EVAL) {		/* normal eval */
+	curcmd->c_filestab = fstab("(eval)");
+	curcmd->c_line = 1;
+	str_sset(linestr,str);
+	str_cat(linestr,";\n;\n");	/* be kind to them */
+	if (perldb)
+	    savelines(stab_xarray(curcmd->c_filestab), linestr);
+    }
+    else {
+	if (last_root && !in_eval) {
+	    Safefree(last_eval);
+	    last_eval = Nullch;
+	    cmd_free(last_root);
+	    last_root = Nullcmd;
+	}
+	specfilename = str_get(str);
+	str_set(linestr,"");
+	if (optype == O_REQUIRE && &str_undef !=
+	  hfetch(stab_hash(incstab), specfilename, strlen(specfilename), 0)) {
+	    curcmd = oldcurcmd;
+	    tmps_base = oldtmps_base;
+	    st[++sp] = &str_yes;
+	    perldb = oldperldb;
+	    return sp;
+	}
+	tmpfilename = savestr(specfilename);
+	if (*tmpfilename == '/' ||
+	    (*tmpfilename == '.' && 
+		(tmpfilename[1] == '/' ||
+		 (tmpfilename[1] == '.' && tmpfilename[2] == '/'))))
+	{
+	    rsfp = fopen(tmpfilename,"r");
+	}
+	else {
+	    ar = stab_array(incstab);
+	    for (i = 0; i <= ar->ary_fill; i++) {
+		(void)sprintf(buf, "%s/%s",
+		  str_get(afetch(ar,i,TRUE)), specfilename);
+		rsfp = fopen(buf,"r");
+		if (rsfp) {
+		    char *s = buf;
+
+		    if (*s == '.' && s[1] == '/')
+			s += 2;
+		    Safefree(tmpfilename);
+		    tmpfilename = savestr(s);
+		    break;
+		}
+	    }
+	}
+	curcmd->c_filestab = fstab(tmpfilename);
+	Safefree(tmpfilename);
+	tmpfilename = Nullch;
+	if (!rsfp) {
+	    curcmd = oldcurcmd;
+	    tmps_base = oldtmps_base;
+	    if (optype == O_REQUIRE) {
+		sprintf(tokenbuf,"Can't locate %s in @INC", specfilename);
+		if (instr(tokenbuf,".h "))
+		    strcat(tokenbuf," (change .h to .ph maybe?)");
+		if (instr(tokenbuf,".ph "))
+		    strcat(tokenbuf," (did you run h2ph?)");
+		fatal("%s",tokenbuf);
+	    }
+	    if (gimme != G_ARRAY)
+		st[++sp] = &str_undef;
+	    perldb = oldperldb;
+	    return sp;
+	}
+	curcmd->c_line = 0;
+    }
+    in_eval++;
+    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
+    bufend = bufptr + linestr->str_cur;
+    if (++loop_ptr >= loop_max) {
+	loop_max += 128;
+	Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    eval_root = Nullcmd;
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	retval = 1;
+    }
+    else {
+	error_count = 0;
+	if (rsfp) {
+	    retval = yyparse();
+	    retval |= error_count;
+	}
+	else if (last_root && last_elen == bufend - bufptr
+	  && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){
+	    retval = 0;
+	    eval_root = last_root;	/* no point in reparsing */
+	}
+	else if (in_eval == 1 && !savecmd) {
+	    if (last_root) {
+		Safefree(last_eval);
+		last_eval = Nullch;
+		cmd_free(last_root);
+	    }
+	    last_root = Nullcmd;
+	    last_elen = bufend - bufptr;
+	    last_eval = nsavestr(bufptr, last_elen);
+	    retval = yyparse();
+	    retval |= error_count;
+	    if (!retval)
+		last_root = eval_root;
+	    if (!last_root) {
+		Safefree(last_eval);
+		last_eval = Nullch;
+	    }
+	}
+	else
+	    retval = yyparse();
+    }
+    myroot = eval_root;		/* in case cmd_exec does another eval! */
+
+    if (retval || error_count) {
+	st = stack->ary_array;
+	sp = arglast[0];
+	if (gimme != G_ARRAY)
+	    st[++sp] = &str_undef;
+	if (parsing) {
+#ifndef MANGLEDPARSE
+#ifdef DEBUGGING
+	    if (debug & 128)
+		fprintf(stderr,"Freeing eval_root %lx\n",(long)eval_root);
+#endif
+	    cmd_free(eval_root);
+#endif
+	    /*SUPPRESS 29*/ /*SUPPRESS 30*/
+	    if ((CMD*)eval_root == last_root)
+		last_root = Nullcmd;
+	    eval_root = myroot = Nullcmd;
+	}
+	if (rsfp) {
+	    fclose(rsfp);
+	    rsfp = 0;
+	}
+    }
+    else {
+	parsing = 0;
+	sp = cmd_exec(eval_root,gimme,sp);
+	st = stack->ary_array;
+	for (i = arglast[0] + 1; i <= sp; i++)
+	    st[i] = str_mortal(st[i]);
+				/* if we don't save result, free zaps it */
+	if (savecmd)
+	    eval_root = myroot;
+	else if (in_eval != 1 && myroot != last_root)
+	    cmd_free(myroot);
+	    if (eval_root == myroot)
+		eval_root = Nullcmd;
+    }
+
+    perldb = oldperldb;
+    in_eval--;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    tmps_base = oldtmps_base;
+    curspat = oldspat;
+    lastspat = oldlspat;
+    if (savestack->ary_fill > oldsave)	/* let them use local() */
+	restorelist(oldsave);
+
+    if (optype != O_EVAL) {
+	if (retval) {
+	    if (optype == O_REQUIRE)
+		fatal("%s", str_get(stab_val(stabent("@",TRUE))));
+	}
+	else {
+	    curcmd = oldcurcmd;
+	    if (gimme == G_SCALAR ? str_true(st[sp]) : sp > arglast[0]) {
+		(void)hstore(stab_hash(incstab), specfilename,
+		  strlen(specfilename), str_smake(stab_val(curcmd->c_filestab)),
+		      0 );
+	    }
+	    else if (optype == O_REQUIRE)
+		fatal("%s did not return a true value", specfilename);
+	}
+    }
+    curcmd = oldcurcmd;
+    return sp;
+}
+
+int
+do_try(cmd,gimme,arglast)
+CMD *cmd;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+
+    CMD * VOLATILE oldcurcmd = curcmd;
+    VOLATILE int oldtmps_base = tmps_base;
+    VOLATILE int oldsave = savestack->ary_fill;
+    SPAT * VOLATILE oldspat = curspat;
+    SPAT * VOLATILE oldlspat = lastspat;
+    VOLATILE int sp = arglast[0];
+
+    tmps_base = tmps_max;
+    str_set(stab_val(stabent("@",TRUE)),"");
+    in_eval++;
+    if (++loop_ptr >= loop_max) {
+	loop_max += 128;
+	Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	st = stack->ary_array;
+	sp = arglast[0];
+	if (gimme != G_ARRAY)
+	    st[++sp] = &str_undef;
+    }
+    else {
+	sp = cmd_exec(cmd,gimme,sp);
+	st = stack->ary_array;
+/*	for (i = arglast[0] + 1; i <= sp; i++)
+	    st[i] = str_mortal(st[i]);  not needed, I think */
+				/* if we don't save result, free zaps it */
+    }
+
+    in_eval--;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    tmps_base = oldtmps_base;
+    curspat = oldspat;
+    lastspat = oldlspat;
+    curcmd = oldcurcmd;
+    if (savestack->ary_fill > oldsave)	/* let them use local() */
+	restorelist(oldsave);
+
+    return sp;
+}
+
+/* This routine handles any switches that can be given during run */
+
+static char *
+moreswitches(s)
+char *s;
+{
+    int numlen;
+
+    switch (*s) {
+    case '0':
+	nrschar = scanoct(s, 4, &numlen);
+	nrs = nsavestr("\n",1);
+	*nrs = nrschar;
+	if (nrschar > 0377) {
+	    nrslen = 0;
+	    nrs = "";
+	}
+	else if (!nrschar && numlen >= 2) {
+	    nrslen = 2;
+	    nrs = "\n\n";
+	    nrschar = '\n';
+	}
+	return s + numlen;
+    case 'a':
+	minus_a = TRUE;
+	s++;
+	return s;
+    case 'c':
+	minus_c = TRUE;
+	s++;
+	return s;
+    case 'd':
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -d allowed in setuid scripts");
+#endif
+	perldb = TRUE;
+	s++;
+	return s;
+    case 'D':
+#ifdef DEBUGGING
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -D allowed in setuid scripts");
+#endif
+	debug = atoi(s+1) | 32768;
+#else
+	warn("Recompile perl with -DDEBUGGING to use -D switch\n");
+#endif
+	/*SUPPRESS 530*/
+	for (s++; isDIGIT(*s); s++) ;
+	return s;
+    case 'i':
+	inplace = savestr(s+1);
+	/*SUPPRESS 530*/
+	for (s = inplace; *s && !isSPACE(*s); s++) ;
+	*s = '\0';
+	break;
+    case 'I':
+#ifdef TAINT
+	if (euid != uid || egid != gid)
+	    fatal("No -I allowed in setuid scripts");
+#endif
+	if (*++s) {
+	    (void)apush(stab_array(incstab),str_make(s,0));
+	}
+	else
+	    fatal("No space allowed after -I");
+	break;
+    case 'l':
+	minus_l = TRUE;
+	s++;
+	if (isDIGIT(*s)) {
+	    ors = savestr("\n");
+	    orslen = 1;
+	    *ors = scanoct(s, 3 + (*s == '0'), &numlen);
+	    s += numlen;
+	}
+	else {
+	    ors = nsavestr(nrs,nrslen);
+	    orslen = nrslen;
+	}
+	return s;
+    case 'n':
+	minus_n = TRUE;
+	s++;
+	return s;
+    case 'p':
+	minus_p = TRUE;
+	s++;
+	return s;
+    case 'u':
+	do_undump = TRUE;
+	s++;
+	return s;
+    case 'U':
+	unsafe = TRUE;
+	s++;
+	return s;
+    case 'v':
+	fputs("\nThis is perl, version 4.0\n\n",stdout);
+	fputs(rcsid,stdout);
+	fputs("\nCopyright (c) 1989, 1990, 1991, Larry Wall\n",stdout);
+#ifdef MSDOS
+	fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
+	stdout);
+#ifdef OS2
+        fputs("OS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n",
+        stdout);
+#endif
+#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 4.0 source kit.\n",stdout);
+#ifdef MSDOS
+        usage(origargv[0]);
+#endif
+	exit(0);
+    case 'w':
+	dowarn = TRUE;
+	s++;
+	return s;
+    case ' ':
+    case '\n':
+    case '\t':
+	break;
+    default:
+	fatal("Switch meaningless after -x: -%s",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;
+    static char dumpname[BUFSIZ];
+    static char perlpath[256];
+
+    sprintf (dumpname, "%s.perldump", origfilename);
+    sprintf (perlpath, "%s/perl", BIN);
+
+    status = unexec(dumpname, perlpath, &etext, sbrk(0), 0);
+    if (status)
+	fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
+    exit(status);
+#else
+#ifdef DOSISH
+    abort();	/* nothing else to do */
+#else /* ! MSDOS */
+#   ifndef SIGABRT
+#	define SIGABRT SIGILL
+#   endif
+#   ifndef SIGILL
+#	define SIGILL 6		/* blech */
+#   endif
+    kill(getpid(),SIGABRT);	/* for use with undump */
+#endif /* ! MSDOS */
+#endif
+}
+
diff --git a/gnu/usr.bin/perl/perl/perl.h b/gnu/usr.bin/perl/perl/perl.h
new file mode 100644
index 000000000000..8249c62bd492
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/perl.h
@@ -0,0 +1,1063 @@
+/* $RCSfile: perl.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:35 $
+ *
+ *    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: perl.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:35  nate
+ * PERL!
+ *
+ * Revision 4.0.1.7  1993/02/05  19:40:30  lwall
+ * patch36: worked around certain busted compilers that don't init statics right
+ *
+ * Revision 4.0.1.6  92/06/08  14:55:10  lwall
+ * patch20: added Atari ST portability
+ * patch20: bcopy() and memcpy() now tested for overlap safety
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: removed implicit int declarations on functions
+ * 
+ * Revision 4.0.1.5  91/11/11  16:41:07  lwall
+ * patch19: uts wrongly defines S_ISDIR() et al
+ * patch19: too many preprocessors can't expand a macro right in #if
+ * patch19: added little-endian pack/unpack options
+ * 
+ * Revision 4.0.1.4  91/11/05  18:06:10  lwall
+ * patch11: various portability fixes
+ * patch11: added support for dbz
+ * patch11: added some support for 64-bit integers
+ * patch11: hex() didn't understand leading 0x
+ * 
+ * Revision 4.0.1.3  91/06/10  01:25:10  lwall
+ * patch10: certain pattern optimizations were botched
+ * 
+ * Revision 4.0.1.2  91/06/07  11:28:33  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:49:51  lwall
+ * patch1: hopefully straightened out some of the Xenix mess
+ * 
+ * Revision 4.0  91/03/20  01:37:56  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define VOIDWANT 1
+#include "config.h"
+
+#ifdef MYMALLOC
+#   ifdef HIDEMYMALLOC
+#	define malloc Mymalloc
+#	define realloc Myremalloc
+#	define free Myfree
+#   endif
+#   define safemalloc malloc
+#   define saferealloc realloc
+#   define safefree free
+#endif
+
+/* work around some libPW problems */
+#define fatal Myfatal
+#ifdef DOINIT
+char Error[1];
+#endif
+
+/* define this once if either system, instead of cluttering up the src */
+#if defined(MSDOS) || defined(atarist)
+#define DOSISH 1
+#endif
+
+#ifdef DOSISH
+/* This stuff now in the MS-DOS config.h file. */
+#else /* !MSDOS */
+
+/*
+ * 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.
+ */
+#define HAS_ALARM
+#define HAS_CHOWN
+#define HAS_CHROOT
+#define HAS_FORK
+#define HAS_GETLOGIN
+#define HAS_GETPPID
+#define HAS_KILL
+#define HAS_LINK
+#define HAS_PIPE
+#define HAS_WAIT
+#define HAS_UMASK
+/*
+ * The following symbols are defined if your operating system supports
+ * password and group functions in general.  All Unix systems do.
+ */
+#define HAS_GROUP
+#define HAS_PASSWD
+
+#endif /* !MSDOS */
+
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__)
+# define STANDARD_C 1
+#endif
+
+#if defined(HASVOLATILE) || defined(STANDARD_C)
+#define VOLATILE volatile
+#else
+#define VOLATILE
+#endif
+
+#ifdef IAMSUID
+#   ifndef TAINT
+#	define TAINT
+#   endif
+#endif
+
+#ifndef HAS_VFORK
+#   define vfork fork
+#endif
+
+#ifdef HAS_GETPGRP2
+#   ifndef HAS_GETPGRP
+#	define HAS_GETPGRP
+#   endif
+#   define getpgrp getpgrp2
+#endif
+
+#ifdef HAS_SETPGRP2
+#   ifndef HAS_SETPGRP
+#	define HAS_SETPGRP
+#   endif
+#   define setpgrp setpgrp2
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <setjmp.h>
+#ifndef MSDOS
+#ifdef PARAM_NEEDS_TYPES
+#include <sys/types.h>
+#endif
+#include <sys/param.h>
+#endif
+#ifdef STANDARD_C
+/* Use all the "standard" definitions */
+#include <stdlib.h>
+#include <string.h>
+#define MEM_SIZE size_t
+#else
+typedef unsigned int MEM_SIZE;
+#endif /* STANDARD_C */
+
+#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
+#undef HAS_MEMCMP
+#endif
+
+#ifdef HAS_MEMCPY
+#  ifndef STANDARD_C
+#    ifndef memcpy
+	extern char * memcpy();
+#    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
+#  ifndef STANDARD_C
+#    ifndef memset
+	extern char *memset();
+#    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
+#  ifndef STANDARD_C
+#    ifndef memcmp
+	extern int memcmp();
+#    endif
+#  endif
+#else
+#   ifndef memcmp
+#	define memcmp(s1,s2,l) my_memcmp(s1,s2,l)
+#   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 */
+
+#ifndef HAS_MEMMOVE
+#if defined(HAS_BCOPY) && defined(SAFE_BCOPY)
+#define memmove(d,s,l) bcopy(s,d,l)
+#else
+#if defined(HAS_MEMCPY) && defined(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
+
+#include <sys/stat.h>
+#if defined(uts) || defined(UTekV)
+#undef S_ISDIR
+#undef S_ISCHR
+#undef S_ISBLK
+#undef S_ISREG
+#undef S_ISFIFO
+#undef S_ISLNK
+#define S_ISDIR(P) (((P)&S_IFMT)==S_IFDIR)
+#define S_ISCHR(P) (((P)&S_IFMT)==S_IFCHR)
+#define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
+#define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
+#define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
+#ifdef S_IFLNK
+#define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
+#endif
+#endif
+
+#ifdef I_TIME
+#   include <time.h>
+#endif
+
+#ifdef I_SYS_TIME
+#   ifdef SYSTIMEKERNEL
+#	define KERNEL
+#   endif
+#   include <sys/time.h>
+#   ifdef SYSTIMEKERNEL
+#	undef KERNEL
+#   endif
+#endif
+
+#ifndef MSDOS
+#include <sys/times.h>
+#endif
+
+#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
+#undef HAS_STRERROR
+#endif
+
+#include <errno.h>
+#ifndef MSDOS
+#ifndef errno
+extern int errno;     /* ANSI allows errno to be an lvalue expr */
+#endif
+#endif
+
+#ifndef strerror
+#ifdef HAS_STRERROR
+char *strerror();
+#else
+extern int sys_nerr;
+extern char *sys_errlist[];
+#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+#endif
+#endif
+
+#ifdef I_SYSIOCTL
+#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 HAS_NDBM
+#undef HAS_NDBM
+#endif
+#endif
+
+#ifdef WANT_DBZ
+#include <dbz.h>
+#define SOME_DBM
+#define dbm_fetch(db,dkey) fetch(dkey)
+#define dbm_delete(db,dkey) fatal("dbz doesn't implement delete")
+#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
+#define dbm_close(db) dbmclose()
+#define dbm_firstkey(db) (fatal("dbz doesn't implement traversal"),fetch())
+#define nextkey() (fatal("dbz doesn't implement traversal"),fetch())
+#define dbm_nextkey(db) (fatal("dbz doesn't implement traversal"),fetch())
+#ifdef HAS_NDBM
+#undef HAS_NDBM
+#endif
+#ifndef HAS_ODBM
+#define HAS_ODBM
+#endif
+#else
+#ifdef HAS_GDBM
+#ifdef I_GDBM
+#include <gdbm.h>
+#endif
+#define SOME_DBM
+#ifdef HAS_NDBM
+#undef HAS_NDBM
+#endif
+#ifdef HAS_ODBM
+#undef HAS_ODBM
+#endif
+#else
+#ifdef HAS_NDBM
+#include <ndbm.h>
+#define SOME_DBM
+#ifdef HAS_ODBM
+#undef HAS_ODBM
+#endif
+#else
+#ifdef HAS_ODBM
+#ifdef NULL
+#undef NULL		/* suppress redefinition message */
+#endif
+#include <dbm.h>
+#ifdef NULL
+#undef NULL
+#endif
+#define NULL 0		/* silly thing is, we don't even use this */
+#define SOME_DBM
+#define dbm_fetch(db,dkey) fetch(dkey)
+#define dbm_delete(db,dkey) delete(dkey)
+#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
+#define dbm_close(db) dbmclose()
+#define dbm_firstkey(db) firstkey()
+#endif /* HAS_ODBM */
+#endif /* HAS_NDBM */
+#endif /* HAS_GDBM */
+#endif /* WANT_DBZ */
+#ifdef SOME_DBM
+EXT char *dbmkey;
+EXT int dbmlen;
+#endif
+
+#if INTSIZE == 2
+#define htoni htons
+#define ntohi ntohs
+#else
+#define htoni htonl
+#define ntohi ntohl
+#endif
+
+#if defined(I_DIRENT)
+#   include <dirent.h>
+#   define DIRENT dirent
+#else
+#   ifdef I_SYS_NDIR
+#	include <sys/ndir.h>
+#	define DIRENT direct
+#   else
+#	ifdef I_SYS_DIR
+#	    ifdef hp9000s500
+#		include <ndir.h>	/* may be wrong in the future */
+#	    else
+#		include <sys/dir.h>
+#	    endif
+#	    define DIRENT direct
+#	endif
+#   endif
+#endif
+
+#ifdef FPUTS_BOTCH
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
+#   ifndef fputs
+#	define fputs(str,fp) fprintf(fp,"%s",str)
+#   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 f_next
+#undef f_next
+#endif
+
+#if defined(cray) || defined(gould) || defined(i860)
+#   define SLOPPYDIVIDE
+#endif
+
+#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
+#   define QUAD
+#endif
+
+#ifdef QUAD
+#   ifdef cray
+#	define quad int
+#   else
+#	if defined(convex) || defined (uts)
+#	    define quad long long
+#	else
+#	    define quad long
+#	endif
+#   endif
+#endif
+
+typedef MEM_SIZE STRLEN;
+
+typedef struct arg ARG;
+typedef struct cmd CMD;
+typedef struct formcmd FCMD;
+typedef struct scanpat SPAT;
+typedef struct stio STIO;
+typedef struct sub SUBR;
+typedef struct string STR;
+typedef struct atbl ARRAY;
+typedef struct htbl HASH;
+typedef struct regexp REGEXP;
+typedef struct stabptrs STBP;
+typedef struct stab STAB;
+typedef struct callsave CSV;
+
+#include "handy.h"
+#include "regexp.h"
+#include "str.h"
+#include "util.h"
+#include "form.h"
+#include "stab.h"
+#include "spat.h"
+#include "arg.h"
+#include "cmd.h"
+#include "array.h"
+#include "hash.h"
+
+#if defined(iAPX286) || defined(M_I286) || defined(I80286)
+#   define I286
+#endif
+
+#ifndef	STANDARD_C
+#ifdef CHARSPRINTF
+    char *sprintf();
+#else
+    int sprintf();
+#endif
+#endif
+
+EXT char *Yes INIT("1");
+EXT char *No INIT("");
+
+/* "gimme" values */
+
+/* Note: cmd.c assumes that it can use && to produce one of these values! */
+#define G_SCALAR 0
+#define G_ARRAY 1
+
+#ifdef CRIPPLED_CC
+int str_true();
+#else /* !CRIPPLED_CC */
+#define str_true(str) (Str = (str), \
+	(Str->str_pok ? \
+	    ((*Str->str_ptr > '0' || \
+	      Str->str_cur > 1 || \
+	      (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
+	: \
+	    (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
+#endif /* CRIPPLED_CC */
+
+#ifdef DEBUGGING
+#define str_peek(str) (Str = (str), \
+	(Str->str_pok ? \
+	    Str->str_ptr : \
+	    (Str->str_nok ? \
+		(sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
+		    (char*)tokenbuf) : \
+		"" )))
+#endif
+
+#ifdef CRIPPLED_CC
+char *str_get();
+#else
+#ifdef TAINT
+#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
+	(Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#else
+#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#endif /* TAINT */
+#endif /* CRIPPLED_CC */
+
+#ifdef CRIPPLED_CC
+double str_gnum();
+#else /* !CRIPPLED_CC */
+#ifdef TAINT
+#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
+	(Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
+#else /* !TAINT */
+#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
+#endif /* TAINT*/
+#endif /* CRIPPLED_CC */
+EXT STR *Str;
+
+#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
+
+#ifndef DOSISH
+#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
+#define Str_Grow str_grow
+#else
+/* extra parentheses intentionally NOT placed around "len"! */
+#define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
+		str_grow(str,(unsigned long)len)
+#define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
+#endif /* DOSISH */
+
+#ifndef BYTEORDER
+#define BYTEORDER 0x1234
+#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) ((unsigned short)(what))
+#define U_I(what) ((unsigned int)(what))
+#define U_L(what) ((unsigned long)(what))
+#else
+unsigned long castulong();
+#define U_S(what) ((unsigned int)castulong(what))
+#define U_I(what) ((unsigned int)castulong(what))
+#define U_L(what) (castulong(what))
+#endif
+
+CMD *add_label();
+CMD *block_head();
+CMD *append_line();
+CMD *make_acmd();
+CMD *make_ccmd();
+CMD *make_icmd();
+CMD *invert();
+CMD *addcond();
+CMD *addloop();
+CMD *wopt();
+CMD *over();
+
+STAB *stabent();
+STAB *genstab();
+
+ARG *stab2arg();
+ARG *op_new();
+ARG *make_op();
+ARG *make_match();
+ARG *make_split();
+ARG *rcatmaybe();
+ARG *listish();
+ARG *maybelistish();
+ARG *localize();
+ARG *fixeval();
+ARG *jmaybe();
+ARG *l();
+ARG *fixl();
+ARG *mod_match();
+ARG *make_list();
+ARG *cmd_to_arg();
+ARG *addflags();
+ARG *hide_ary();
+ARG *cval_to_arg();
+
+STR *str_new();
+STR *stab_str();
+
+int apply();
+int do_each();
+int do_subr();
+int do_match();
+int do_unpack();
+int eval();		/* this evaluates expressions */
+int do_eval();		/* this evaluates eval operator */
+int do_assign();
+
+SUBR *make_sub();
+
+FCMD *load_format();
+
+char *scanpat();
+char *scansubst();
+char *scantrans();
+char *scanstr();
+char *scanident();
+char *str_append_till();
+char *str_gets();
+char *str_grow();
+
+bool do_open();
+bool do_close();
+bool do_print();
+bool do_aprint();
+bool do_exec();
+bool do_aexec();
+
+int do_subst();
+int cando();
+int ingroup();
+int whichsig();
+int userinit();
+#ifdef CRYPTSCRIPT
+void cryptswitch();
+#endif
+
+void str_replace();
+void str_inc();
+void str_dec();
+void str_free();
+void cmd_free();
+void arg_free();
+void spat_free();
+void regfree();
+void stab_clear();
+void do_chop();
+void do_vop();
+void do_write();
+void do_join();
+void do_sprintf();
+void do_accept();
+void do_pipe();
+void do_vecset();
+void do_unshift();
+void do_execfree();
+void magicalize();
+void magicname();
+void savelist();
+void saveitem();
+void saveint();
+void savelong();
+void savesptr();
+void savehptr();
+void restorelist();
+void repeatcpy();
+void make_form();
+void dehoist();
+void format();
+void my_unexec();
+void fatal();
+void warn();
+#ifdef DEBUGGING
+void dump_all();
+void dump_cmd();
+void dump_arg();
+void dump_flags();
+void dump_stab();
+void dump_spat();
+#endif
+#ifdef MSTATS
+void mstats();
+#endif
+
+HASH *savehash();
+ARRAY *saveary();
+
+EXT char **origargv;
+EXT int origargc;
+EXT char **origenviron;
+extern char **environ;
+
+EXT long subline INIT(0);
+EXT STR *subname INIT(Nullstr);
+EXT int arybase INIT(0);
+
+struct outrec {
+    long	o_lines;
+    char	*o_str;
+    int		o_len;
+};
+
+EXT struct outrec outrec;
+EXT struct outrec toprec;
+
+EXT STAB *stdinstab INIT(Nullstab);
+EXT STAB *last_in_stab INIT(Nullstab);
+EXT STAB *defstab INIT(Nullstab);
+EXT STAB *argvstab INIT(Nullstab);
+EXT STAB *envstab INIT(Nullstab);
+EXT STAB *sigstab INIT(Nullstab);
+EXT STAB *defoutstab INIT(Nullstab);
+EXT STAB *curoutstab INIT(Nullstab);
+EXT STAB *argvoutstab INIT(Nullstab);
+EXT STAB *incstab INIT(Nullstab);
+EXT STAB *leftstab INIT(Nullstab);
+EXT STAB *amperstab INIT(Nullstab);
+EXT STAB *rightstab INIT(Nullstab);
+EXT STAB *DBstab INIT(Nullstab);
+EXT STAB *DBline INIT(Nullstab);
+EXT STAB *DBsub INIT(Nullstab);
+
+EXT HASH *defstash;		/* main symbol table */
+EXT HASH *curstash;		/* symbol table for current package */
+EXT HASH *debstash;		/* symbol table for perldb package */
+
+EXT STR *curstname;		/* name of current package */
+
+EXT STR *freestrroot INIT(Nullstr);
+EXT STR *lastretstr INIT(Nullstr);
+EXT STR *DBsingle INIT(Nullstr);
+EXT STR *DBtrace INIT(Nullstr);
+EXT STR *DBsignal INIT(Nullstr);
+EXT STR *formfeed INIT(Nullstr);
+
+EXT int lastspbase;
+EXT int lastsize;
+
+EXT char *hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
+EXT char *origfilename;
+EXT FILE * VOLATILE rsfp INIT(Nullfp);
+EXT char buf[1024];
+EXT char *bufptr;
+EXT char *oldbufptr;
+EXT char *oldoldbufptr;
+EXT char *bufend;
+
+EXT STR *linestr INIT(Nullstr);
+
+EXT char *rs INIT("\n");
+EXT int rschar INIT('\n');	/* final char of rs, or 0777 if none */
+EXT int rslen INIT(1);
+EXT bool rspara INIT(FALSE);
+EXT char *ofs INIT(Nullch);
+EXT int ofslen INIT(0);
+EXT char *ors INIT(Nullch);
+EXT int orslen INIT(0);
+EXT char *ofmt INIT(Nullch);
+EXT char *inplace INIT(Nullch);
+EXT char *nointrp INIT("");
+
+EXT bool preprocess INIT(FALSE);
+EXT bool minus_n INIT(FALSE);
+EXT bool minus_p INIT(FALSE);
+EXT bool minus_l INIT(FALSE);
+EXT bool minus_a INIT(FALSE);
+EXT bool doswitches INIT(FALSE);
+EXT bool dowarn INIT(FALSE);
+EXT bool doextract INIT(FALSE);
+EXT bool allstabs INIT(FALSE);	/* init all customary symbols in symbol table?*/
+EXT bool sawampersand INIT(FALSE);	/* must save all match strings */
+EXT bool sawstudy INIT(FALSE);		/* do fbminstr on all strings */
+EXT bool sawi INIT(FALSE);		/* study must assume case insensitive */
+EXT bool sawvec INIT(FALSE);
+EXT bool localizing INIT(FALSE);	/* are we processing a local() list? */
+
+#ifndef MAXSYSFD
+#   define MAXSYSFD 2
+#endif
+EXT int maxsysfd INIT(MAXSYSFD);	/* top fd to pass to subprocesses */
+
+#ifdef CSH
+EXT char *cshname INIT(CSH);
+EXT int cshlen INIT(0);
+#endif /* CSH */
+
+#ifdef TAINT
+EXT bool tainted INIT(FALSE);		/* using variables controlled by $< */
+EXT bool taintanyway INIT(FALSE);	/* force taint checks when !set?id */
+#endif
+
+EXT bool nomemok INIT(FALSE);		/* let malloc context handle nomem */
+
+#ifndef DOSISH
+#define TMPPATH "/tmp/perl-eXXXXXX"
+#else
+#define TMPPATH "plXXXXXX"
+#endif /* MSDOS */
+EXT char *e_tmpname;
+EXT FILE *e_fp INIT(Nullfp);
+
+EXT char tokenbuf[256];
+EXT int expectterm INIT(TRUE);		/* how to interpret ambiguous tokens */
+EXT VOLATILE int in_eval INIT(FALSE);	/* trap fatal errors? */
+EXT int multiline INIT(0);		/* $*--do strings hold >1 line? */
+EXT int forkprocess;			/* so do_open |- can return proc# */
+EXT int do_undump INIT(0);		/* -u or dump seen? */
+EXT int error_count INIT(0);		/* how many errors so far, max 10 */
+EXT int multi_start INIT(0);		/* 1st line of multi-line string */
+EXT int multi_end INIT(0);		/* last line of multi-line string */
+EXT int multi_open INIT(0);		/* delimiter of said string */
+EXT int multi_close INIT(0);		/* delimiter of said string */
+
+FILE *popen();
+/* char *str_get(); */
+STR *interp();
+void free_arg();
+STIO *stio_new();
+void hoistmust();
+void scanconst();
+
+EXT struct stat statbuf;
+EXT struct stat statcache;
+EXT STAB *statstab INIT(Nullstab);
+EXT STR *statname INIT(Nullstr);
+#ifndef MSDOS
+EXT struct tms timesbuf;
+#endif
+EXT int uid;
+EXT int euid;
+EXT int gid;
+EXT int egid;
+UIDTYPE getuid();
+UIDTYPE geteuid();
+GIDTYPE getgid();
+GIDTYPE getegid();
+EXT int unsafe;
+
+#ifdef DEBUGGING
+EXT VOLATILE int debug INIT(0);
+EXT int dlevel INIT(0);
+EXT int dlmax INIT(128);
+EXT char *debname;
+EXT char *debdelim;
+#define YYDEBUG 1
+#endif
+EXT int perldb INIT(0);
+#define YYMAXDEPTH 300
+
+EXT line_t cmdline INIT(NOLINE);
+
+EXT STR str_undef;
+EXT STR str_no;
+EXT STR str_yes;
+
+/* runtime control stuff */
+
+EXT struct loop {
+    char *loop_label;		/* what the loop was called, if anything */
+    int loop_sp;		/* stack pointer to copy stuff down to */
+    jmp_buf loop_env;
+} *loop_stack;
+
+EXT int loop_ptr INIT(-1);
+EXT int loop_max INIT(128);
+
+EXT jmp_buf top_env;
+
+EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
+
+struct ufuncs {
+    int (*uf_val)();
+    int (*uf_set)();
+    int uf_index;
+};
+
+EXT ARRAY *stack;		/* THE STACK */
+
+EXT ARRAY * VOLATILE savestack;		/* to save non-local values on */
+
+EXT ARRAY *tosave;		/* strings to save on recursive subroutine */
+
+EXT ARRAY *lineary;		/* lines of script for debugger */
+EXT ARRAY *dbargs;		/* args to call listed by caller function */
+
+EXT ARRAY *fdpid;		/* keep fd-to-pid mappings for mypopen */
+EXT HASH *pidstatus;		/* keep pid-to-status mappings for waitpid */
+
+EXT int *di;			/* for tmp use in debuggers */
+EXT char *dc;
+EXT short *ds;
+
+/* Fix these up for __STDC__ */
+EXT time_t basetime INIT(0);
+char *mktemp();
+#ifndef STANDARD_C
+/* All of these are in stdlib.h or time.h for ANSI C */
+double atof();
+long time();
+struct tm *gmtime(), *localtime();
+char *index(), *rindex();
+char *strcpy(), *strcat();
+#endif /* ! STANDARD_C */
+
+#ifdef EUNICE
+#define UNLINK unlnk
+int unlnk();
+#else
+#define UNLINK unlink
+#endif
+
+#ifndef HAS_SETREUID
+#ifdef HAS_SETRESUID
+#define setreuid(r,e) setresuid(r,e,-1)
+#define HAS_SETREUID
+#endif
+#endif
+#ifndef HAS_SETREGID
+#ifdef HAS_SETRESGID
+#define setregid(r,e) setresgid(r,e,-1)
+#define HAS_SETREGID
+#endif
+#endif
+
+#define SCAN_DEF 0
+#define SCAN_TR 1
+#define SCAN_REPL 2
diff --git a/gnu/usr.bin/perl/perl/perly.c b/gnu/usr.bin/perl/perl/perly.c
new file mode 100644
index 000000000000..1084cc4d2593
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/perly.c
@@ -0,0 +1,3063 @@
+#ifndef lint
+static char yysccsid[] = "@(#)yaccpar	1.9 (Berkeley) 02/21/93";
+#endif
+#define YYBYACC 1
+#define YYMAJOR 1
+#define YYMINOR 9
+#define yyclearin (yychar=(-1))
+#define yyerrok (yyerrflag=0)
+#define YYRECOVERING (yyerrflag!=0)
+#define YYPREFIX "yy"
+#line 43 "perly.y"
+#include "INTERN.h"
+#include "perl.h"
+
+/*SUPPRESS 530*/
+/*SUPPRESS 593*/
+/*SUPPRESS 595*/
+
+STAB *scrstab;
+ARG *arg4;	/* rarely used arguments to make_op() */
+ARG *arg5;
+
+#line 58 "perly.y"
+typedef union {
+    int	ival;
+    char *cval;
+    ARG *arg;
+    CMD *cmdval;
+    struct compcmd compval;
+    STAB *stabval;
+    FCMD *formval;
+} YYSTYPE;
+#line 34 "y.tab.c"
+#define WORD 257
+#define LABEL 258
+#define APPEND 259
+#define OPEN 260
+#define SSELECT 261
+#define LOOPEX 262
+#define DOTDOT 263
+#define USING 264
+#define FORMAT 265
+#define DO 266
+#define SHIFT 267
+#define PUSH 268
+#define POP 269
+#define LVALFUN 270
+#define WHILE 271
+#define UNTIL 272
+#define IF 273
+#define UNLESS 274
+#define ELSE 275
+#define ELSIF 276
+#define CONTINUE 277
+#define SPLIT 278
+#define FLIST 279
+#define FOR 280
+#define FILOP 281
+#define FILOP2 282
+#define FILOP3 283
+#define FILOP4 284
+#define FILOP22 285
+#define FILOP25 286
+#define FUNC0 287
+#define FUNC1 288
+#define FUNC2 289
+#define FUNC2x 290
+#define FUNC3 291
+#define FUNC4 292
+#define FUNC5 293
+#define HSHFUN 294
+#define HSHFUN3 295
+#define FLIST2 296
+#define SUB 297
+#define FILETEST 298
+#define LOCAL 299
+#define DELETE 300
+#define RELOP 301
+#define EQOP 302
+#define MULOP 303
+#define ADDOP 304
+#define PACKAGE 305
+#define AMPER 306
+#define FORMLIST 307
+#define REG 308
+#define ARYLEN 309
+#define ARY 310
+#define HSH 311
+#define STAR 312
+#define SUBST 313
+#define PATTERN 314
+#define RSTRING 315
+#define TRANS 316
+#define LISTOP 317
+#define OROR 318
+#define ANDAND 319
+#define UNIOP 320
+#define LS 321
+#define RS 322
+#define MATCH 323
+#define NMATCH 324
+#define UMINUS 325
+#define POW 326
+#define INC 327
+#define DEC 328
+#define YYERRCODE 256
+short yylhs[] = {                                        -1,
+   26,    0,   25,   25,   12,   12,   12,    5,    3,    6,
+    6,    7,    7,    7,    7,    7,   10,   10,   10,   10,
+   10,   10,    9,    9,    9,    9,    8,    8,    8,    8,
+    8,    8,    8,    8,   11,   11,   21,   21,   24,   24,
+    1,    1,    1,    2,    2,   27,   28,   15,   13,   13,
+   16,   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,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   17,   17,   17,   17,   17,   17,   17,   17,   17,
+   17,   22,   22,   22,   22,   22,   22,   18,   18,   19,
+   19,   20,   20,    4,    4,   23,
+};
+short yylen[] = {                                         2,
+    0,    2,    3,    2,    0,    2,    5,    4,    0,    0,
+    2,    1,    2,    1,    2,    3,    1,    1,    3,    3,
+    3,    3,    5,    5,    3,    3,    6,    6,    4,    4,
+    7,    6,   10,    2,    0,    1,    0,    1,    0,    1,
+    1,    1,    1,    4,    3,    3,    3,    2,    3,    1,
+    2,    3,    4,    4,    4,    4,    4,    4,    4,    4,
+    3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+    3,    3,    3,    5,    3,    3,    1,    2,    2,    2,
+    2,    2,    2,    2,    2,    2,    2,    1,    4,    3,
+    2,    2,    2,    1,    1,    4,    1,    1,    5,    6,
+    5,    4,    5,    6,    8,    1,    1,    1,    1,    1,
+    5,    5,    4,    4,    2,    5,    5,    4,    4,    2,
+    1,    2,    1,    2,    2,    1,    2,    4,    7,    2,
+    4,    5,    4,    2,    2,    3,    1,    5,    6,    6,
+    7,    9,    6,    2,    4,    2,    4,    1,    1,    6,
+    5,    4,    5,    4,    2,    1,    1,    3,    3,    4,
+    5,    5,    6,    6,    7,    8,    4,    2,    6,    1,
+    1,    1,    2,    2,    3,    3,    3,    1,    1,    1,
+    1,    1,    1,    2,    1,    1,
+};
+short yydefred[] = {                                      1,
+    0,   10,    0,   40,    0,    0,    0,   12,   41,   11,
+   14,    0,   42,   43,    0,    0,    0,    0,   17,    9,
+  186,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  106,    0,   97,
+   95,  109,  108,  107,  110,    0,    0,    0,    0,    0,
+    0,    0,   15,    0,    0,    0,   13,    0,    0,    0,
+    0,  171,  170,   34,    0,   45,   46,   47,   10,  130,
+    0,  127,    0,  122,    0,    0,   93,    0,  180,  181,
+    0,  146,    0,    0,  144,  155,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  134,  135,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  182,  183,    0,  168,    0,    0,   86,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  124,    0,    0,    0,   84,   85,
+    0,    0,    0,    0,    0,    0,    0,    4,   16,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   82,   83,   44,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   29,    0,
+   30,    0,   25,    0,   26,    0,    0,    0,   36,    0,
+    0,  136,    0,    0,    0,    0,    0,    0,  158,  159,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  185,    0,    0,    6,    0,    3,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    8,  131,
+    0,    0,    0,    0,  128,  113,    0,  118,    0,  147,
+    0,  145,    0,    0,    0,    0,  152,    0,  154,    0,
+    0,    0,  133,    0,    0,    0,    0,    0,  160,    0,
+    0,    0,    0,    0,  167,    0,    0,   89,    0,    0,
+  114,    0,  119,    0,    0,   96,    0,  102,    0,  184,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  132,    0,    0,  111,  116,    0,   27,   28,
+   23,   24,  151,    0,    0,    0,   32,  138,    0,    0,
+    0,    0,  161,  162,    0,    0,    0,    0,    0,  153,
+    0,    0,  112,  117,   99,  103,  101,    0,    0,    0,
+    0,  143,  150,   31,    0,  139,    0,  140,    0,  163,
+  164,    0,    0,  169,  104,    0,  100,    7,  129,    0,
+  141,    0,  165,    0,    0,    0,    0,  166,  105,   33,
+  142,
+};
+short yydgoto[] = {                                       1,
+    8,    9,   89,  255,   76,    3,   10,   11,   77,  219,
+  220,  168,   79,   80,  292,  294,   81,  198,  102,  137,
+  208,   82,   83,   12,   84,    2,   13,   14,
+};
+short yysindex[] = {                                      0,
+    0,    0, -193,    0,  -54, -229, -212,    0,    0,    0,
+    0,  383,    0,    0,   22, -232,  -31,   40,    0,    0,
+    0,  -37,  -36, -132,  562,   -7,  107,   -2, 2819,  -29,
+  -23,  -22,  -21,  109,  111,   -3,   -4,  113,  123,  143,
+  170,  172,  173,  174,  175,  186,  187,  188,  189,  -34,
+  191,  200, 2896,  202,   11, -228,  -60,    0,  -32,    0,
+    0,    0,    0,    0,    0,  741,  848, 2819, 2819, 2819,
+ 2819,  912,    0, 2819, 2819,  -98,    0,   98,  -35, 1707,
+ -197,    0,    0,    0,  -64,    0,    0,    0,    0,    0,
+ 3011,    0, 3105,    0,  204,  -30,    0, -122,    0,    0,
+ -231,    0, -231, -231,    0,    0, 2819,  -31, 2819,  -31,
+ 2819,  -31, 2819,  -31, 2819, 2819,  205, 1027,    0,    0,
+ 1144, 3105, 3105, 3105, 3105, 3105,  206, 1208, 2819, 2819,
+ 2819, 2819, 2819,    0,    0, -237,    0, -237, 2819,    0,
+ -122, 2819,  131,  -62,  216,  220, 2819, 2819, 2819, 2819,
+ 2819, 5754, 2819,  221,    0, -122, -197, -197,    0,    0,
+  229,   32, -197, -197,  -31,  224,  -31,    0,    0, 2819,
+ 2819, 2819, 2819, 2819, 2819, 2819, 2819, 1319, 1494, 2819,
+ 2819, 2819, 2819, 1605, 1669, 1780, 1955, 2066, 2819, 2819,
+ 2130,    0,    0,    0, -113,  281, 1707,  279,    0, 5647,
+  283, 2244, 2362,  284,  289,  293,  221,  294,    0,   65,
+    0,   67,    0,  126,    0, 5528,   32, 2819,    0,  286,
+  -39,    0,  305,  279,  303,  303,  328,  329,    0,    0,
+  130, 5658, 5647, 5647, 5647, 5647,  333,  303, 5658,   32,
+ 2819,  252, 2436, 2533,   74,  -12,   84,   -9,  221,  221,
+  221, 2819,    0, 2725,  297,    0, 2819,    0,  221,  221,
+  221,  221, 1707,  474, -122, -187, 2819, -257, 2819, -138,
+ 1707,  954,  117,  512, 2819,  238, 2819,  238, 2819,  486,
+ 2819, -162, 2819, -162,   51,   51, 2819,   51,    0,    0,
+ 2819,  348, 2819,  303,    0,    0,   32,    0,   32,    0,
+ 2819,    0,  -31,  -31,  -31,  -31,    0,  146,    0,   32,
+ 2819,  -31,    0,  352,  279,  303, 3105, 3105,    0,  353,
+  153,  279,  303,  303,    0,  279,  355,    0,  100, 2819,
+    0,   32,    0,   32,  276,    0,  277,    0,    3,    0,
+ 2819,  154, 1707, 1707, 2819, 1707, 1707, 1707, 1707, 1707,
+ 1707,  221,    0, 1707,  303,    0,    0,   32,    0,    0,
+    0,    0,    0,  362,  -31,  345,    0,    0,  364,  279,
+  365,  303,    0,    0,  367,  369,  279,  303,  370,    0,
+  287,  114,    0,    0,    0,    0,    0,   14,  -31, 1989,
+  372,    0,    0,    0, 1027,    0,  373,    0,  303,    0,
+    0,  374,  279,    0,    0,  292,    0,    0,    0,  381,
+    0,  279,    0,  384,  386,  -31,  393,    0,    0,    0,
+    0,
+};
+short yyrindex[] = {                                      0,
+    0,    0,   70,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0, 3189, 3385,    0, 3460,    0,    0, 5031,    0,
+    0,    0,    0, 3497,    0,    0, 3539,    0,    0,    0,
+    0,    0, 3576,    0,    0,    0,    0,    0,    0,    0,
+    0,    0, 5098,    0,    0,    0, 3661,    0, 3793,    0,
+    0,    0,    0,    0,    0, 5195, 5207,    0,    0,    0,
+    0,    0,    0,    0,    0,    1,    0,    0,  -11, 2796,
+ 5280,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0, 3867, 3661,    0, 4782,    0,    0,
+    0,    0,    0,    0,    0,    0,  396,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  385,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+ 4825,    0,    0,    0, 3909, 3952,    0,    0,    0,    0,
+ 5347, 3661,    0, 4158,    0, 4849, 5444, 5501,    0,    0,
+ 3994,    0, 5570, 5596,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  452, 2647,  164,    0,  128,  404,
+    0,    0,    0,    0,    0,    0,   23,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  389,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0, 4200, 4243,
+ 4285,    0,    0,    0, 4084,    0,    0,    0,   30,   64,
+   79,   81, 3733, 1030, 4916, 3409,    0, 4534,    0, 4576,
+ 3830,    0, 1883, 1422,    0, 5843,    0, 5894,    0, 4957,
+    0, 4666,    0, 4740, 4375, 4449,    0, 4491,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  394,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0, 3878, 4698,    0, 4858, 4989, 5104, 5370, 5668,
+ 5820,  417,    0,  165,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0, 1582,
+    0,    0,    0,    0,  418,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,
+};
+short yygindex[] = {                                      0,
+    0,    0,    0, -178,  -17,  335,    0,    0,    0,  448,
+   66,    0, 6067,  342,  168, -148,  430,  -69,   -6,  -96,
+  151,    0,    0,    0,  -87,    0,    0,    0,
+};
+#define YYTABLESIZE 6408
+short yytable[] = {                                      87,
+    5,  253,   91,   93,  254,  136,   16,   97,  174,  203,
+  107,  289,  108,  110,  112,  114,  109,  111,  113,  134,
+  209,  105,  211,  201,  213,   99,  215,   17,  145,   18,
+  148,  174,  101,    5,  174,  121,  118,  104,  309,  237,
+    5,  238,  312,    5,   18,    5,  174,   18,  153,  155,
+  144,  223,  224,  225,  226,  227,  228,  174,  150,    5,
+  148,  328,  147,   38,    4,  189,  190,  308,  191,    2,
+   21,    5,  253,  135,   86,  254,  315,  316,  100,  146,
+  336,   38,   85,  338,  321,  322,  323,  324,   21,  326,
+  149,   20,  147,   20,  204,  387,  205,  206,   88,   20,
+   20,   20,   39,    6,   22,  304,  407,  305,  174,   39,
+  174,    7,   39,  176,   39,  178,  179,  174,  356,   19,
+  357,   20,   22,    5,   94,    5,    5,  174,   39,  192,
+  193,  365,  335,  187,  188,  189,  190,   19,  191,   20,
+  178,  179,  337,  174,    4,  355,  103,  256,  115,  258,
+  116,    5,  122,  383,  186,  384,  169,  174,  381,  364,
+  189,  190,  123,  191,  178,  186,  306,  370,  178,  174,
+  319,  178,  406,  174,  377,  378,  165,  166,  167,  392,
+  178,  179,  124,    6,  189,  190,  363,  191,  186,  293,
+  186,    7,   39,  374,  389,   39,  291,  174,  187,  188,
+  189,  190,   15,  191,  179,   51,  391,  179,   51,  125,
+  185,  126,  127,  128,  129,  359,  360,  361,  362,   90,
+   92,  186,  134,  399,  367,  130,  131,  132,  133,  403,
+  138,  170,  171,  172,  173,  170,  171,  172,  173,  139,
+  184,  142,  194,  202,  218,  242,  229,  371,  372,   99,
+  412,  186,  119,  241,   99,  243,    5,    5,    5,  244,
+    5,    5,    5,  257,  174,    5,    5,    5,    5,    5,
+    5,    5,    5,    5,    5,  186,  135,  394,    5,    5,
+    5,    5,    5,    5,    5,    5,    5,    5,    5,    5,
+    5,    5,    5,    5,    5,    5,    5,    5,    5,    5,
+    5,  408,  100,  120,  117,    5,    5,  100,    5,    5,
+    5,    5,    5,    5,    5,    5,    5,    5,  143,  252,
+    5,  290,  291,  295,  300,   39,   39,    5,    5,   39,
+   39,   39,  301,  302,  303,   39,   39,   39,   39,   39,
+   39,   39,   39,   39,  311,  313,  293,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,   39,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,   98,   39,   39,   39,
+  106,  317,  318,  325,  330,   39,  191,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,   39,  341,  353,   39,
+  186,  314,  368,  373,  141,  380,   39,   39,  420,  320,
+  385,  386,  393,  395,  396,  398,  327,  400,  156,  401,
+  404,  405,  409,  411,  413,   68,  415,  176,  177,  178,
+  179,  416,   72,  195,  418,   75,  419,   74,  186,  186,
+  186,  186,  197,  421,  200,  183,   37,  187,  188,  189,
+  190,   73,  191,   35,  179,  186,  186,   18,  186,  186,
+  186,  186,   37,  186,  186,  186,  216,   48,   35,   78,
+  410,  366,  197,  197,  197,  197,  197,  197,    0,    0,
+  232,  233,  234,  235,  236,    0,    0,    0,    0,    0,
+  239,    0,  369,    0,   39,    0,    0,    0,  375,  376,
+    0,   39,    0,  379,   39,    0,   39,  157,  158,  159,
+  160,    0,    0,  163,  164,   20,    0,    0,   69,    0,
+   39,  186,    0,    0,    0,  263,  264,  265,  266,  268,
+  270,  271,  272,  273,  274,  276,  278,  280,  282,  284,
+  285,  286,  288,    0,    0,    0,    0,  397,  176,  177,
+  178,  179,    0,    0,  402,    0,    0,    0,    0,  186,
+    0,    0,    0,    0,    0,    0,    0,    0,  187,  188,
+  189,  190,    0,  191,    0,    0,    0,  185,    0,    0,
+  414,    0,    0,    0,   39,    0,    0,   39,    0,  417,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   68,  263,    0,  184,    0,    0,
+    0,   72,    0,    0,   75,  185,   74,    0,  343,    0,
+  344,    0,    0,    0,    0,    0,  346,    0,  347,    0,
+  348,    0,  349,    0,  350,    0,    0,    0,  351,    0,
+    0,    0,    0,    0,  354,  184,    0,    0,   19,   21,
+    0,    0,   22,   23,   24,    0,    0,    0,   25,   26,
+   27,   28,   29,   30,   31,   32,   33,    0,  197,  197,
+   34,   35,   36,   37,   38,   39,   40,   41,   42,   43,
+   44,   45,   46,   47,   48,   49,   50,   51,   52,    0,
+   53,   54,   55,    0,   20,    0,  390,   69,   56,    0,
+   57,   58,   59,   60,   61,   62,   63,   64,   65,   66,
+    0,    0,   67,    0,    0,    0,    0,   39,   39,   70,
+   71,   39,   39,   39,    0,    0,    0,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,    0,    0,    0,   39,
+   39,   39,   39,   39,   39,   39,   39,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,   39,   39,    0,   39,
+   39,   39,    0,    0,    0,    0,    0,   39,    0,   39,
+   39,   39,   39,   39,   39,   39,   39,   39,   39,    0,
+    0,   39,    0,   68,  176,  177,  178,  179,   39,   39,
+   72,    0,    0,   75,    0,   74,  176,  177,  178,  179,
+    0,  182,  183,    0,  187,  188,  189,  190,    0,  191,
+    0,    0,    0,    0,    0,    0,  187,  188,  189,  190,
+    0,  191,  176,  177,  178,  179,    0,    0,   95,    0,
+    0,   22,   23,   24,    0,    0,    0,   25,   26,   27,
+   28,   29,  187,  188,  189,  190,    0,  191,    0,   34,
+   35,    0,   37,   38,   39,   40,   41,   42,   43,   44,
+   45,   46,   47,   48,   49,   50,   51,   52,    0,   53,
+   54,   55,    0,   20,    0,    0,   69,   56,    0,   96,
+   58,   59,   60,   61,   62,   63,   64,   65,   66,    0,
+   68,   67,    0,    0,    0,    0,    0,   72,   70,   71,
+   75,    0,   74,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   68,    0,    0,    0,    0,    0,
+    0,   72,  161,    0,   75,    0,   74,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   20,    0,    0,   69,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  186,    0,    0,    0,    0,    0,  151,    0,    0,
+   22,   23,   24,    0,    0,    0,   25,   26,   27,   28,
+   29,  345,    0,    0,  180,    0,  181,    0,   34,   35,
+    0,   37,   38,   39,   40,   41,   42,   43,   44,   45,
+   46,   47,   48,   49,   50,   51,   52,   69,   53,   54,
+   55,    0,    0,    0,    0,    0,   56,  185,  152,   58,
+   59,   60,   61,   62,   63,   64,   65,   66,    0,   68,
+   67,    0,    0,    0,    0,    0,   72,   70,   71,   75,
+   71,   74,    0,   71,    0,    0,    0,  184,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   71,   71,    0,
+   71,    0,   71,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   21,    0,    0,   22,   23,   24,
+    0,    0,    0,   25,   26,   27,   28,   29,    0,    0,
+    0,    0,   71,    0,    0,   34,   35,    0,   37,   38,
+   39,   40,   41,   42,   43,   44,   45,   46,   47,   48,
+   49,   50,   51,   52,    0,   53,   54,   55,    0,    0,
+    0,    0,   69,   56,    0,   57,   58,   59,   60,   61,
+   62,   63,   64,   65,   66,    0,    0,   67,   21,    0,
+    0,   22,   23,   24,   70,   71,   68,   25,   26,   27,
+   28,   29,    0,   72,  222,    0,   75,    0,   74,   34,
+   35,    0,   37,   38,   39,   40,   41,   42,   43,   44,
+   45,   46,   47,   48,   49,   50,   51,   52,    0,   53,
+   54,   55,    0,    0,    0,    0,  175,   56,    0,   57,
+   58,   59,   60,   61,   62,   63,   64,   65,   66,    0,
+    0,   67,    0,    0,    0,    0,    0,    0,   70,   71,
+   68,    0,    0,    0,    0,    0,    0,   72,  230,    0,
+   75,    0,   74,    0,  176,  177,  178,  179,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   69,
+    0,  182,  183,    0,  187,  188,  189,  190,    0,  191,
+    0,    0,   19,   21,    0,    0,   22,   23,   24,    0,
+    0,    0,   25,   26,   27,   28,   29,    0,    0,    0,
+   71,   71,   71,   71,   34,   35,    0,   37,   38,   39,
+   40,   41,   42,   43,   44,   45,   46,   47,   48,   49,
+   50,   51,   52,    0,   53,   54,   55,    0,    0,    0,
+    0,    0,   56,   69,   57,   58,   59,   60,   61,   62,
+   63,   64,   65,   66,    0,    0,   67,    0,    0,    0,
+    0,   68,    0,   70,   71,    0,   71,   71,   72,    0,
+    0,   75,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  267,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  199,    0,    0,   22,   23,   24,    0,    0,    0,   25,
+   26,   27,   28,   29,    0,    0,    0,    0,    0,    0,
+    0,   34,   35,    0,   37,   38,   39,   40,   41,   42,
+   43,   44,   45,   46,   47,   48,   49,   50,   51,   52,
+    0,   53,   54,   55,   69,    0,    0,    0,    0,   56,
+    0,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+   66,    0,   72,   67,   21,   72,    0,   22,   23,   24,
+   70,   71,    0,   25,   26,   27,   28,   29,    0,   72,
+   72,    0,   72,    0,   72,   34,   35,    0,   37,   38,
+   39,   40,   41,   42,   43,   44,   45,   46,   47,   48,
+   49,   50,   51,   52,    0,   53,   54,   55,    0,    0,
+    0,    0,    0,   56,   72,   57,   58,   59,   60,   61,
+   62,   63,   64,   65,   66,    0,   68,   67,    0,    0,
+    0,    0,    0,   72,   70,   71,   75,    0,   74,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  269,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   21,    0,    0,   22,   23,
+   24,    0,    0,    0,   25,   26,   27,   28,   29,    0,
+    0,    0,    0,    0,    0,    0,   34,   35,    0,   37,
+   38,   39,   40,   41,   42,   43,   44,   45,   46,   47,
+   48,   49,   50,   51,   52,    0,   53,   54,   55,   69,
+    0,    0,   74,    0,   56,   74,   57,   58,   59,   60,
+   61,   62,   63,   64,   65,   66,    0,   68,   67,   74,
+   74,    0,   74,    0,   72,   70,   71,   75,    0,   74,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  275,    0,    0,    0,    0,
+    0,    0,    0,    0,   74,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   72,    0,    0,    0,    0,    0,
+    0,    0,   72,   72,   72,   72,    0,    0,    0,    0,
+    0,   68,    0,    0,    0,    0,    0,    0,   72,    0,
+    0,   75,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  277,
+   69,    0,    0,    0,    0,    0,    0,    0,    0,   72,
+   72,    0,    0,    0,  186,    0,    0,    0,   72,   72,
+   21,    0,    0,   22,   23,   24,    0,    0,    0,   25,
+   26,   27,   28,   29,    0,    0,    0,  180,    0,  181,
+    0,   34,   35,    0,   37,   38,   39,   40,   41,   42,
+   43,   44,   45,   46,   47,   48,   49,   50,   51,   52,
+    0,   53,   54,   55,   69,    0,    0,    0,    0,   56,
+  185,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+   66,    0,   68,   67,    0,    0,    0,    0,    0,   72,
+   70,   71,   75,    0,   74,    0,    0,    0,    0,    0,
+  184,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  279,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   74,   74,   74,   74,    0,    0,    0,    0,
+    0,   21,    0,    0,   22,   23,   24,    0,    0,    0,
+   25,   26,   27,   28,   29,    0,    0,    0,    0,    0,
+    0,    0,   34,   35,    0,   37,   38,   39,   40,   41,
+   42,   43,   44,   45,   46,   47,   48,   49,   50,   51,
+   52,    0,   53,   54,   55,   69,    0,    0,   74,   74,
+   56,    0,   57,   58,   59,   60,   61,   62,   63,   64,
+   65,   66,    0,   73,   67,   21,   73,    0,   22,   23,
+   24,   70,   71,    0,   25,   26,   27,   28,   29,    0,
+   73,   73,    0,   73,    0,   73,   34,   35,    0,   37,
+   38,   39,   40,   41,   42,   43,   44,   45,   46,   47,
+   48,   49,   50,   51,   52,    0,   53,   54,   55,  175,
+    0,    0,    0,    0,   56,   73,   57,   58,   59,   60,
+   61,   62,   63,   64,   65,   66,    0,   68,   67,    0,
+    0,    0,    0,    0,   72,   70,   71,   75,    0,   74,
+    0,    0,    0,    0,    0,    0,    0,  176,  177,  178,
+  179,    0,    0,    0,    0,  281,    0,    0,    0,    0,
+    0,    0,    0,    0,  182,  183,  186,  187,  188,  189,
+  190,    0,  191,    0,    0,    0,   21,    0,    0,   22,
+   23,   24,    0,    0,    0,   25,   26,   27,   28,   29,
+    0,  181,    0,    0,    0,    0,    0,   34,   35,    0,
+   37,   38,   39,   40,   41,   42,   43,   44,   45,   46,
+   47,   48,   49,   50,   51,   52,    0,   53,   54,   55,
+   69,    0,  185,    0,    0,   56,    0,   57,   58,   59,
+   60,   61,   62,   63,   64,   65,   66,    0,   68,   67,
+    0,    0,    0,    0,    0,   72,   70,   71,   75,    0,
+   74,    0,  184,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  283,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   73,    0,    0,    0,    0,
+    0,    0,    0,   73,   73,   73,   73,    0,    0,    0,
+    0,    0,   68,    0,    0,    0,    0,    0,    0,   72,
+    0,    0,   75,    0,   74,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  287,   69,    0,    0,    0,    0,    0,    0,    0,    0,
+   73,    0,    0,    0,    0,    0,    0,    0,    0,   73,
+   73,   21,    0,    0,   22,   23,   24,    0,    0,    0,
+   25,   26,   27,   28,   29,    0,    0,    0,    0,    0,
+    0,    0,   34,   35,    0,   37,   38,   39,   40,   41,
+   42,   43,   44,   45,   46,   47,   48,   49,   50,   51,
+   52,  175,   53,   54,   55,   69,    0,    0,    0,    0,
+   56,    0,   57,   58,   59,   60,   61,   62,   63,   64,
+   65,   66,    0,    0,   67,    0,   68,    0,    0,    0,
+    0,   70,   71,   72,  296,    0,   75,    0,   74,  176,
+  177,  178,  179,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  182,  183,    0,  187,
+  188,  189,  190,    0,  191,    0,    0,    0,    0,    0,
+    0,    0,   21,    0,    0,   22,   23,   24,    0,    0,
+    0,   25,   26,   27,   28,   29,    0,    0,    0,    0,
+    0,    0,    0,   34,   35,    0,   37,   38,   39,   40,
+   41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+   51,   52,    0,   53,   54,   55,    0,    0,    0,   69,
+    0,   56,    0,   57,   58,   59,   60,   61,   62,   63,
+   64,   65,   66,    0,    0,   67,   21,    0,    0,   22,
+   23,   24,   70,   71,   68,   25,   26,   27,   28,   29,
+    0,   72,  298,    0,   75,    0,   74,   34,   35,    0,
+   37,   38,   39,   40,   41,   42,   43,   44,   45,   46,
+   47,   48,   49,   50,   51,   52,    0,   53,   54,   55,
+    0,    0,    0,    0,    0,   56,    0,   57,   58,   59,
+   60,   61,   62,   63,   64,   65,   66,    0,    0,   67,
+    0,    0,    0,    0,    0,    0,   70,   71,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   68,    0,
+    0,    0,    0,    0,    0,   72,  331,    0,   75,    0,
+   74,    0,    0,    0,    0,    0,    0,   69,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   21,    0,    0,   22,   23,   24,    0,    0,    0,   25,
+   26,   27,   28,   29,    0,    0,    0,    0,    0,    0,
+    0,   34,   35,    0,   37,   38,   39,   40,   41,   42,
+   43,   44,   45,   46,   47,   48,   49,   50,   51,   52,
+    0,   53,   54,   55,    0,    0,    0,    0,    0,   56,
+    0,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+   66,   69,    0,   67,    0,   68,    0,    0,    0,    0,
+   70,   71,   72,  333,    0,   75,    0,   74,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   21,    0,
+    0,   22,   23,   24,    0,    0,    0,   25,   26,   27,
+   28,   29,    0,    0,    0,    0,    0,    0,    0,   34,
+   35,    0,   37,   38,   39,   40,   41,   42,   43,   44,
+   45,   46,   47,   48,   49,   50,   51,   52,   69,   53,
+   54,   55,    0,    0,    0,    0,    0,   56,    0,   57,
+   58,   59,   60,   61,   62,   63,   64,   65,   66,    0,
+    0,   67,    0,    0,  186,    0,    0,    0,   70,   71,
+  178,    0,   21,    0,    0,   22,   23,   24,    0,    0,
+    0,   25,   26,   27,   28,   29,    0,  186,    0,  186,
+    0,    0,    0,   34,   35,    0,   37,   38,   39,   40,
+   41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+   51,   52,    0,   53,   54,   55,    0,    0,    0,    0,
+  186,   56,    0,   57,   58,   59,   60,   61,   62,   63,
+   64,   65,   66,    0,    0,   67,    0,   68,    0,    0,
+    0,    0,   70,   71,   72,  340,    0,   75,    0,   74,
+  186,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   21,
+    0,    0,   22,   23,   24,    0,    0,    0,   25,   26,
+   27,   28,   29,    0,    0,    0,    0,    0,    0,    0,
+   34,   35,    0,   37,   38,   39,   40,   41,   42,   43,
+   44,   45,   46,   47,   48,   49,   50,   51,   52,    0,
+   53,   54,   55,    0,    0,    0,   50,    0,   56,   50,
+   57,   58,   59,   60,   61,   62,   63,   64,   65,   66,
+   69,   68,   67,   50,   50,    0,    0,    0,   72,   70,
+   71,   75,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   50,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  186,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   68,    0,
+    0,    0,    0,    0,    0,   72,    0,    0,   75,    0,
+   74,    0,    0,    0,   69,    0,    0,  186,  186,  186,
+  186,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  186,  186,    0,  186,  186,  186,
+  186,    0,  186,  186,  186,    0,    0,    0,    0,    0,
+    0,   21,    0,    0,   22,   23,   24,    0,    0,    0,
+   25,   26,   27,   28,   29,    0,    0,    0,    0,    0,
+    0,    0,   34,   35,    0,   37,   38,   39,   40,   41,
+   42,   43,   44,   45,   46,   47,   48,   49,   50,   51,
+   52,   69,   53,   54,   55,    0,    0,    0,    0,    0,
+   56,    0,   57,   58,   59,   60,   61,   62,   63,   64,
+   65,   66,    0,   68,   67,    0,    0,    0,    0,    0,
+   72,   70,   71,   75,    0,   74,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   50,   50,   50,   50,
+    0,    0,    0,    0,    0,   21,    0,    0,   22,   23,
+   24,    0,    0,    0,   25,   26,   27,   28,   29,    0,
+    0,    0,    0,    0,    0,    0,   34,   35,    0,   37,
+   38,   39,   40,   41,   42,   43,   44,   45,   46,   47,
+   48,   49,   50,   51,   52,    0,   53,   54,   55,    0,
+    0,    0,   50,   50,   56,    0,   57,   58,   59,   60,
+   61,   62,   63,   64,   65,   66,   69,   68,   67,    0,
+    0,    0,    0,    0,   72,   70,   71,   75,    0,   74,
+    0,    0,  140,    0,    0,   22,   23,   24,    0,    0,
+    0,   25,   26,   27,   28,   29,    0,    0,    0,    0,
+    0,    0,    0,   34,   35,    0,   37,   38,   39,   40,
+   41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+   51,   52,    0,   53,   54,   55,    0,    0,    0,    0,
+    0,   56,    0,   57,   58,   59,   60,   61,   62,   63,
+   64,   65,   66,    0,    0,   67,    0,    0,    0,    0,
+    0,    0,   70,   71,    0,    0,  126,    0,    0,  126,
+   69,    0,  126,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  126,  126,    0,  126,
+    0,  126,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  196,    0,    0,
+   22,   23,   24,    0,    0,    0,   25,   26,   27,   28,
+   29,  126,  126,    0,    0,    0,    0,    0,   34,   35,
+    0,   37,   38,   39,   40,   41,   42,   43,   44,   45,
+   46,   47,   48,   49,   50,   51,   52,    0,   53,   54,
+   55,    0,  126,    0,    0,    0,   56,    0,   57,   58,
+   59,   60,   61,   62,   63,   64,   65,   66,    0,    0,
+   67,    0,    0,    0,    0,    0,    0,   70,   71,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  199,    0,    0,   22,   23,   24,    0,    0,    0,
+   25,   26,   27,   28,   29,    0,    0,    0,    0,    0,
+    0,    0,   34,   35,    0,   37,   38,   39,   40,   41,
+   42,   43,   44,   45,   46,   47,   48,   49,   50,   51,
+   52,    0,   53,   54,   55,    0,    0,    0,    0,    0,
+   56,    0,   57,   58,   59,   60,   61,   62,   63,   64,
+   65,   66,  121,    0,   67,  121,    0,    0,  121,    0,
+    0,   70,   71,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  121,  121,    0,  121,   67,  121,    0,   67,
+    0,  126,   67,    0,    0,    0,    0,    0,    0,  126,
+  126,  126,  126,    0,    0,    0,   67,   67,    0,   67,
+    0,   67,    0,    0,    0,    0,    0,  121,  121,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  126,
+  126,  126,  126,    0,    0,    0,    0,  148,    0,    0,
+  148,   67,   67,  148,    0,    0,  126,  126,  121,  126,
+  126,  126,  126,    0,  126,  126,  126,  148,  148,    0,
+  148,    0,  148,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   67,    0,  149,    0,    0,  149,    0,    0,
+  149,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  148,  148,  149,  149,    0,  149,    0,  149,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  137,    0,    0,  137,
+    0,    0,  137,  148,    0,    0,    0,    0,    0,  149,
+  149,    0,    0,    0,    0,    0,  137,  137,    0,  137,
+    0,  137,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  157,    0,    0,  157,    0,    0,  157,
+  149,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  137,  137,  157,  157,    0,  157,    0,  157,    0,
+    0,    0,    0,    0,    0,    0,    0,  121,    0,    0,
+    0,    0,    0,    0,    0,  121,  121,  121,  121,    0,
+    0,    0,  137,    0,    0,    0,    0,    0,  157,  157,
+    0,   67,    0,    0,    0,    0,    0,    0,    0,   67,
+   67,   67,   67,    0,    0,  121,  121,  121,  121,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   94,  157,
+    0,   94,  121,  121,   94,  121,  121,  121,  121,    0,
+  121,  121,  121,    0,    0,    0,    0,    0,   94,   94,
+    0,   94,  148,   94,    0,    0,   67,   67,    0,    0,
+  148,  148,  148,  148,    0,   67,   67,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   94,   94,    0,    0,    0,    0,  149,
+  148,  148,  148,  148,    0,    0,    0,  149,  149,  149,
+  149,    0,    0,   49,    0,    0,   49,  148,  148,    0,
+  148,  148,  148,  148,   94,  148,  148,  148,    0,    0,
+   49,   49,    0,    0,    0,    0,    0,  149,  149,  149,
+  149,  137,    0,    0,    0,    0,    0,    0,    0,  137,
+  137,  137,  137,    0,  149,  149,    0,  149,  149,  149,
+  149,    0,  149,  149,  149,   49,    0,    0,    0,    0,
+   98,    0,    0,   98,    0,    0,   98,    0,  157,  137,
+  137,  137,  137,    0,    0,    0,  157,  157,  157,  157,
+   98,   98,    0,   98,    0,   98,  137,  137,    0,  137,
+  137,  137,  137,    0,  137,  137,  137,    0,    0,    0,
+   52,    0,    0,   52,    0,    0,  157,  157,  157,  157,
+    0,    0,    0,    0,    0,   98,   98,   52,   52,    0,
+    0,    0,    0,  157,  157,    0,  157,  157,  157,  157,
+    0,  157,  157,  157,  186,    0,    0,  186,    0,    0,
+  186,    0,    0,    0,    0,    0,   98,    0,   54,    0,
+    0,   54,   52,   94,  186,  186,    0,  186,    0,  186,
+    0,   94,   94,   94,   94,   54,   54,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  115,    0,    0,  115,
+    0,    0,  115,    0,    0,    0,    0,    0,    0,  186,
+  186,   94,   94,   94,   94,    0,  115,  115,    0,  115,
+   54,  115,    0,    0,    0,    0,    0,    0,   94,   94,
+    0,   94,   94,   94,   94,    0,   94,   94,   94,  120,
+  186,    0,  120,    0,    0,  120,    0,    0,    0,    0,
+    0,  115,  115,   49,   49,   49,   49,    0,    0,  120,
+  120,    0,  120,    0,  120,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   91,  115,    0,   91,    0,    0,   91,    0,    0,
+    0,    0,    0,    0,  120,  120,    0,    0,    0,    0,
+    0,   91,   91,    0,   91,   98,   91,    0,    0,   49,
+   49,    0,    0,   98,   98,   98,   98,    0,    0,    0,
+    0,    0,    0,    0,    0,  120,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   91,   91,    0,    0,
+    0,    0,    0,   98,   98,   98,   98,    0,    0,    0,
+   52,   52,   52,   52,    0,    0,    0,    0,    0,    0,
+   98,   98,    0,   98,   98,   98,   98,   91,   98,   98,
+   98,   90,    0,    0,   90,    0,    0,   90,    0,  186,
+    0,    0,    0,    0,    0,    0,    0,  186,  186,  186,
+  186,   90,   90,    0,   90,    0,   90,    0,   54,   54,
+   54,   54,    0,    0,    0,    0,   52,   52,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  186,  186,  186,
+  186,  115,    0,    0,    0,    0,   90,   90,    0,  115,
+  115,  115,  115,    0,  186,  186,    0,  186,  186,  186,
+  186,    0,  186,  186,  186,  173,    0,    0,  173,    0,
+    0,    0,    0,    0,   54,   54,    0,   90,    0,  115,
+  115,  115,  115,    0,  120,  173,  173,    0,  173,    0,
+  173,    0,  120,  120,  120,  120,  115,  115,    0,  115,
+  115,  115,  115,    0,  115,  115,  115,  175,    0,    0,
+  175,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  173,  173,  120,  120,  120,  120,   91,  175,  175,    0,
+  175,    0,  175,    0,   91,   91,   91,   91,    0,  120,
+  120,    0,  120,  120,  120,  120,    0,  120,  120,  120,
+  176,  173,    0,  176,    0,    0,    0,    0,    0,    0,
+    0,    0,  175,  175,   91,   91,   91,   91,    0,    0,
+  176,  176,    0,  176,    0,  176,    0,    0,    0,    0,
+    0,   91,   91,    0,   91,   91,   91,   91,    0,   91,
+   91,   91,  177,  175,    0,  177,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  176,  176,    0,    0,    0,
+    0,    0,  177,  177,    0,  177,   90,  177,    0,    0,
+    0,    0,    0,    0,   90,   90,   90,   90,    0,    0,
+    0,    0,    0,    0,    0,    0,  176,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  177,  177,    0,
+    0,    0,    0,    0,   90,   90,   90,   90,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   90,   90,    0,   90,   90,   90,   90,  177,   90,
+   90,   90,   75,    0,    0,   75,    0,    0,   75,    0,
+  173,    0,    0,    0,    0,    0,    0,    0,  173,  173,
+  173,  173,   75,   75,    0,   75,    0,   75,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  173,  173,
+  173,  173,  175,    0,    0,    0,    0,   75,   75,    0,
+  175,  175,  175,  175,    0,  173,  173,    0,  173,  173,
+  173,  173,    0,  173,  173,  173,   76,    0,    0,   76,
+    0,    0,   76,    0,    0,    0,    0,    0,   75,    0,
+  175,  175,  175,  175,    0,  176,   76,   76,    0,   76,
+    0,   76,    0,  176,  176,  176,  176,  175,  175,    0,
+  175,  175,  175,  175,    0,  175,  175,  175,   61,    0,
+    0,   61,    0,    0,   61,    0,    0,    0,    0,    0,
+    0,   76,   76,  176,  176,  176,  176,  177,   61,   61,
+    0,   61,    0,   61,    0,  177,  177,  177,  177,    0,
+  176,  176,    0,  176,  176,  176,  176,    0,  176,  176,
+  176,   62,   76,    0,   62,    0,    0,   62,    0,    0,
+    0,    0,    0,   61,   61,  177,  177,  177,  177,    0,
+    0,   62,   62,    0,   62,    0,   62,    0,    0,    0,
+    0,    0,  177,  177,    0,  177,  177,  177,  177,    0,
+  177,  177,  177,   63,   61,    0,   63,    0,    0,   63,
+    0,    0,    0,    0,    0,    0,   62,   62,    0,    0,
+    0,    0,    0,   63,   63,    0,   63,   75,   63,    0,
+    0,    0,    0,    0,    0,   75,   75,   75,   75,    0,
+    0,    0,    0,    0,    0,    0,    0,   62,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   63,   63,
+    0,    0,    0,    0,    0,   75,   75,   75,   75,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   75,   75,    0,   75,   75,   75,   75,   63,
+    0,   75,   75,   64,    0,    0,   64,    0,    0,   64,
+    0,   76,    0,    0,    0,    0,    0,    0,    0,   76,
+   76,   76,   76,   64,   64,    0,   64,    0,   64,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   55,    0,
+    0,   55,    0,    0,    0,    0,    0,    0,    0,   76,
+   76,   76,   76,   61,    0,   55,   55,    0,   64,   64,
+    0,   61,   61,   61,   61,    0,   76,   76,    0,   76,
+   76,   76,   76,    0,    0,   76,   76,   65,    0,    0,
+   65,    0,    0,   65,    0,    0,    0,    0,    0,   64,
+   55,   61,   61,   61,   61,    0,   62,   65,   65,    0,
+   65,    0,   65,    0,   62,   62,   62,   62,   61,   61,
+    0,   61,   61,   61,   61,    0,    0,   61,   61,   92,
+    0,    0,   92,    0,    0,   92,    0,    0,    0,    0,
+    0,    0,   65,   65,   62,   62,   62,   62,   63,   92,
+   92,    0,   92,    0,   92,    0,   63,   63,   63,   63,
+    0,   62,   62,    0,   62,   62,    0,    0,    0,    0,
+   62,   62,   87,   65,    0,   87,    0,    0,   87,    0,
+    0,    0,    0,    0,   92,   92,   63,   63,    0,   63,
+    0,    0,   87,   87,    0,   87,  125,   87,    0,  125,
+    0,    0,  125,   63,   63,    0,   63,   63,   60,    0,
+    0,   60,   63,   63,    0,   92,  125,  125,    0,  125,
+    0,  125,    0,    0,    0,   60,   60,   87,   87,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   64,    0,
+    0,    0,    0,    0,    0,    0,   64,   64,   64,   64,
+    0,  125,  125,    0,    0,    0,    0,    0,   87,    0,
+   60,    0,    0,   66,    0,    0,   66,    0,    0,   66,
+    0,    0,    0,    0,    0,    0,   64,   64,   55,   55,
+   55,   55,  125,   66,   66,    0,   66,    0,   66,    0,
+    0,    0,    0,   64,   64,    0,   64,   64,    0,    0,
+    0,    0,   64,   64,   68,    0,    0,   68,    0,    0,
+   68,    0,   65,    0,    0,    0,    0,    0,   66,   66,
+   65,   65,   65,   65,   68,   68,    0,   68,    0,   68,
+    0,    0,    0,    0,   55,   55,    0,    0,    0,   59,
+    0,    0,   59,    0,    0,    0,    0,    0,    0,   66,
+   65,   65,    0,    0,   92,    0,   59,   59,    0,   68,
+   68,    0,   92,   92,   92,   92,    0,   65,   65,    0,
+   65,   65,    0,    0,    0,    0,   65,   65,  156,    0,
+    0,  156,    0,    0,  156,    0,    0,    0,    0,    0,
+   68,   59,   92,   92,    0,    0,    0,   87,  156,  156,
+    0,  156,    0,  156,    0,   87,   87,   87,   87,   92,
+   92,    0,    0,    0,    0,    0,    0,    0,   92,   92,
+    0,  125,    0,    0,    0,    0,    0,    0,    0,  125,
+  125,  125,  125,  156,  156,   87,   87,    0,   60,   60,
+   60,   60,    0,    0,    0,   88,    0,    0,   88,    0,
+    0,   88,   87,   87,   58,    0,    0,   58,    0,  125,
+  125,   87,   87,    0,  156,   88,   88,    0,   88,    0,
+   88,   58,   58,    0,    0,    0,  125,  125,    0,    0,
+    0,    0,    0,    0,    0,  125,  125,    0,   66,    0,
+    0,    0,    0,    0,   60,   60,   66,   66,   66,   66,
+   88,   88,    0,    0,    0,    0,   58,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   66,    0,   68,
+    0,   88,    0,    0,    0,    0,    0,   68,   68,   68,
+   68,    0,  172,   66,   66,  172,    0,    0,  172,    0,
+    0,    0,   66,   66,  123,    0,    0,  123,    0,    0,
+  123,    0,  172,  172,    0,  172,    0,  172,    0,   59,
+   59,   59,   59,    0,  123,  123,    0,  123,    0,  123,
+    0,    0,    0,    0,   68,   68,    0,    0,    0,    0,
+    0,    0,    0,   68,   68,    0,    0,  172,  172,    0,
+    0,    0,    0,  156,    0,    0,    0,    0,    0,  123,
+  123,  156,  156,  156,  156,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   59,   59,   77,  172,    0,
+   77,    0,    0,   77,    0,    0,    0,    0,    0,    0,
+  123,  156,  156,  156,  156,    0,    0,   77,   77,    0,
+   77,    0,   77,    0,    0,    0,    0,    0,  156,  156,
+    0,  156,  156,  156,  156,    0,  156,    0,    0,    0,
+   88,    0,    0,    0,    0,    0,    0,    0,   88,   88,
+   88,   88,   77,   77,   58,   58,   58,   58,    0,    0,
+    0,    0,    0,    0,  174,    0,    0,  174,    0,    0,
+  174,    0,    0,    0,    0,    0,    0,    0,   88,   88,
+   88,   88,    0,   77,  174,  174,    0,  174,    0,  174,
+   56,    0,    0,   56,    0,   88,   88,    0,   88,   88,
+   88,   88,    0,   88,    0,    0,    0,   56,   56,    0,
+   58,   58,    0,    0,    0,    0,    0,    0,    0,  174,
+  174,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  172,    0,    0,
+    0,    0,   56,    0,    0,  172,  172,  172,  172,  123,
+  174,    0,    0,    0,    0,    0,    0,  123,  123,  123,
+  123,   80,    0,    0,   80,    0,    0,   80,    0,    0,
+    0,    0,    0,    0,    0,  172,  172,  172,  172,    0,
+    0,   80,   80,    0,   80,    0,   80,  123,  123,  123,
+  123,    0,  172,  172,    0,  172,  172,  172,  172,    0,
+  172,    0,    0,    0,  123,  123,    0,  123,  123,  123,
+  123,    0,  123,    0,    0,    0,   80,   80,   81,    0,
+    0,   81,   77,    0,   81,    0,    0,    0,    0,    0,
+   77,   77,   77,   77,    0,    0,    0,    0,   81,   81,
+    0,   81,    0,   81,    0,  186,    0,   80,  307,    0,
+    0,  293,    0,    0,    0,    0,    0,    0,    0,    0,
+   77,   77,   77,   77,    0,    0,    0,    0,  180,    0,
+  181,    0,    0,   81,   81,    0,    0,   77,   77,    0,
+   77,   77,   77,   77,    0,   77,    0,   78,    0,  174,
+   78,    0,    0,   78,    0,    0,    0,  174,  174,  174,
+  174,  185,    0,    0,   81,    0,    0,   78,   78,    0,
+   78,    0,   78,   79,    0,    0,   79,    0,    0,   79,
+   56,   56,   56,   56,    0,    0,    0,  174,  174,  174,
+  174,  184,    0,   79,   79,    0,   79,    0,   79,    0,
+    0,    0,   78,   78,  174,  174,    0,  174,  174,  174,
+  174,    0,  174,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  186,    0,    0,    0,   79,   79,
+  293,    0,    0,   78,    0,  186,   56,   56,    0,    0,
+    0,  291,    0,    0,    0,    0,   80,  180,   57,  181,
+    0,   57,    0,    0,   80,   80,   80,   80,  180,   79,
+  181,    0,    0,    0,    0,   57,   57,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  185,    0,    0,    0,   80,   80,   80,   80,    0,    0,
+    0,  185,    0,    0,    0,    0,    0,    0,    0,    0,
+   57,   80,   80,   81,   80,   80,   80,   80,    0,   80,
+  184,   81,   81,   81,   81,    0,    0,    0,    0,    0,
+    0,  184,    0,    0,    0,    0,   68,    0,    0,    0,
+  175,    0,    0,   72,    0,    0,   75,    0,   74,    0,
+    0,   81,   81,   81,   81,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   81,   81,
+    0,   81,   81,   81,   81,    0,   81,    0,  176,  177,
+  178,  179,   78,    0,    0,    0,    0,    0,    0,    0,
+   78,   78,   78,   78,  148,  182,  183,    0,  187,  188,
+  189,  190,    0,  191,    0,    0,    0,    0,   79,    0,
+   53,    0,    0,   53,    0,    0,   79,   79,   79,   79,
+   78,   78,   78,   78,    0,    0,  147,   53,   53,   69,
+    0,    0,    0,   70,    0,    0,   70,   78,   78,    0,
+   78,   78,   78,   78,    0,   78,   79,   79,   79,   79,
+   70,   70,    0,   70,    0,   70,    0,    0,    0,  175,
+    0,    0,   53,   79,   79,    0,   79,   79,   79,   79,
+  175,   79,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   69,   70,   70,   69,   57,   57,
+   57,   57,    0,    0,    0,    0,    0,  176,  177,  178,
+  179,   69,   69,    0,   69,    0,   69,    0,  176,  177,
+  178,  179,    0,    0,  182,  183,   70,  187,  188,  189,
+  190,    0,  191,    0,    0,  182,  183,    0,  187,  188,
+  189,  190,    0,  191,    0,    0,   69,   69,    0,    0,
+    0,    0,    0,    0,   57,   57,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   21,    0,    0,   22,   23,   24,    0,   69,    0,   25,
+   26,   27,   28,   29,    0,    0,    0,    0,    0,    0,
+    0,   34,   35,    0,   37,   38,   39,   40,   41,   42,
+   43,   44,   45,   46,   47,   48,   49,   50,   51,   52,
+    0,   53,   54,   55,    0,    0,    0,    0,    0,   56,
+    0,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+   66,    0,    0,   67,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   53,   53,   53,   53,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   70,    0,    0,    0,    0,
+    0,    0,    0,   70,   70,   70,   70,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  154,    0,    0,    0,    0,    0,  162,    0,
+    0,    0,    0,    0,    0,    0,   53,   53,    0,    0,
+    0,    0,    0,    0,    0,    0,   69,    0,    0,    0,
+   70,   70,    0,    0,   69,   69,   69,   69,    0,   70,
+   70,    0,    0,  207,    0,  210,    0,  212,    0,  214,
+    0,    0,  217,    0,  221,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  231,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  240,    0,
+    0,   69,   69,  245,  246,  247,  248,  249,  250,  251,
+   69,   69,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  259,  260,  261,  262,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  297,  299,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  310,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  329,    0,  332,
+  334,    0,    0,    0,    0,    0,    0,    0,  339,    0,
+    0,    0,    0,  342,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  352,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  358,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  207,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  382,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  388,
+};
+short yycheck[] = {                                      17,
+    0,   41,   40,   40,   44,   40,   61,   25,   44,   40,
+   40,  125,   30,   31,   32,   33,   40,   40,   40,  257,
+  108,   28,  110,   93,  112,  257,  114,  257,  257,   41,
+   91,   44,   40,   33,   44,   40,   40,   40,  217,  136,
+   40,  138,  221,   43,  257,   45,   44,   59,   66,   67,
+   40,  121,  122,  123,  124,  125,  126,   44,   91,   59,
+   91,  240,  123,   41,  258,  323,  324,  216,  326,    0,
+   41,  265,   41,  311,  307,   44,  225,  226,  310,  308,
+   93,   59,   61,   93,  233,  234,  235,  236,   59,  238,
+  123,  123,  123,  123,  101,   93,  103,  104,   59,  123,
+  123,  123,   33,  297,   41,   41,   93,   41,   44,   40,
+   44,  305,   43,  301,   45,  303,  304,   44,  297,   41,
+  299,   41,   59,  123,  257,  125,  126,   44,   59,  327,
+  328,  310,   59,  321,  322,  323,  324,   59,  326,   59,
+  303,  304,   59,   44,  258,  294,   40,  165,   40,  167,
+   40,  265,   40,  332,   38,  334,   59,   44,   59,  308,
+  323,  324,   40,  326,  303,   38,   41,  316,   41,   44,
+   41,   44,   59,   44,  323,  324,  275,  276,  277,  358,
+  303,  304,   40,  297,  323,  324,   41,  326,   61,   44,
+   63,  305,  123,   41,   41,  126,   44,   44,  321,  322,
+  323,  324,  257,  326,   41,   41,  355,   44,   44,   40,
+   94,   40,   40,   40,   40,  303,  304,  305,  306,  257,
+  257,   94,  257,  372,  312,   40,   40,   40,   40,  378,
+   40,  271,  272,  273,  274,  271,  272,  273,  274,   40,
+  124,   40,  307,   40,   40,  308,   41,  317,  318,  257,
+  399,  124,  257,  123,  257,   40,  256,  257,  258,   40,
+  260,  261,  262,   40,   44,  265,  266,  267,  268,  269,
+  270,  271,  272,  273,  274,   38,  311,  365,  278,  279,
+  280,  281,  282,  283,  284,  285,  286,  287,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,  297,  298,  299,
+  300,  389,  310,  308,  308,  305,  306,  310,  308,  309,
+  310,  311,  312,  313,  314,  315,  316,  317,  308,   91,
+  320,   41,   44,   41,   41,  256,  257,  327,  328,  260,
+  261,  262,   44,   41,   41,  266,  267,  268,  269,  270,
+  271,  272,  273,  274,   59,   41,   44,  278,  279,  280,
+  281,  282,  283,  284,  285,  286,  287,  288,  289,  290,
+  291,  292,  293,  294,  295,  296,   25,  298,  299,  300,
+   29,   44,   44,   41,  123,  306,  326,  308,  309,  310,
+  311,  312,  313,  314,  315,  316,  317,   91,   41,  320,
+  263,  224,   41,   41,   53,   41,  327,  328,  416,  232,
+  125,  125,   41,   59,   41,   41,  239,   41,   67,   41,
+   41,  125,   41,   41,   41,   33,  125,  301,  302,  303,
+  304,   41,   40,   89,   41,   43,   41,   45,  301,  302,
+  303,  304,   91,   41,   93,  319,   41,  321,  322,  323,
+  324,   59,  326,   59,   41,  318,  319,   59,  321,  322,
+  323,  324,   59,  326,  327,  328,  115,   41,   41,   12,
+  395,  311,  121,  122,  123,  124,  125,  126,   -1,   -1,
+  129,  130,  131,  132,  133,   -1,   -1,   -1,   -1,   -1,
+  139,   -1,  315,   -1,   33,   -1,   -1,   -1,  321,  322,
+   -1,   40,   -1,  326,   43,   -1,   45,   68,   69,   70,
+   71,   -1,   -1,   74,   75,  123,   -1,   -1,  126,   -1,
+   59,   38,   -1,   -1,   -1,  174,  175,  176,  177,  178,
+  179,  180,  181,  182,  183,  184,  185,  186,  187,  188,
+  189,  190,  191,   -1,   -1,   -1,   -1,  370,  301,  302,
+  303,  304,   -1,   -1,  377,   -1,   -1,   -1,   -1,   38,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  321,  322,
+  323,  324,   -1,  326,   -1,   -1,   -1,   94,   -1,   -1,
+  403,   -1,   -1,   -1,  123,   -1,   -1,  126,   -1,  412,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   33,  254,   -1,  124,   -1,   -1,
+   -1,   40,   -1,   -1,   43,   94,   45,   -1,  267,   -1,
+  269,   -1,   -1,   -1,   -1,   -1,  275,   -1,  277,   -1,
+  279,   -1,  281,   -1,  283,   -1,   -1,   -1,  287,   -1,
+   -1,   -1,   -1,   -1,  293,  124,   -1,   -1,  256,  257,
+   -1,   -1,  260,  261,  262,   -1,   -1,   -1,  266,  267,
+  268,  269,  270,  271,  272,  273,  274,   -1,  317,  318,
+  278,  279,  280,  281,  282,  283,  284,  285,  286,  287,
+  288,  289,  290,  291,  292,  293,  294,  295,  296,   -1,
+  298,  299,  300,   -1,  123,   -1,  345,  126,  306,   -1,
+  308,  309,  310,  311,  312,  313,  314,  315,  316,  317,
+   -1,   -1,  320,   -1,   -1,   -1,   -1,  256,  257,  327,
+  328,  260,  261,  262,   -1,   -1,   -1,  266,  267,  268,
+  269,  270,  271,  272,  273,  274,   -1,   -1,   -1,  278,
+  279,  280,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,  298,
+  299,  300,   -1,   -1,   -1,   -1,   -1,  306,   -1,  308,
+  309,  310,  311,  312,  313,  314,  315,  316,  317,   -1,
+   -1,  320,   -1,   33,  301,  302,  303,  304,  327,  328,
+   40,   -1,   -1,   43,   -1,   45,  301,  302,  303,  304,
+   -1,  318,  319,   -1,  321,  322,  323,  324,   -1,  326,
+   -1,   -1,   -1,   -1,   -1,   -1,  321,  322,  323,  324,
+   -1,  326,  301,  302,  303,  304,   -1,   -1,  257,   -1,
+   -1,  260,  261,  262,   -1,   -1,   -1,  266,  267,  268,
+  269,  270,  321,  322,  323,  324,   -1,  326,   -1,  278,
+  279,   -1,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,  298,
+  299,  300,   -1,  123,   -1,   -1,  126,  306,   -1,  308,
+  309,  310,  311,  312,  313,  314,  315,  316,  317,   -1,
+   33,  320,   -1,   -1,   -1,   -1,   -1,   40,  327,  328,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   33,   -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,
+  123,   -1,   -1,  126,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   38,   -1,   -1,   -1,   -1,   -1,  257,   -1,   -1,
+  260,  261,  262,   -1,   -1,   -1,  266,  267,  268,  269,
+  270,   58,   -1,   -1,   61,   -1,   63,   -1,  278,  279,
+   -1,  281,  282,  283,  284,  285,  286,  287,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,  126,  298,  299,
+  300,   -1,   -1,   -1,   -1,   -1,  306,   94,  308,  309,
+  310,  311,  312,  313,  314,  315,  316,  317,   -1,   33,
+  320,   -1,   -1,   -1,   -1,   -1,   40,  327,  328,   43,
+   41,   45,   -1,   44,   -1,   -1,   -1,  124,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   61,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  257,   -1,   -1,  260,  261,  262,
+   -1,   -1,   -1,  266,  267,  268,  269,  270,   -1,   -1,
+   -1,   -1,   93,   -1,   -1,  278,  279,   -1,  281,  282,
+  283,  284,  285,  286,  287,  288,  289,  290,  291,  292,
+  293,  294,  295,  296,   -1,  298,  299,  300,   -1,   -1,
+   -1,   -1,  126,  306,   -1,  308,  309,  310,  311,  312,
+  313,  314,  315,  316,  317,   -1,   -1,  320,  257,   -1,
+   -1,  260,  261,  262,  327,  328,   33,  266,  267,  268,
+  269,  270,   -1,   40,   41,   -1,   43,   -1,   45,  278,
+  279,   -1,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,  298,
+  299,  300,   -1,   -1,   -1,   -1,  263,  306,   -1,  308,
+  309,  310,  311,  312,  313,  314,  315,  316,  317,   -1,
+   -1,  320,   -1,   -1,   -1,   -1,   -1,   -1,  327,  328,
+   33,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,
+   43,   -1,   45,   -1,  301,  302,  303,  304,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  126,
+   -1,  318,  319,   -1,  321,  322,  323,  324,   -1,  326,
+   -1,   -1,  256,  257,   -1,   -1,  260,  261,  262,   -1,
+   -1,   -1,  266,  267,  268,  269,  270,   -1,   -1,   -1,
+  271,  272,  273,  274,  278,  279,   -1,  281,  282,  283,
+  284,  285,  286,  287,  288,  289,  290,  291,  292,  293,
+  294,  295,  296,   -1,  298,  299,  300,   -1,   -1,   -1,
+   -1,   -1,  306,  126,  308,  309,  310,  311,  312,  313,
+  314,  315,  316,  317,   -1,   -1,  320,   -1,   -1,   -1,
+   -1,   33,   -1,  327,  328,   -1,  327,  328,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   61,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,  266,
+  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  278,  279,   -1,  281,  282,  283,  284,  285,  286,
+  287,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,  299,  300,  126,   -1,   -1,   -1,   -1,  306,
+   -1,  308,  309,  310,  311,  312,  313,  314,  315,  316,
+  317,   -1,   41,  320,  257,   44,   -1,  260,  261,  262,
+  327,  328,   -1,  266,  267,  268,  269,  270,   -1,   58,
+   59,   -1,   61,   -1,   63,  278,  279,   -1,  281,  282,
+  283,  284,  285,  286,  287,  288,  289,  290,  291,  292,
+  293,  294,  295,  296,   -1,  298,  299,  300,   -1,   -1,
+   -1,   -1,   -1,  306,   93,  308,  309,  310,  311,  312,
+  313,  314,  315,  316,  317,   -1,   33,  320,   -1,   -1,
+   -1,   -1,   -1,   40,  327,  328,   43,   -1,   45,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   61,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,   -1,   -1,  260,  261,
+  262,   -1,   -1,   -1,  266,  267,  268,  269,  270,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  278,  279,   -1,  281,
+  282,  283,  284,  285,  286,  287,  288,  289,  290,  291,
+  292,  293,  294,  295,  296,   -1,  298,  299,  300,  126,
+   -1,   -1,   41,   -1,  306,   44,  308,  309,  310,  311,
+  312,  313,  314,  315,  316,  317,   -1,   33,  320,   58,
+   59,   -1,   61,   -1,   40,  327,  328,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   61,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  263,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  271,  272,  273,  274,   -1,   -1,   -1,   -1,
+   -1,   33,   -1,   -1,   -1,   -1,   -1,   -1,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   61,
+  126,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  318,
+  319,   -1,   -1,   -1,   38,   -1,   -1,   -1,  327,  328,
+  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,  266,
+  267,  268,  269,  270,   -1,   -1,   -1,   61,   -1,   63,
+   -1,  278,  279,   -1,  281,  282,  283,  284,  285,  286,
+  287,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,  299,  300,  126,   -1,   -1,   -1,   -1,  306,
+   94,  308,  309,  310,  311,  312,  313,  314,  315,  316,
+  317,   -1,   33,  320,   -1,   -1,   -1,   -1,   -1,   40,
+  327,  328,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   61,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  271,  272,  273,  274,   -1,   -1,   -1,   -1,
+   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,
+  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,  285,
+  286,  287,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,   -1,  298,  299,  300,  126,   -1,   -1,  327,  328,
+  306,   -1,  308,  309,  310,  311,  312,  313,  314,  315,
+  316,  317,   -1,   41,  320,  257,   44,   -1,  260,  261,
+  262,  327,  328,   -1,  266,  267,  268,  269,  270,   -1,
+   58,   59,   -1,   61,   -1,   63,  278,  279,   -1,  281,
+  282,  283,  284,  285,  286,  287,  288,  289,  290,  291,
+  292,  293,  294,  295,  296,   -1,  298,  299,  300,  263,
+   -1,   -1,   -1,   -1,  306,   93,  308,  309,  310,  311,
+  312,  313,  314,  315,  316,  317,   -1,   33,  320,   -1,
+   -1,   -1,   -1,   -1,   40,  327,  328,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,  303,
+  304,   -1,   -1,   -1,   -1,   61,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  318,  319,   38,  321,  322,  323,
+  324,   -1,  326,   -1,   -1,   -1,  257,   -1,   -1,  260,
+  261,  262,   -1,   -1,   -1,  266,  267,  268,  269,  270,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,  278,  279,   -1,
+  281,  282,  283,  284,  285,  286,  287,  288,  289,  290,
+  291,  292,  293,  294,  295,  296,   -1,  298,  299,  300,
+  126,   -1,   94,   -1,   -1,  306,   -1,  308,  309,  310,
+  311,  312,  313,  314,  315,  316,  317,   -1,   33,  320,
+   -1,   -1,   -1,   -1,   -1,   40,  327,  328,   43,   -1,
+   45,   -1,  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   61,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  263,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  271,  272,  273,  274,   -1,   -1,   -1,
+   -1,   -1,   33,   -1,   -1,   -1,   -1,   -1,   -1,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   61,  126,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  318,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  327,
+  328,  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,
+  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,  285,
+  286,  287,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,  263,  298,  299,  300,  126,   -1,   -1,   -1,   -1,
+  306,   -1,  308,  309,  310,  311,  312,  313,  314,  315,
+  316,  317,   -1,   -1,  320,   -1,   33,   -1,   -1,   -1,
+   -1,  327,  328,   40,   41,   -1,   43,   -1,   45,  301,
+  302,  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  318,  319,   -1,  321,
+  322,  323,  324,   -1,  326,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,
+   -1,  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,
+  285,  286,  287,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,  299,  300,   -1,   -1,   -1,  126,
+   -1,  306,   -1,  308,  309,  310,  311,  312,  313,  314,
+  315,  316,  317,   -1,   -1,  320,  257,   -1,   -1,  260,
+  261,  262,  327,  328,   33,  266,  267,  268,  269,  270,
+   -1,   40,   41,   -1,   43,   -1,   45,  278,  279,   -1,
+  281,  282,  283,  284,  285,  286,  287,  288,  289,  290,
+  291,  292,  293,  294,  295,  296,   -1,  298,  299,  300,
+   -1,   -1,   -1,   -1,   -1,  306,   -1,  308,  309,  310,
+  311,  312,  313,  314,  315,  316,  317,   -1,   -1,  320,
+   -1,   -1,   -1,   -1,   -1,   -1,  327,  328,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,
+   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,   43,   -1,
+   45,   -1,   -1,   -1,   -1,   -1,   -1,  126,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,  266,
+  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  278,  279,   -1,  281,  282,  283,  284,  285,  286,
+  287,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,  299,  300,   -1,   -1,   -1,   -1,   -1,  306,
+   -1,  308,  309,  310,  311,  312,  313,  314,  315,  316,
+  317,  126,   -1,  320,   -1,   33,   -1,   -1,   -1,   -1,
+  327,  328,   40,   41,   -1,   43,   -1,   45,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -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,   -1,
+   -1,  260,  261,  262,   -1,   -1,   -1,  266,  267,  268,
+  269,  270,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  278,
+  279,   -1,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,  126,  298,
+  299,  300,   -1,   -1,   -1,   -1,   -1,  306,   -1,  308,
+  309,  310,  311,  312,  313,  314,  315,  316,  317,   -1,
+   -1,  320,   -1,   -1,   38,   -1,   -1,   -1,  327,  328,
+   44,   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,
+   -1,  266,  267,  268,  269,  270,   -1,   61,   -1,   63,
+   -1,   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,
+  285,  286,  287,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,  299,  300,   -1,   -1,   -1,   -1,
+   94,  306,   -1,  308,  309,  310,  311,  312,  313,  314,
+  315,  316,  317,   -1,   -1,  320,   -1,   33,   -1,   -1,
+   -1,   -1,  327,  328,   40,   41,   -1,   43,   -1,   45,
+  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,
+   -1,   -1,  260,  261,  262,   -1,   -1,   -1,  266,  267,
+  268,  269,  270,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  278,  279,   -1,  281,  282,  283,  284,  285,  286,  287,
+  288,  289,  290,  291,  292,  293,  294,  295,  296,   -1,
+  298,  299,  300,   -1,   -1,   -1,   41,   -1,  306,   44,
+  308,  309,  310,  311,  312,  313,  314,  315,  316,  317,
+  126,   33,  320,   58,   59,   -1,   -1,   -1,   40,  327,
+  328,   43,   -1,   45,   -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,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  263,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,
+   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,
+   45,   -1,   -1,   -1,  126,   -1,   -1,  301,  302,  303,
+  304,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  318,  319,   -1,  321,  322,  323,
+  324,   -1,  326,  327,  328,   -1,   -1,   -1,   -1,   -1,
+   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,
+  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,  285,
+  286,  287,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,  126,  298,  299,  300,   -1,   -1,   -1,   -1,   -1,
+  306,   -1,  308,  309,  310,  311,  312,  313,  314,  315,
+  316,  317,   -1,   33,  320,   -1,   -1,   -1,   -1,   -1,
+   40,  327,  328,   43,   -1,   45,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,  273,  274,
+   -1,   -1,   -1,   -1,   -1,  257,   -1,   -1,  260,  261,
+  262,   -1,   -1,   -1,  266,  267,  268,  269,  270,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  278,  279,   -1,  281,
+  282,  283,  284,  285,  286,  287,  288,  289,  290,  291,
+  292,  293,  294,  295,  296,   -1,  298,  299,  300,   -1,
+   -1,   -1,  327,  328,  306,   -1,  308,  309,  310,  311,
+  312,  313,  314,  315,  316,  317,  126,   33,  320,   -1,
+   -1,   -1,   -1,   -1,   40,  327,  328,   43,   -1,   45,
+   -1,   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,
+   -1,  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,
+  285,  286,  287,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,  299,  300,   -1,   -1,   -1,   -1,
+   -1,  306,   -1,  308,  309,  310,  311,  312,  313,  314,
+  315,  316,  317,   -1,   -1,  320,   -1,   -1,   -1,   -1,
+   -1,   -1,  327,  328,   -1,   -1,   38,   -1,   -1,   41,
+  126,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   61,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,   -1,   -1,
+  260,  261,  262,   -1,   -1,   -1,  266,  267,  268,  269,
+  270,   93,   94,   -1,   -1,   -1,   -1,   -1,  278,  279,
+   -1,  281,  282,  283,  284,  285,  286,  287,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,   -1,  298,  299,
+  300,   -1,  124,   -1,   -1,   -1,  306,   -1,  308,  309,
+  310,  311,  312,  313,  314,  315,  316,  317,   -1,   -1,
+  320,   -1,   -1,   -1,   -1,   -1,   -1,  327,  328,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  257,   -1,   -1,  260,  261,  262,   -1,   -1,   -1,
+  266,  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  278,  279,   -1,  281,  282,  283,  284,  285,
+  286,  287,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,   -1,  298,  299,  300,   -1,   -1,   -1,   -1,   -1,
+  306,   -1,  308,  309,  310,  311,  312,  313,  314,  315,
+  316,  317,   38,   -1,  320,   41,   -1,   -1,   44,   -1,
+   -1,  327,  328,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   58,   59,   -1,   61,   38,   63,   -1,   41,
+   -1,  263,   44,   -1,   -1,   -1,   -1,   -1,   -1,  271,
+  272,  273,  274,   -1,   -1,   -1,   58,   59,   -1,   61,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,
+  302,  303,  304,   -1,   -1,   -1,   -1,   38,   -1,   -1,
+   41,   93,   94,   44,   -1,   -1,  318,  319,  124,  321,
+  322,  323,  324,   -1,  326,  327,  328,   58,   59,   -1,
+   61,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  124,   -1,   38,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   93,   94,   58,   59,   -1,   61,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   38,   -1,   -1,   41,
+   -1,   -1,   44,  124,   -1,   -1,   -1,   -1,   -1,   93,
+   94,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   61,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   38,   -1,   -1,   41,   -1,   -1,   44,
+  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   93,   94,   58,   59,   -1,   61,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  263,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  271,  272,  273,  274,   -1,
+   -1,   -1,  124,   -1,   -1,   -1,   -1,   -1,   93,   94,
+   -1,  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,
+  272,  273,  274,   -1,   -1,  301,  302,  303,  304,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   38,  124,
+   -1,   41,  318,  319,   44,  321,  322,  323,  324,   -1,
+  326,  327,  328,   -1,   -1,   -1,   -1,   -1,   58,   59,
+   -1,   61,  263,   63,   -1,   -1,  318,  319,   -1,   -1,
+  271,  272,  273,  274,   -1,  327,  328,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   93,   94,   -1,   -1,   -1,   -1,  263,
+  301,  302,  303,  304,   -1,   -1,   -1,  271,  272,  273,
+  274,   -1,   -1,   41,   -1,   -1,   44,  318,  319,   -1,
+  321,  322,  323,  324,  124,  326,  327,  328,   -1,   -1,
+   58,   59,   -1,   -1,   -1,   -1,   -1,  301,  302,  303,
+  304,  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,
+  272,  273,  274,   -1,  318,  319,   -1,  321,  322,  323,
+  324,   -1,  326,  327,  328,   93,   -1,   -1,   -1,   -1,
+   38,   -1,   -1,   41,   -1,   -1,   44,   -1,  263,  301,
+  302,  303,  304,   -1,   -1,   -1,  271,  272,  273,  274,
+   58,   59,   -1,   61,   -1,   63,  318,  319,   -1,  321,
+  322,  323,  324,   -1,  326,  327,  328,   -1,   -1,   -1,
+   41,   -1,   -1,   44,   -1,   -1,  301,  302,  303,  304,
+   -1,   -1,   -1,   -1,   -1,   93,   94,   58,   59,   -1,
+   -1,   -1,   -1,  318,  319,   -1,  321,  322,  323,  324,
+   -1,  326,  327,  328,   38,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,  124,   -1,   41,   -1,
+   -1,   44,   93,  263,   58,   59,   -1,   61,   -1,   63,
+   -1,  271,  272,  273,  274,   58,   59,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   38,   -1,   -1,   41,
+   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   93,
+   94,  301,  302,  303,  304,   -1,   58,   59,   -1,   61,
+   93,   63,   -1,   -1,   -1,   -1,   -1,   -1,  318,  319,
+   -1,  321,  322,  323,  324,   -1,  326,  327,  328,   38,
+  124,   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,
+   -1,   93,   94,  271,  272,  273,  274,   -1,   -1,   58,
+   59,   -1,   61,   -1,   63,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   38,  124,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   93,   94,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,   61,  263,   63,   -1,   -1,  327,
+  328,   -1,   -1,  271,  272,  273,  274,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  124,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,   -1,
+   -1,   -1,   -1,  301,  302,  303,  304,   -1,   -1,   -1,
+  271,  272,  273,  274,   -1,   -1,   -1,   -1,   -1,   -1,
+  318,  319,   -1,  321,  322,  323,  324,  124,  326,  327,
+  328,   38,   -1,   -1,   41,   -1,   -1,   44,   -1,  263,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,  273,
+  274,   58,   59,   -1,   61,   -1,   63,   -1,  271,  272,
+  273,  274,   -1,   -1,   -1,   -1,  327,  328,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,  303,
+  304,  263,   -1,   -1,   -1,   -1,   93,   94,   -1,  271,
+  272,  273,  274,   -1,  318,  319,   -1,  321,  322,  323,
+  324,   -1,  326,  327,  328,   38,   -1,   -1,   41,   -1,
+   -1,   -1,   -1,   -1,  327,  328,   -1,  124,   -1,  301,
+  302,  303,  304,   -1,  263,   58,   59,   -1,   61,   -1,
+   63,   -1,  271,  272,  273,  274,  318,  319,   -1,  321,
+  322,  323,  324,   -1,  326,  327,  328,   38,   -1,   -1,
+   41,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   93,   94,  301,  302,  303,  304,  263,   58,   59,   -1,
+   61,   -1,   63,   -1,  271,  272,  273,  274,   -1,  318,
+  319,   -1,  321,  322,  323,  324,   -1,  326,  327,  328,
+   38,  124,   -1,   41,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   93,   94,  301,  302,  303,  304,   -1,   -1,
+   58,   59,   -1,   61,   -1,   63,   -1,   -1,   -1,   -1,
+   -1,  318,  319,   -1,  321,  322,  323,  324,   -1,  326,
+  327,  328,   38,  124,   -1,   41,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,   -1,   -1,
+   -1,   -1,   58,   59,   -1,   61,  263,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,  271,  272,  273,  274,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  124,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   -1,   -1,  301,  302,  303,  304,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  318,  319,   -1,  321,  322,  323,  324,  124,  326,
+  327,  328,   38,   -1,   -1,   41,   -1,   -1,   44,   -1,
+  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,
+  273,  274,   58,   59,   -1,   61,   -1,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,
+  303,  304,  263,   -1,   -1,   -1,   -1,   93,   94,   -1,
+  271,  272,  273,  274,   -1,  318,  319,   -1,  321,  322,
+  323,  324,   -1,  326,  327,  328,   38,   -1,   -1,   41,
+   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,  124,   -1,
+  301,  302,  303,  304,   -1,  263,   58,   59,   -1,   61,
+   -1,   63,   -1,  271,  272,  273,  274,  318,  319,   -1,
+  321,  322,  323,  324,   -1,  326,  327,  328,   38,   -1,
+   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,
+   -1,   93,   94,  301,  302,  303,  304,  263,   58,   59,
+   -1,   61,   -1,   63,   -1,  271,  272,  273,  274,   -1,
+  318,  319,   -1,  321,  322,  323,  324,   -1,  326,  327,
+  328,   38,  124,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   93,   94,  301,  302,  303,  304,   -1,
+   -1,   58,   59,   -1,   61,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,  318,  319,   -1,  321,  322,  323,  324,   -1,
+  326,  327,  328,   38,  124,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,   -1,
+   -1,   -1,   -1,   58,   59,   -1,   61,  263,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,  271,  272,  273,  274,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  124,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,
+   -1,   -1,   -1,   -1,   -1,  301,  302,  303,  304,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  318,  319,   -1,  321,  322,  323,  324,  124,
+   -1,  327,  328,   38,   -1,   -1,   41,   -1,   -1,   44,
+   -1,  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,
+  272,  273,  274,   58,   59,   -1,   61,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,
+  302,  303,  304,  263,   -1,   58,   59,   -1,   93,   94,
+   -1,  271,  272,  273,  274,   -1,  318,  319,   -1,  321,
+  322,  323,  324,   -1,   -1,  327,  328,   38,   -1,   -1,
+   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,  124,
+   93,  301,  302,  303,  304,   -1,  263,   58,   59,   -1,
+   61,   -1,   63,   -1,  271,  272,  273,  274,  318,  319,
+   -1,  321,  322,  323,  324,   -1,   -1,  327,  328,   38,
+   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,
+   -1,   -1,   93,   94,  301,  302,  303,  304,  263,   58,
+   59,   -1,   61,   -1,   63,   -1,  271,  272,  273,  274,
+   -1,  318,  319,   -1,  321,  322,   -1,   -1,   -1,   -1,
+  327,  328,   38,  124,   -1,   41,   -1,   -1,   44,   -1,
+   -1,   -1,   -1,   -1,   93,   94,  301,  302,   -1,  304,
+   -1,   -1,   58,   59,   -1,   61,   38,   63,   -1,   41,
+   -1,   -1,   44,  318,  319,   -1,  321,  322,   41,   -1,
+   -1,   44,  327,  328,   -1,  124,   58,   59,   -1,   61,
+   -1,   63,   -1,   -1,   -1,   58,   59,   93,   94,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  263,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,  273,  274,
+   -1,   93,   94,   -1,   -1,   -1,   -1,   -1,  124,   -1,
+   93,   -1,   -1,   38,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,  271,  272,
+  273,  274,  124,   58,   59,   -1,   61,   -1,   63,   -1,
+   -1,   -1,   -1,  318,  319,   -1,  321,  322,   -1,   -1,
+   -1,   -1,  327,  328,   38,   -1,   -1,   41,   -1,   -1,
+   44,   -1,  263,   -1,   -1,   -1,   -1,   -1,   93,   94,
+  271,  272,  273,  274,   58,   59,   -1,   61,   -1,   63,
+   -1,   -1,   -1,   -1,  327,  328,   -1,   -1,   -1,   41,
+   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,  124,
+  301,  302,   -1,   -1,  263,   -1,   58,   59,   -1,   93,
+   94,   -1,  271,  272,  273,  274,   -1,  318,  319,   -1,
+  321,  322,   -1,   -1,   -1,   -1,  327,  328,   38,   -1,
+   -1,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,
+  124,   93,  301,  302,   -1,   -1,   -1,  263,   58,   59,
+   -1,   61,   -1,   63,   -1,  271,  272,  273,  274,  318,
+  319,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  327,  328,
+   -1,  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,
+  272,  273,  274,   93,   94,  301,  302,   -1,  271,  272,
+  273,  274,   -1,   -1,   -1,   38,   -1,   -1,   41,   -1,
+   -1,   44,  318,  319,   41,   -1,   -1,   44,   -1,  301,
+  302,  327,  328,   -1,  124,   58,   59,   -1,   61,   -1,
+   63,   58,   59,   -1,   -1,   -1,  318,  319,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  327,  328,   -1,  263,   -1,
+   -1,   -1,   -1,   -1,  327,  328,  271,  272,  273,  274,
+   93,   94,   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  302,   -1,  263,
+   -1,  124,   -1,   -1,   -1,   -1,   -1,  271,  272,  273,
+  274,   -1,   38,  318,  319,   41,   -1,   -1,   44,   -1,
+   -1,   -1,  327,  328,   38,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   58,   59,   -1,   61,   -1,   63,   -1,  271,
+  272,  273,  274,   -1,   58,   59,   -1,   61,   -1,   63,
+   -1,   -1,   -1,   -1,  318,  319,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  327,  328,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   -1,  263,   -1,   -1,   -1,   -1,   -1,   93,
+   94,  271,  272,  273,  274,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  327,  328,   38,  124,   -1,
+   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,
+  124,  301,  302,  303,  304,   -1,   -1,   58,   59,   -1,
+   61,   -1,   63,   -1,   -1,   -1,   -1,   -1,  318,  319,
+   -1,  321,  322,  323,  324,   -1,  326,   -1,   -1,   -1,
+  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,
+  273,  274,   93,   94,  271,  272,  273,  274,   -1,   -1,
+   -1,   -1,   -1,   -1,   38,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,  302,
+  303,  304,   -1,  124,   58,   59,   -1,   61,   -1,   63,
+   41,   -1,   -1,   44,   -1,  318,  319,   -1,  321,  322,
+  323,  324,   -1,  326,   -1,   -1,   -1,   58,   59,   -1,
+  327,  328,   -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,  263,   -1,   -1,
+   -1,   -1,   93,   -1,   -1,  271,  272,  273,  274,  263,
+  124,   -1,   -1,   -1,   -1,   -1,   -1,  271,  272,  273,
+  274,   38,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  301,  302,  303,  304,   -1,
+   -1,   58,   59,   -1,   61,   -1,   63,  301,  302,  303,
+  304,   -1,  318,  319,   -1,  321,  322,  323,  324,   -1,
+  326,   -1,   -1,   -1,  318,  319,   -1,  321,  322,  323,
+  324,   -1,  326,   -1,   -1,   -1,   93,   94,   38,   -1,
+   -1,   41,  263,   -1,   44,   -1,   -1,   -1,   -1,   -1,
+  271,  272,  273,  274,   -1,   -1,   -1,   -1,   58,   59,
+   -1,   61,   -1,   63,   -1,   38,   -1,  124,   41,   -1,
+   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  301,  302,  303,  304,   -1,   -1,   -1,   -1,   61,   -1,
+   63,   -1,   -1,   93,   94,   -1,   -1,  318,  319,   -1,
+  321,  322,  323,  324,   -1,  326,   -1,   38,   -1,  263,
+   41,   -1,   -1,   44,   -1,   -1,   -1,  271,  272,  273,
+  274,   94,   -1,   -1,  124,   -1,   -1,   58,   59,   -1,
+   61,   -1,   63,   38,   -1,   -1,   41,   -1,   -1,   44,
+  271,  272,  273,  274,   -1,   -1,   -1,  301,  302,  303,
+  304,  124,   -1,   58,   59,   -1,   61,   -1,   63,   -1,
+   -1,   -1,   93,   94,  318,  319,   -1,  321,  322,  323,
+  324,   -1,  326,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   38,   -1,   -1,   -1,   93,   94,
+   44,   -1,   -1,  124,   -1,   38,  327,  328,   -1,   -1,
+   -1,   44,   -1,   -1,   -1,   -1,  263,   61,   41,   63,
+   -1,   44,   -1,   -1,  271,  272,  273,  274,   61,  124,
+   63,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   94,   -1,   -1,   -1,  301,  302,  303,  304,   -1,   -1,
+   -1,   94,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   93,  318,  319,  263,  321,  322,  323,  324,   -1,  326,
+  124,  271,  272,  273,  274,   -1,   -1,   -1,   -1,   -1,
+   -1,  124,   -1,   -1,   -1,   -1,   33,   -1,   -1,   -1,
+  263,   -1,   -1,   40,   -1,   -1,   43,   -1,   45,   -1,
+   -1,  301,  302,  303,  304,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  318,  319,
+   -1,  321,  322,  323,  324,   -1,  326,   -1,  301,  302,
+  303,  304,  263,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  271,  272,  273,  274,   91,  318,  319,   -1,  321,  322,
+  323,  324,   -1,  326,   -1,   -1,   -1,   -1,  263,   -1,
+   41,   -1,   -1,   44,   -1,   -1,  271,  272,  273,  274,
+  301,  302,  303,  304,   -1,   -1,  123,   58,   59,  126,
+   -1,   -1,   -1,   41,   -1,   -1,   44,  318,  319,   -1,
+  321,  322,  323,  324,   -1,  326,  301,  302,  303,  304,
+   58,   59,   -1,   61,   -1,   63,   -1,   -1,   -1,  263,
+   -1,   -1,   93,  318,  319,   -1,  321,  322,  323,  324,
+  263,  326,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   41,   93,   94,   44,  271,  272,
+  273,  274,   -1,   -1,   -1,   -1,   -1,  301,  302,  303,
+  304,   58,   59,   -1,   61,   -1,   63,   -1,  301,  302,
+  303,  304,   -1,   -1,  318,  319,  124,  321,  322,  323,
+  324,   -1,  326,   -1,   -1,  318,  319,   -1,  321,  322,
+  323,  324,   -1,  326,   -1,   -1,   93,   94,   -1,   -1,
+   -1,   -1,   -1,   -1,  327,  328,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,   -1,   -1,  260,  261,  262,   -1,  124,   -1,  266,
+  267,  268,  269,  270,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  278,  279,   -1,  281,  282,  283,  284,  285,  286,
+  287,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,  299,  300,   -1,   -1,   -1,   -1,   -1,  306,
+   -1,  308,  309,  310,  311,  312,  313,  314,  315,  316,
+  317,   -1,   -1,  320,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  271,  272,  273,  274,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  263,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  271,  272,  273,  274,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   66,   -1,   -1,   -1,   -1,   -1,   72,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  327,  328,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  263,   -1,   -1,   -1,
+  318,  319,   -1,   -1,  271,  272,  273,  274,   -1,  327,
+  328,   -1,   -1,  107,   -1,  109,   -1,  111,   -1,  113,
+   -1,   -1,  116,   -1,  118,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  128,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  142,   -1,
+   -1,  318,  319,  147,  148,  149,  150,  151,  152,  153,
+  327,  328,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  170,  171,  172,  173,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  202,  203,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  218,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  241,   -1,  243,
+  244,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  252,   -1,
+   -1,   -1,   -1,  257,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  291,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  301,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  311,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  330,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  341,
+};
+#define YYFINAL 1
+#ifndef YYDEBUG
+#define YYDEBUG 0
+#endif
+#define YYMAXTOKEN 328
+#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,0,"WORD","LABEL","APPEND","OPEN",
+"SSELECT","LOOPEX","DOTDOT","USING","FORMAT","DO","SHIFT","PUSH","POP",
+"LVALFUN","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF","CONTINUE","SPLIT",
+"FLIST","FOR","FILOP","FILOP2","FILOP3","FILOP4","FILOP22","FILOP25","FUNC0",
+"FUNC1","FUNC2","FUNC2x","FUNC3","FUNC4","FUNC5","HSHFUN","HSHFUN3","FLIST2",
+"SUB","FILETEST","LOCAL","DELETE","RELOP","EQOP","MULOP","ADDOP","PACKAGE",
+"AMPER","FORMLIST","REG","ARYLEN","ARY","HSH","STAR","SUBST","PATTERN",
+"RSTRING","TRANS","LISTOP","OROR","ANDAND","UNIOP","LS","RS","MATCH","NMATCH",
+"UMINUS","POW","INC","DEC",
+};
+char *yyrule[] = {
+"$accept : prog",
+"$$1 :",
+"prog : $$1 lineseq",
+"compblock : block CONTINUE block",
+"compblock : block else",
+"else :",
+"else : ELSE block",
+"else : ELSIF '(' expr ')' compblock",
+"block : '{' remember lineseq '}'",
+"remember :",
+"lineseq :",
+"lineseq : lineseq line",
+"line : decl",
+"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",
+"cond : IF '(' expr ')' compblock",
+"cond : UNLESS '(' expr ')' compblock",
+"cond : IF block compblock",
+"cond : UNLESS block compblock",
+"loop : label WHILE '(' texpr ')' compblock",
+"loop : label UNTIL '(' expr ')' compblock",
+"loop : label WHILE block compblock",
+"loop : label UNTIL block compblock",
+"loop : label FOR REG '(' expr crp compblock",
+"loop : label FOR '(' expr crp compblock",
+"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block",
+"loop : label compblock",
+"nexpr :",
+"nexpr : sideff",
+"texpr :",
+"texpr : expr",
+"label :",
+"label : LABEL",
+"decl : format",
+"decl : subrout",
+"decl : package",
+"format : FORMAT WORD '=' FORMLIST",
+"format : FORMAT '=' FORMLIST",
+"subrout : SUB WORD block",
+"package : PACKAGE WORD ';'",
+"cexpr : ',' expr",
+"expr : expr ',' sexpr",
+"expr : sexpr",
+"csexpr : ',' sexpr",
+"sexpr : sexpr '=' sexpr",
+"sexpr : sexpr POW '=' sexpr",
+"sexpr : sexpr MULOP '=' sexpr",
+"sexpr : sexpr ADDOP '=' sexpr",
+"sexpr : sexpr LS '=' sexpr",
+"sexpr : sexpr RS '=' sexpr",
+"sexpr : sexpr '&' '=' sexpr",
+"sexpr : sexpr '^' '=' sexpr",
+"sexpr : sexpr '|' '=' sexpr",
+"sexpr : sexpr POW sexpr",
+"sexpr : sexpr MULOP sexpr",
+"sexpr : sexpr ADDOP sexpr",
+"sexpr : sexpr LS sexpr",
+"sexpr : sexpr RS sexpr",
+"sexpr : sexpr RELOP sexpr",
+"sexpr : sexpr EQOP sexpr",
+"sexpr : sexpr '&' sexpr",
+"sexpr : sexpr '^' sexpr",
+"sexpr : sexpr '|' sexpr",
+"sexpr : sexpr DOTDOT sexpr",
+"sexpr : sexpr ANDAND sexpr",
+"sexpr : sexpr OROR sexpr",
+"sexpr : sexpr '?' sexpr ':' sexpr",
+"sexpr : sexpr MATCH sexpr",
+"sexpr : sexpr NMATCH sexpr",
+"sexpr : term",
+"term : '-' term",
+"term : '+' term",
+"term : '!' term",
+"term : '~' term",
+"term : term INC",
+"term : term DEC",
+"term : INC term",
+"term : DEC term",
+"term : FILETEST WORD",
+"term : FILETEST sexpr",
+"term : FILETEST",
+"term : LOCAL '(' expr crp",
+"term : '(' expr crp",
+"term : '(' ')'",
+"term : DO sexpr",
+"term : DO block",
+"term : REG",
+"term : STAR",
+"term : REG '[' expr ']'",
+"term : HSH",
+"term : ARY",
+"term : REG '{' expr ';' '}'",
+"term : '(' expr crp '[' expr ']'",
+"term : '(' ')' '[' expr ']'",
+"term : ARY '[' expr ']'",
+"term : ARY '{' expr ';' '}'",
+"term : DELETE REG '{' expr ';' '}'",
+"term : DELETE '(' REG '{' expr ';' '}' ')'",
+"term : ARYLEN",
+"term : RSTRING",
+"term : PATTERN",
+"term : SUBST",
+"term : TRANS",
+"term : DO WORD '(' expr crp",
+"term : AMPER WORD '(' expr crp",
+"term : DO WORD '(' ')'",
+"term : AMPER WORD '(' ')'",
+"term : AMPER WORD",
+"term : DO REG '(' expr crp",
+"term : AMPER REG '(' expr crp",
+"term : DO REG '(' ')'",
+"term : AMPER REG '(' ')'",
+"term : AMPER REG",
+"term : LOOPEX",
+"term : LOOPEX WORD",
+"term : UNIOP",
+"term : UNIOP block",
+"term : UNIOP sexpr",
+"term : SSELECT",
+"term : SSELECT WORD",
+"term : SSELECT '(' handle ')'",
+"term : SSELECT '(' sexpr csexpr csexpr csexpr ')'",
+"term : OPEN WORD",
+"term : OPEN '(' WORD ')'",
+"term : OPEN '(' handle cexpr ')'",
+"term : FILOP '(' handle ')'",
+"term : FILOP WORD",
+"term : FILOP REG",
+"term : FILOP '(' ')'",
+"term : FILOP",
+"term : FILOP2 '(' handle cexpr ')'",
+"term : FILOP3 '(' handle csexpr cexpr ')'",
+"term : FILOP22 '(' handle ',' handle ')'",
+"term : FILOP4 '(' handle csexpr csexpr cexpr ')'",
+"term : FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'",
+"term : PUSH '(' aryword ',' expr crp",
+"term : POP aryword",
+"term : POP '(' aryword ')'",
+"term : SHIFT aryword",
+"term : SHIFT '(' aryword ')'",
+"term : SHIFT",
+"term : SPLIT",
+"term : SPLIT '(' sexpr csexpr csexpr ')'",
+"term : SPLIT '(' sexpr csexpr ')'",
+"term : SPLIT '(' sexpr ')'",
+"term : FLIST2 '(' sexpr cexpr ')'",
+"term : FLIST '(' expr crp",
+"term : LVALFUN sexpr",
+"term : LVALFUN",
+"term : FUNC0",
+"term : FUNC0 '(' ')'",
+"term : FUNC1 '(' ')'",
+"term : FUNC1 '(' expr ')'",
+"term : FUNC2 '(' sexpr cexpr ')'",
+"term : FUNC2x '(' sexpr csexpr ')'",
+"term : FUNC2x '(' sexpr csexpr cexpr ')'",
+"term : FUNC3 '(' sexpr csexpr cexpr ')'",
+"term : FUNC4 '(' sexpr csexpr csexpr cexpr ')'",
+"term : FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'",
+"term : HSHFUN '(' hshword ')'",
+"term : HSHFUN hshword",
+"term : HSHFUN3 '(' hshword csexpr cexpr ')'",
+"term : bareword",
+"term : listop",
+"listop : LISTOP",
+"listop : LISTOP expr",
+"listop : LISTOP WORD",
+"listop : LISTOP WORD expr",
+"listop : LISTOP REG expr",
+"listop : LISTOP block expr",
+"handle : WORD",
+"handle : sexpr",
+"aryword : WORD",
+"aryword : ARY",
+"hshword : WORD",
+"hshword : HSH",
+"crp : ',' ')'",
+"crp : ')'",
+"bareword : WORD",
+};
+#endif
+#ifdef YYSTACKSIZE
+#undef YYMAXDEPTH
+#define YYMAXDEPTH YYSTACKSIZE
+#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 876 "perly.y"
+ /* PROGRAM */
+#line 1820 "y.tab.c"
+#define YYABORT goto yyabort
+#define YYREJECT 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("%sdebug: state %d, reading %d (%s)\n",
+                    YYPREFIX, yystate, yychar, yys);
+        }
+#endif
+    }
+    if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("%sdebug: state %d, shifting to state %d\n",
+                    YYPREFIX, 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("%sdebug: state %d, error recovery shifting\
+ to state %d\n", YYPREFIX, *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("%sdebug: error recovery discarding state %d\n",
+                            YYPREFIX, *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("%sdebug: state %d, error recovery discards token %d (%s)\n",
+                    YYPREFIX, yystate, yychar, yys);
+        }
+#endif
+        yychar = (-1);
+        goto yyloop;
+    }
+yyreduce:
+#if YYDEBUG
+    if (yydebug)
+        printf("%sdebug: state %d, reducing by rule %d (%s)\n",
+                YYPREFIX, yystate, yyn, yyrule[yyn]);
+#endif
+    yym = yylen[yyn];
+    yyval = yyvsp[1-yym];
+    switch (yyn)
+    {
+case 1:
+#line 115 "perly.y"
+{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (debug & 1);
+#endif
+		    expectterm = 2;
+		}
+break;
+case 2:
+#line 122 "perly.y"
+{ if (in_eval)
+				eval_root = block_head(yyvsp[0].cmdval);
+			    else
+				main_root = block_head(yyvsp[0].cmdval); }
+break;
+case 3:
+#line 129 "perly.y"
+{ yyval.compval.comp_true = yyvsp[-2].cmdval; yyval.compval.comp_alt = yyvsp[0].cmdval; }
+break;
+case 4:
+#line 131 "perly.y"
+{ yyval.compval.comp_true = yyvsp[-1].cmdval; yyval.compval.comp_alt = yyvsp[0].cmdval; }
+break;
+case 5:
+#line 135 "perly.y"
+{ yyval.cmdval = Nullcmd; }
+break;
+case 6:
+#line 137 "perly.y"
+{ yyval.cmdval = yyvsp[0].cmdval; }
+break;
+case 7:
+#line 139 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    yyval.cmdval = make_ccmd(C_ELSIF,1,yyvsp[-2].arg,yyvsp[0].compval); }
+break;
+case 8:
+#line 144 "perly.y"
+{ yyval.cmdval = block_head(yyvsp[-1].cmdval);
+			  if (cmdline > (line_t)yyvsp[-3].ival)
+			      cmdline = yyvsp[-3].ival;
+			  if (savestack->ary_fill > yyvsp[-2].ival)
+			    restorelist(yyvsp[-2].ival);
+			  expectterm = 2; }
+break;
+case 9:
+#line 153 "perly.y"
+{ yyval.ival = savestack->ary_fill; }
+break;
+case 10:
+#line 157 "perly.y"
+{ yyval.cmdval = Nullcmd; }
+break;
+case 11:
+#line 159 "perly.y"
+{ yyval.cmdval = append_line(yyvsp[-1].cmdval,yyvsp[0].cmdval); }
+break;
+case 12:
+#line 163 "perly.y"
+{ yyval.cmdval = Nullcmd; }
+break;
+case 13:
+#line 165 "perly.y"
+{ yyval.cmdval = add_label(yyvsp[-1].cval,yyvsp[0].cmdval); }
+break;
+case 15:
+#line 168 "perly.y"
+{ if (yyvsp[-1].cval != Nullch) {
+			      yyval.cmdval = add_label(yyvsp[-1].cval, make_acmd(C_EXPR, Nullstab,
+				  Nullarg, Nullarg) );
+			    }
+			    else {
+			      yyval.cmdval = Nullcmd;
+			      cmdline = NOLINE;
+			    }
+			    expectterm = 2; }
+break;
+case 16:
+#line 178 "perly.y"
+{ yyval.cmdval = add_label(yyvsp[-2].cval,yyvsp[-1].cmdval);
+			  expectterm = 2; }
+break;
+case 17:
+#line 183 "perly.y"
+{ yyval.cmdval = Nullcmd; }
+break;
+case 18:
+#line 185 "perly.y"
+{ yyval.cmdval = make_acmd(C_EXPR, Nullstab, yyvsp[0].arg, Nullarg); }
+break;
+case 19:
+#line 187 "perly.y"
+{ yyval.cmdval = addcond(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, yyvsp[-2].arg), yyvsp[0].arg); }
+break;
+case 20:
+#line 190 "perly.y"
+{ yyval.cmdval = addcond(invert(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, yyvsp[-2].arg)), yyvsp[0].arg); }
+break;
+case 21:
+#line 193 "perly.y"
+{ yyval.cmdval = addloop(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, yyvsp[-2].arg), yyvsp[0].arg); }
+break;
+case 22:
+#line 196 "perly.y"
+{ yyval.cmdval = addloop(invert(
+			       make_acmd(C_EXPR, Nullstab, Nullarg, yyvsp[-2].arg)), yyvsp[0].arg); }
+break;
+case 23:
+#line 201 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    yyval.cmdval = make_icmd(C_IF,yyvsp[-2].arg,yyvsp[0].compval); }
+break;
+case 24:
+#line 204 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    yyval.cmdval = invert(make_icmd(C_IF,yyvsp[-2].arg,yyvsp[0].compval)); }
+break;
+case 25:
+#line 207 "perly.y"
+{ cmdline = yyvsp[-2].ival;
+			    yyval.cmdval = make_icmd(C_IF,cmd_to_arg(yyvsp[-1].cmdval),yyvsp[0].compval); }
+break;
+case 26:
+#line 210 "perly.y"
+{ cmdline = yyvsp[-2].ival;
+			    yyval.cmdval = invert(make_icmd(C_IF,cmd_to_arg(yyvsp[-1].cmdval),yyvsp[0].compval)); }
+break;
+case 27:
+#line 215 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    yyval.cmdval = wopt(add_label(yyvsp[-5].cval,
+			    make_ccmd(C_WHILE,1,yyvsp[-2].arg,yyvsp[0].compval) )); }
+break;
+case 28:
+#line 219 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    yyval.cmdval = wopt(add_label(yyvsp[-5].cval,
+			    invert(make_ccmd(C_WHILE,1,yyvsp[-2].arg,yyvsp[0].compval)) )); }
+break;
+case 29:
+#line 223 "perly.y"
+{ cmdline = yyvsp[-2].ival;
+			    yyval.cmdval = wopt(add_label(yyvsp[-3].cval,
+			    make_ccmd(C_WHILE, 1, cmd_to_arg(yyvsp[-1].cmdval),yyvsp[0].compval) )); }
+break;
+case 30:
+#line 227 "perly.y"
+{ cmdline = yyvsp[-2].ival;
+			    yyval.cmdval = wopt(add_label(yyvsp[-3].cval,
+			    invert(make_ccmd(C_WHILE,1,cmd_to_arg(yyvsp[-1].cmdval),yyvsp[0].compval)) )); }
+break;
+case 31:
+#line 231 "perly.y"
+{ cmdline = yyvsp[-5].ival;
+			    /*
+			     * The following gobbledygook catches EXPRs that
+			     * aren't explicit array refs and translates
+			     *		foreach VAR (EXPR) {
+			     * into
+			     *		@ary = EXPR;
+			     *		foreach VAR (@ary) {
+			     * where @ary is a hidden array made by genstab().
+			     * (Note that @ary may become a local array if
+			     * it is determined that it might be called
+			     * recursively.  See cmd_tosave().)
+			     */
+			    if (yyvsp[-2].arg->arg_type != O_ARRAY) {
+				scrstab = aadd(genstab());
+				yyval.cmdval = append_line(
+				    make_acmd(C_EXPR, Nullstab,
+				      l(make_op(O_ASSIGN,2,
+					listish(make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg )),
+					listish(make_list(yyvsp[-2].arg)),
+					Nullarg)),
+				      Nullarg),
+				    wopt(over(yyvsp[-4].stabval,add_label(yyvsp[-6].cval,
+				      make_ccmd(C_WHILE, 0,
+					make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg ),
+					yyvsp[0].compval)))));
+				yyval.cmdval->c_line = yyvsp[-5].ival;
+				yyval.cmdval->c_head->c_line = yyvsp[-5].ival;
+			    }
+			    else {
+				yyval.cmdval = wopt(over(yyvsp[-4].stabval,add_label(yyvsp[-6].cval,
+				make_ccmd(C_WHILE,1,yyvsp[-2].arg,yyvsp[0].compval) )));
+			    }
+			}
+break;
+case 32:
+#line 270 "perly.y"
+{ cmdline = yyvsp[-4].ival;
+			    if (yyvsp[-2].arg->arg_type != O_ARRAY) {
+				scrstab = aadd(genstab());
+				yyval.cmdval = append_line(
+				    make_acmd(C_EXPR, Nullstab,
+				      l(make_op(O_ASSIGN,2,
+					listish(make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg )),
+					listish(make_list(yyvsp[-2].arg)),
+					Nullarg)),
+				      Nullarg),
+				    wopt(over(defstab,add_label(yyvsp[-5].cval,
+				      make_ccmd(C_WHILE, 0,
+					make_op(O_ARRAY, 1,
+					  stab2arg(A_STAB,scrstab),
+					  Nullarg,Nullarg ),
+					yyvsp[0].compval)))));
+				yyval.cmdval->c_line = yyvsp[-4].ival;
+				yyval.cmdval->c_head->c_line = yyvsp[-4].ival;
+			    }
+			    else {	/* lisp, anyone? */
+				yyval.cmdval = wopt(over(defstab,add_label(yyvsp[-5].cval,
+				make_ccmd(C_WHILE,1,yyvsp[-2].arg,yyvsp[0].compval) )));
+			    }
+			}
+break;
+case 33:
+#line 298 "perly.y"
+{   yyval.compval.comp_true = yyvsp[0].cmdval;
+			    yyval.compval.comp_alt = yyvsp[-2].cmdval;
+			    cmdline = yyvsp[-8].ival;
+			    yyval.cmdval = append_line(yyvsp[-6].cmdval,wopt(add_label(yyvsp[-9].cval,
+				make_ccmd(C_WHILE,1,yyvsp[-4].arg,yyval.compval) ))); }
+break;
+case 34:
+#line 304 "perly.y"
+{ yyval.cmdval = add_label(yyvsp[-1].cval,make_ccmd(C_BLOCK,1,Nullarg,yyvsp[0].compval)); }
+break;
+case 35:
+#line 308 "perly.y"
+{ yyval.cmdval = Nullcmd; }
+break;
+case 37:
+#line 313 "perly.y"
+{ (void)scanstr("1",SCAN_DEF); yyval.arg = yylval.arg; }
+break;
+case 39:
+#line 318 "perly.y"
+{ yyval.cval = Nullch; }
+break;
+case 41:
+#line 323 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 42:
+#line 325 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 43:
+#line 327 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 44:
+#line 331 "perly.y"
+{ if (strEQ(yyvsp[-2].cval,"stdout"))
+			    make_form(stabent("STDOUT",TRUE),yyvsp[0].formval);
+			  else if (strEQ(yyvsp[-2].cval,"stderr"))
+			    make_form(stabent("STDERR",TRUE),yyvsp[0].formval);
+			  else
+			    make_form(stabent(yyvsp[-2].cval,TRUE),yyvsp[0].formval);
+			  Safefree(yyvsp[-2].cval); yyvsp[-2].cval = Nullch; }
+break;
+case 45:
+#line 339 "perly.y"
+{ make_form(stabent("STDOUT",TRUE),yyvsp[0].formval); }
+break;
+case 46:
+#line 343 "perly.y"
+{ make_sub(yyvsp[-1].cval,yyvsp[0].cmdval);
+			  cmdline = NOLINE;
+			  if (savestack->ary_fill > yyvsp[-2].ival)
+			    restorelist(yyvsp[-2].ival); }
+break;
+case 47:
+#line 350 "perly.y"
+{ char tmpbuf[256];
+			  STAB *tmpstab;
+
+			  savehptr(&curstash);
+			  saveitem(curstname);
+			  str_set(curstname,yyvsp[-1].cval);
+			  sprintf(tmpbuf,"'_%s",yyvsp[-1].cval);
+			  tmpstab = stabent(tmpbuf,TRUE);
+			  if (!stab_xhash(tmpstab))
+			      stab_xhash(tmpstab) = hnew(0);
+			  curstash = stab_xhash(tmpstab);
+			  if (!curstash->tbl_name)
+			      curstash->tbl_name = savestr(yyvsp[-1].cval);
+			  curstash->tbl_coeffsize = 0;
+			  Safefree(yyvsp[-1].cval); yyvsp[-1].cval = Nullch;
+			  cmdline = NOLINE;
+			  expectterm = 2;
+			}
+break;
+case 48:
+#line 371 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 49:
+#line 375 "perly.y"
+{ yyval.arg = make_op(O_COMMA, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 51:
+#line 380 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 52:
+#line 384 "perly.y"
+{   yyvsp[-2].arg = listish(yyvsp[-2].arg);
+			    if (yyvsp[-2].arg->arg_type == O_ASSIGN && yyvsp[-2].arg->arg_len == 1)
+				yyvsp[-2].arg->arg_type = O_ITEM;	/* a local() */
+			    if (yyvsp[-2].arg->arg_type == O_LIST)
+				yyvsp[0].arg = listish(yyvsp[0].arg);
+			    yyval.arg = l(make_op(O_ASSIGN, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 53:
+#line 391 "perly.y"
+{ yyval.arg = l(make_op(O_POW, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 54:
+#line 393 "perly.y"
+{ yyval.arg = l(make_op(yyvsp[-2].ival, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 55:
+#line 395 "perly.y"
+{ yyval.arg = rcatmaybe(l(make_op(yyvsp[-2].ival, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)));}
+break;
+case 56:
+#line 397 "perly.y"
+{ yyval.arg = l(make_op(O_LEFT_SHIFT, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 57:
+#line 399 "perly.y"
+{ yyval.arg = l(make_op(O_RIGHT_SHIFT, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 58:
+#line 401 "perly.y"
+{ yyval.arg = l(make_op(O_BIT_AND, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 59:
+#line 403 "perly.y"
+{ yyval.arg = l(make_op(O_XOR, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 60:
+#line 405 "perly.y"
+{ yyval.arg = l(make_op(O_BIT_OR, 2, yyvsp[-3].arg, yyvsp[0].arg, Nullarg)); }
+break;
+case 61:
+#line 409 "perly.y"
+{ yyval.arg = make_op(O_POW, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 62:
+#line 411 "perly.y"
+{ if (yyvsp[-1].ival == O_REPEAT)
+			      yyvsp[-2].arg = listish(yyvsp[-2].arg);
+			    yyval.arg = make_op(yyvsp[-1].ival, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg);
+			    if (yyvsp[-1].ival == O_REPEAT) {
+				if (yyval.arg[1].arg_type != A_EXPR ||
+				  yyval.arg[1].arg_ptr.arg_arg->arg_type != O_LIST)
+				    yyval.arg[1].arg_flags &= ~AF_ARYOK;
+			    } }
+break;
+case 63:
+#line 420 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 64:
+#line 422 "perly.y"
+{ yyval.arg = make_op(O_LEFT_SHIFT, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 65:
+#line 424 "perly.y"
+{ yyval.arg = make_op(O_RIGHT_SHIFT, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 66:
+#line 426 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 67:
+#line 428 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 68:
+#line 430 "perly.y"
+{ yyval.arg = make_op(O_BIT_AND, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 69:
+#line 432 "perly.y"
+{ yyval.arg = make_op(O_XOR, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 70:
+#line 434 "perly.y"
+{ yyval.arg = make_op(O_BIT_OR, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 71:
+#line 436 "perly.y"
+{ arg4 = Nullarg;
+			  yyval.arg = make_op(O_F_OR_R, 4, yyvsp[-2].arg, yyvsp[0].arg, Nullarg);
+			  yyval.arg[0].arg_flags |= yyvsp[-1].ival; }
+break;
+case 72:
+#line 440 "perly.y"
+{ yyval.arg = make_op(O_AND, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 73:
+#line 442 "perly.y"
+{ yyval.arg = make_op(O_OR, 2, yyvsp[-2].arg, yyvsp[0].arg, Nullarg); }
+break;
+case 74:
+#line 444 "perly.y"
+{ yyval.arg = make_op(O_COND_EXPR, 3, yyvsp[-4].arg, yyvsp[-2].arg, yyvsp[0].arg); }
+break;
+case 75:
+#line 446 "perly.y"
+{ yyval.arg = mod_match(O_MATCH, yyvsp[-2].arg, yyvsp[0].arg); }
+break;
+case 76:
+#line 448 "perly.y"
+{ yyval.arg = mod_match(O_NMATCH, yyvsp[-2].arg, yyvsp[0].arg); }
+break;
+case 77:
+#line 450 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 78:
+#line 454 "perly.y"
+{ yyval.arg = make_op(O_NEGATE, 1, yyvsp[0].arg, Nullarg, Nullarg); }
+break;
+case 79:
+#line 456 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 80:
+#line 458 "perly.y"
+{ yyval.arg = make_op(O_NOT, 1, yyvsp[0].arg, Nullarg, Nullarg); }
+break;
+case 81:
+#line 460 "perly.y"
+{ yyval.arg = make_op(O_COMPLEMENT, 1, yyvsp[0].arg, Nullarg, Nullarg);}
+break;
+case 82:
+#line 462 "perly.y"
+{ yyval.arg = addflags(1, AF_POST|AF_UP,
+			    l(make_op(O_ITEM,1,yyvsp[-1].arg,Nullarg,Nullarg))); }
+break;
+case 83:
+#line 465 "perly.y"
+{ yyval.arg = addflags(1, AF_POST,
+			    l(make_op(O_ITEM,1,yyvsp[-1].arg,Nullarg,Nullarg))); }
+break;
+case 84:
+#line 468 "perly.y"
+{ yyval.arg = addflags(1, AF_PRE|AF_UP,
+			    l(make_op(O_ITEM,1,yyvsp[0].arg,Nullarg,Nullarg))); }
+break;
+case 85:
+#line 471 "perly.y"
+{ yyval.arg = addflags(1, AF_PRE,
+			    l(make_op(O_ITEM,1,yyvsp[0].arg,Nullarg,Nullarg))); }
+break;
+case 86:
+#line 474 "perly.y"
+{ opargs[yyvsp[-1].ival] = 0;	/* force it special */
+			    yyval.arg = make_op(yyvsp[-1].ival, 1,
+				stab2arg(A_STAB,stabent(yyvsp[0].cval,TRUE)),
+				Nullarg, Nullarg);
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;
+			}
+break;
+case 87:
+#line 481 "perly.y"
+{ opargs[yyvsp[-1].ival] = 1;
+			    yyval.arg = make_op(yyvsp[-1].ival, 1, yyvsp[0].arg, Nullarg, Nullarg); }
+break;
+case 88:
+#line 484 "perly.y"
+{ opargs[yyvsp[0].ival] = (yyvsp[0].ival != O_FTTTY);
+			    yyval.arg = make_op(yyvsp[0].ival, 1,
+				stab2arg(A_STAB,
+				  yyvsp[0].ival == O_FTTTY?stabent("STDIN",TRUE):defstab),
+				Nullarg, Nullarg); }
+break;
+case 89:
+#line 490 "perly.y"
+{ yyval.arg = l(localize(make_op(O_ASSIGN, 1,
+				localize(listish(make_list(yyvsp[-1].arg))),
+				Nullarg,Nullarg))); }
+break;
+case 90:
+#line 494 "perly.y"
+{ yyval.arg = make_list(yyvsp[-1].arg); }
+break;
+case 91:
+#line 496 "perly.y"
+{ yyval.arg = make_list(Nullarg); }
+break;
+case 92:
+#line 498 "perly.y"
+{ yyval.arg = make_op(O_DOFILE,2,yyvsp[0].arg,Nullarg,Nullarg);
+			  allstabs = TRUE;}
+break;
+case 93:
+#line 501 "perly.y"
+{ yyval.arg = cmd_to_arg(yyvsp[0].cmdval); }
+break;
+case 94:
+#line 503 "perly.y"
+{ yyval.arg = stab2arg(A_STAB,yyvsp[0].stabval); }
+break;
+case 95:
+#line 505 "perly.y"
+{ yyval.arg = stab2arg(A_STAR,yyvsp[0].stabval); }
+break;
+case 96:
+#line 507 "perly.y"
+{ yyval.arg = make_op(O_AELEM, 2,
+				stab2arg(A_STAB,aadd(yyvsp[-3].stabval)), yyvsp[-1].arg, Nullarg); }
+break;
+case 97:
+#line 510 "perly.y"
+{ yyval.arg = make_op(O_HASH, 1,
+				stab2arg(A_STAB,yyvsp[0].stabval),
+				Nullarg, Nullarg); }
+break;
+case 98:
+#line 514 "perly.y"
+{ yyval.arg = make_op(O_ARRAY, 1,
+				stab2arg(A_STAB,yyvsp[0].stabval),
+				Nullarg, Nullarg); }
+break;
+case 99:
+#line 518 "perly.y"
+{ yyval.arg = make_op(O_HELEM, 2,
+				stab2arg(A_STAB,hadd(yyvsp[-4].stabval)),
+				jmaybe(yyvsp[-2].arg),
+				Nullarg);
+			    expectterm = FALSE; }
+break;
+case 100:
+#line 524 "perly.y"
+{ yyval.arg = make_op(O_LSLICE, 3,
+				Nullarg,
+				listish(make_list(yyvsp[-1].arg)),
+				listish(make_list(yyvsp[-4].arg))); }
+break;
+case 101:
+#line 529 "perly.y"
+{ yyval.arg = make_op(O_LSLICE, 3,
+				Nullarg,
+				listish(make_list(yyvsp[-1].arg)),
+				Nullarg); }
+break;
+case 102:
+#line 534 "perly.y"
+{ yyval.arg = make_op(O_ASLICE, 2,
+				stab2arg(A_STAB,aadd(yyvsp[-3].stabval)),
+				listish(make_list(yyvsp[-1].arg)),
+				Nullarg); }
+break;
+case 103:
+#line 539 "perly.y"
+{ yyval.arg = make_op(O_HSLICE, 2,
+				stab2arg(A_STAB,hadd(yyvsp[-4].stabval)),
+				listish(make_list(yyvsp[-2].arg)),
+				Nullarg);
+			    expectterm = FALSE; }
+break;
+case 104:
+#line 545 "perly.y"
+{ yyval.arg = make_op(O_DELETE, 2,
+				stab2arg(A_STAB,hadd(yyvsp[-4].stabval)),
+				jmaybe(yyvsp[-2].arg),
+				Nullarg);
+			    expectterm = FALSE; }
+break;
+case 105:
+#line 551 "perly.y"
+{ yyval.arg = make_op(O_DELETE, 2,
+				stab2arg(A_STAB,hadd(yyvsp[-5].stabval)),
+				jmaybe(yyvsp[-3].arg),
+				Nullarg);
+			    expectterm = FALSE; }
+break;
+case 106:
+#line 557 "perly.y"
+{ yyval.arg = stab2arg(A_ARYLEN,yyvsp[0].stabval); }
+break;
+case 107:
+#line 559 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 108:
+#line 561 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 109:
+#line 563 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 110:
+#line 565 "perly.y"
+{ yyval.arg = yyvsp[0].arg; }
+break;
+case 111:
+#line 567 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent(yyvsp[-3].cval,MULTI)),
+				make_list(yyvsp[-1].arg),
+				Nullarg); Safefree(yyvsp[-3].cval); yyvsp[-3].cval = Nullch;
+			    yyval.arg->arg_flags |= AF_DEPR; }
+break;
+case 112:
+#line 573 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent(yyvsp[-3].cval,MULTI)),
+				make_list(yyvsp[-1].arg),
+				Nullarg); Safefree(yyvsp[-3].cval); yyvsp[-3].cval = Nullch; }
+break;
+case 113:
+#line 578 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent(yyvsp[-2].cval,MULTI)),
+				make_list(Nullarg),
+				Nullarg);
+			    Safefree(yyvsp[-2].cval); yyvsp[-2].cval = Nullch;
+			    yyval.arg->arg_flags |= AF_DEPR; }
+break;
+case 114:
+#line 585 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent(yyvsp[-2].cval,MULTI)),
+				make_list(Nullarg),
+				Nullarg);
+			    Safefree(yyvsp[-2].cval); yyvsp[-2].cval = Nullch;
+			}
+break;
+case 115:
+#line 592 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_WORD,stabent(yyvsp[0].cval,MULTI)),
+				Nullarg,
+				Nullarg);
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;
+			}
+break;
+case 116:
+#line 599 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,yyvsp[-3].stabval),
+				make_list(yyvsp[-1].arg),
+				Nullarg);
+			    yyval.arg->arg_flags |= AF_DEPR; }
+break;
+case 117:
+#line 605 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,yyvsp[-3].stabval),
+				make_list(yyvsp[-1].arg),
+				Nullarg); }
+break;
+case 118:
+#line 610 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,yyvsp[-2].stabval),
+				make_list(Nullarg),
+				Nullarg);
+			    yyval.arg->arg_flags |= AF_DEPR; }
+break;
+case 119:
+#line 616 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,yyvsp[-2].stabval),
+				make_list(Nullarg),
+				Nullarg); }
+break;
+case 120:
+#line 621 "perly.y"
+{ yyval.arg = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
+				stab2arg(A_STAB,yyvsp[0].stabval),
+				Nullarg,
+				Nullarg); }
+break;
+case 121:
+#line 626 "perly.y"
+{ yyval.arg = make_op(yyvsp[0].ival,0,Nullarg,Nullarg,Nullarg); }
+break;
+case 122:
+#line 628 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival,1,cval_to_arg(yyvsp[0].cval),
+			    Nullarg,Nullarg); }
+break;
+case 123:
+#line 631 "perly.y"
+{ yyval.arg = make_op(yyvsp[0].ival,0,Nullarg,Nullarg,Nullarg); }
+break;
+case 124:
+#line 633 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival,1,cmd_to_arg(yyvsp[0].cmdval),Nullarg,Nullarg); }
+break;
+case 125:
+#line 635 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival,1,yyvsp[0].arg,Nullarg,Nullarg); }
+break;
+case 126:
+#line 637 "perly.y"
+{ yyval.arg = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
+break;
+case 127:
+#line 639 "perly.y"
+{ yyval.arg = make_op(O_SELECT, 1,
+			    stab2arg(A_WORD,stabent(yyvsp[0].cval,TRUE)),
+			    Nullarg,
+			    Nullarg);
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch; }
+break;
+case 128:
+#line 645 "perly.y"
+{ yyval.arg = make_op(O_SELECT, 1, yyvsp[-1].arg, Nullarg, Nullarg); }
+break;
+case 129:
+#line 647 "perly.y"
+{ arg4 = yyvsp[-1].arg;
+			  yyval.arg = make_op(O_SSELECT, 4, yyvsp[-4].arg, yyvsp[-3].arg, yyvsp[-2].arg); }
+break;
+case 130:
+#line 650 "perly.y"
+{ yyval.arg = make_op(O_OPEN, 2,
+			    stab2arg(A_WORD,stabent(yyvsp[0].cval,TRUE)),
+			    stab2arg(A_STAB,stabent(yyvsp[0].cval,TRUE)),
+			    Nullarg);
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;
+			}
+break;
+case 131:
+#line 657 "perly.y"
+{ yyval.arg = make_op(O_OPEN, 2,
+			    stab2arg(A_WORD,stabent(yyvsp[-1].cval,TRUE)),
+			    stab2arg(A_STAB,stabent(yyvsp[-1].cval,TRUE)),
+			    Nullarg);
+			    Safefree(yyvsp[-1].cval); yyvsp[-1].cval = Nullch;
+			}
+break;
+case 132:
+#line 664 "perly.y"
+{ yyval.arg = make_op(O_OPEN, 2,
+			    yyvsp[-2].arg,
+			    yyvsp[-1].arg, Nullarg); }
+break;
+case 133:
+#line 668 "perly.y"
+{ yyval.arg = make_op(yyvsp[-3].ival, 1,
+			    yyvsp[-1].arg,
+			    Nullarg, Nullarg); }
+break;
+case 134:
+#line 672 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 1,
+			    stab2arg(A_WORD,stabent(yyvsp[0].cval,TRUE)),
+			    Nullarg, Nullarg);
+			  Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch; }
+break;
+case 135:
+#line 677 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 1,
+			    stab2arg(A_STAB,yyvsp[0].stabval),
+			    Nullarg, Nullarg); }
+break;
+case 136:
+#line 681 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival, 1,
+			    stab2arg(A_WORD,Nullstab),
+			    Nullarg, Nullarg); }
+break;
+case 137:
+#line 685 "perly.y"
+{ yyval.arg = make_op(yyvsp[0].ival, 0,
+			    Nullarg, Nullarg, Nullarg); }
+break;
+case 138:
+#line 688 "perly.y"
+{ yyval.arg = make_op(yyvsp[-4].ival, 2, yyvsp[-2].arg, yyvsp[-1].arg, Nullarg); }
+break;
+case 139:
+#line 690 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 3, yyvsp[-3].arg, yyvsp[-2].arg, make_list(yyvsp[-1].arg)); }
+break;
+case 140:
+#line 692 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 2, yyvsp[-3].arg, yyvsp[-1].arg, Nullarg); }
+break;
+case 141:
+#line 694 "perly.y"
+{ arg4 = yyvsp[-1].arg; yyval.arg = make_op(yyvsp[-6].ival, 4, yyvsp[-4].arg, yyvsp[-3].arg, yyvsp[-2].arg); }
+break;
+case 142:
+#line 696 "perly.y"
+{ arg4 = yyvsp[-2].arg; arg5 = yyvsp[-1].arg;
+			  yyval.arg = make_op(yyvsp[-8].ival, 5, yyvsp[-6].arg, yyvsp[-4].arg, yyvsp[-3].arg); }
+break;
+case 143:
+#line 699 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 2,
+			    yyvsp[-3].arg,
+			    make_list(yyvsp[-1].arg),
+			    Nullarg); }
+break;
+case 144:
+#line 704 "perly.y"
+{ yyval.arg = make_op(O_POP, 1, yyvsp[0].arg, Nullarg, Nullarg); }
+break;
+case 145:
+#line 706 "perly.y"
+{ yyval.arg = make_op(O_POP, 1, yyvsp[-1].arg, Nullarg, Nullarg); }
+break;
+case 146:
+#line 708 "perly.y"
+{ yyval.arg = make_op(O_SHIFT, 1, yyvsp[0].arg, Nullarg, Nullarg); }
+break;
+case 147:
+#line 710 "perly.y"
+{ yyval.arg = make_op(O_SHIFT, 1, yyvsp[-1].arg, Nullarg, Nullarg); }
+break;
+case 148:
+#line 712 "perly.y"
+{ yyval.arg = make_op(O_SHIFT, 1,
+			    stab2arg(A_STAB,
+			      aadd(stabent(subline ? "_" : "ARGV", TRUE))),
+			    Nullarg, Nullarg); }
+break;
+case 149:
+#line 717 "perly.y"
+{   static char p[]="/\\s+/";
+			    char *oldend = bufend;
+			    ARG *oldarg = yylval.arg;
+			    
+			    bufend=p+5;
+			    (void)scanpat(p);
+			    bufend=oldend;
+			    yyval.arg = make_split(defstab,yylval.arg,Nullarg);
+			    yylval.arg = oldarg; }
+break;
+case 150:
+#line 727 "perly.y"
+{ yyval.arg = mod_match(O_MATCH, yyvsp[-2].arg,
+			  make_split(defstab,yyvsp[-3].arg,yyvsp[-1].arg));}
+break;
+case 151:
+#line 730 "perly.y"
+{ yyval.arg = mod_match(O_MATCH, yyvsp[-1].arg,
+			  make_split(defstab,yyvsp[-2].arg,Nullarg) ); }
+break;
+case 152:
+#line 733 "perly.y"
+{ yyval.arg = mod_match(O_MATCH,
+			    stab2arg(A_STAB,defstab),
+			    make_split(defstab,yyvsp[-1].arg,Nullarg) ); }
+break;
+case 153:
+#line 737 "perly.y"
+{ yyval.arg = make_op(yyvsp[-4].ival, 2,
+			    yyvsp[-2].arg,
+			    listish(make_list(yyvsp[-1].arg)),
+			    Nullarg); }
+break;
+case 154:
+#line 742 "perly.y"
+{ yyval.arg = make_op(yyvsp[-3].ival, 1,
+			    make_list(yyvsp[-1].arg),
+			    Nullarg,
+			    Nullarg); }
+break;
+case 155:
+#line 747 "perly.y"
+{ yyval.arg = l(make_op(yyvsp[-1].ival, 1, fixl(yyvsp[-1].ival,yyvsp[0].arg),
+			    Nullarg, Nullarg)); }
+break;
+case 156:
+#line 750 "perly.y"
+{ yyval.arg = l(make_op(yyvsp[0].ival, 1,
+			    stab2arg(A_STAB,defstab),
+			    Nullarg, Nullarg)); }
+break;
+case 157:
+#line 754 "perly.y"
+{ yyval.arg = make_op(yyvsp[0].ival, 0, Nullarg, Nullarg, Nullarg); }
+break;
+case 158:
+#line 756 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival, 0, Nullarg, Nullarg, Nullarg); }
+break;
+case 159:
+#line 758 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival, 0, Nullarg, Nullarg, Nullarg); }
+break;
+case 160:
+#line 760 "perly.y"
+{ yyval.arg = make_op(yyvsp[-3].ival, 1, yyvsp[-1].arg, Nullarg, Nullarg); }
+break;
+case 161:
+#line 762 "perly.y"
+{ yyval.arg = make_op(yyvsp[-4].ival, 2, yyvsp[-2].arg, yyvsp[-1].arg, Nullarg);
+			    if (yyvsp[-4].ival == O_INDEX && yyval.arg[2].arg_type == A_SINGLE)
+				fbmcompile(yyval.arg[2].arg_ptr.arg_str,0); }
+break;
+case 162:
+#line 766 "perly.y"
+{ yyval.arg = make_op(yyvsp[-4].ival, 2, yyvsp[-2].arg, yyvsp[-1].arg, Nullarg);
+			    if (yyvsp[-4].ival == O_INDEX && yyval.arg[2].arg_type == A_SINGLE)
+				fbmcompile(yyval.arg[2].arg_ptr.arg_str,0); }
+break;
+case 163:
+#line 770 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 3, yyvsp[-3].arg, yyvsp[-2].arg, yyvsp[-1].arg);
+			    if (yyvsp[-5].ival == O_INDEX && yyval.arg[2].arg_type == A_SINGLE)
+				fbmcompile(yyval.arg[2].arg_ptr.arg_str,0); }
+break;
+case 164:
+#line 774 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 3, yyvsp[-3].arg, yyvsp[-2].arg, yyvsp[-1].arg); }
+break;
+case 165:
+#line 776 "perly.y"
+{ arg4 = yyvsp[-1].arg;
+			  yyval.arg = make_op(yyvsp[-6].ival, 4, yyvsp[-4].arg, yyvsp[-3].arg, yyvsp[-2].arg); }
+break;
+case 166:
+#line 779 "perly.y"
+{ arg4 = yyvsp[-2].arg; arg5 = yyvsp[-1].arg;
+			  yyval.arg = make_op(yyvsp[-7].ival, 5, yyvsp[-5].arg, yyvsp[-4].arg, yyvsp[-3].arg); }
+break;
+case 167:
+#line 782 "perly.y"
+{ yyval.arg = make_op(yyvsp[-3].ival, 1,
+				yyvsp[-1].arg,
+				Nullarg,
+				Nullarg); }
+break;
+case 168:
+#line 787 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival, 1,
+				yyvsp[0].arg,
+				Nullarg,
+				Nullarg); }
+break;
+case 169:
+#line 792 "perly.y"
+{ yyval.arg = make_op(yyvsp[-5].ival, 3, yyvsp[-3].arg, yyvsp[-2].arg, yyvsp[-1].arg); }
+break;
+case 172:
+#line 798 "perly.y"
+{ yyval.arg = make_op(yyvsp[0].ival,2,
+				stab2arg(A_WORD,Nullstab),
+				stab2arg(A_STAB,defstab),
+				Nullarg); }
+break;
+case 173:
+#line 803 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival,2,
+				stab2arg(A_WORD,Nullstab),
+				maybelistish(yyvsp[-1].ival,make_list(yyvsp[0].arg)),
+				Nullarg); }
+break;
+case 174:
+#line 808 "perly.y"
+{ yyval.arg = make_op(yyvsp[-1].ival,2,
+				stab2arg(A_WORD,stabent(yyvsp[0].cval,TRUE)),
+				stab2arg(A_STAB,defstab),
+				Nullarg);
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;
+			}
+break;
+case 175:
+#line 815 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival,2,
+				stab2arg(A_WORD,stabent(yyvsp[-1].cval,TRUE)),
+				maybelistish(yyvsp[-2].ival,make_list(yyvsp[0].arg)),
+				Nullarg); Safefree(yyvsp[-1].cval); yyvsp[-1].cval = Nullch; }
+break;
+case 176:
+#line 820 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival,2,
+				stab2arg(A_STAB,yyvsp[-1].stabval),
+				maybelistish(yyvsp[-2].ival,make_list(yyvsp[0].arg)),
+				Nullarg); }
+break;
+case 177:
+#line 825 "perly.y"
+{ yyval.arg = make_op(yyvsp[-2].ival,2,
+				cmd_to_arg(yyvsp[-1].cmdval),
+				maybelistish(yyvsp[-2].ival,make_list(yyvsp[0].arg)),
+				Nullarg); }
+break;
+case 178:
+#line 832 "perly.y"
+{ yyval.arg = stab2arg(A_WORD,stabent(yyvsp[0].cval,TRUE));
+			  Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;}
+break;
+case 180:
+#line 838 "perly.y"
+{ yyval.arg = stab2arg(A_WORD,aadd(stabent(yyvsp[0].cval,TRUE)));
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch; }
+break;
+case 181:
+#line 841 "perly.y"
+{ yyval.arg = stab2arg(A_STAB,yyvsp[0].stabval); }
+break;
+case 182:
+#line 845 "perly.y"
+{ yyval.arg = stab2arg(A_WORD,hadd(stabent(yyvsp[0].cval,TRUE)));
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch; }
+break;
+case 183:
+#line 848 "perly.y"
+{ yyval.arg = stab2arg(A_STAB,yyvsp[0].stabval); }
+break;
+case 184:
+#line 852 "perly.y"
+{ yyval.ival = 1; }
+break;
+case 185:
+#line 854 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 186:
+#line 863 "perly.y"
+{ char *s;
+			    yyval.arg = op_new(1);
+			    yyval.arg->arg_type = O_ITEM;
+			    yyval.arg[1].arg_type = A_SINGLE;
+			    yyval.arg[1].arg_ptr.arg_str = str_make(yyvsp[0].cval,0);
+			    for (s = yyvsp[0].cval; *s && isLOWER(*s); s++) ;
+			    if (dowarn && !*s)
+				warn(
+				  "\"%s\" may clash with future reserved word",
+				  yyvsp[0].cval );
+			    Safefree(yyvsp[0].cval); yyvsp[0].cval = Nullch;
+			}
+break;
+#line 3008 "y.tab.c"
+    }
+    yyssp -= yym;
+    yystate = *yyssp;
+    yyvsp -= yym;
+    yym = yylhs[yyn];
+    if (yystate == 0 && yym == 0)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("%sdebug: after reduction, shifting from state 0 to\
+ state %d\n", YYPREFIX, 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("%sdebug: state %d, reading %d (%s)\n",
+                        YYPREFIX, 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("%sdebug: after reduction, shifting from state %d \
+to state %d\n", YYPREFIX, *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/perl/perly.h b/gnu/usr.bin/perl/perl/perly.h
new file mode 100644
index 000000000000..c6f13d1b59eb
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/perly.h
@@ -0,0 +1,83 @@
+#define WORD 257
+#define LABEL 258
+#define APPEND 259
+#define OPEN 260
+#define SSELECT 261
+#define LOOPEX 262
+#define DOTDOT 263
+#define USING 264
+#define FORMAT 265
+#define DO 266
+#define SHIFT 267
+#define PUSH 268
+#define POP 269
+#define LVALFUN 270
+#define WHILE 271
+#define UNTIL 272
+#define IF 273
+#define UNLESS 274
+#define ELSE 275
+#define ELSIF 276
+#define CONTINUE 277
+#define SPLIT 278
+#define FLIST 279
+#define FOR 280
+#define FILOP 281
+#define FILOP2 282
+#define FILOP3 283
+#define FILOP4 284
+#define FILOP22 285
+#define FILOP25 286
+#define FUNC0 287
+#define FUNC1 288
+#define FUNC2 289
+#define FUNC2x 290
+#define FUNC3 291
+#define FUNC4 292
+#define FUNC5 293
+#define HSHFUN 294
+#define HSHFUN3 295
+#define FLIST2 296
+#define SUB 297
+#define FILETEST 298
+#define LOCAL 299
+#define DELETE 300
+#define RELOP 301
+#define EQOP 302
+#define MULOP 303
+#define ADDOP 304
+#define PACKAGE 305
+#define AMPER 306
+#define FORMLIST 307
+#define REG 308
+#define ARYLEN 309
+#define ARY 310
+#define HSH 311
+#define STAR 312
+#define SUBST 313
+#define PATTERN 314
+#define RSTRING 315
+#define TRANS 316
+#define LISTOP 317
+#define OROR 318
+#define ANDAND 319
+#define UNIOP 320
+#define LS 321
+#define RS 322
+#define MATCH 323
+#define NMATCH 324
+#define UMINUS 325
+#define POW 326
+#define INC 327
+#define DEC 328
+typedef union {
+    int	ival;
+    char *cval;
+    ARG *arg;
+    CMD *cmdval;
+    struct compcmd compval;
+    STAB *stabval;
+    FCMD *formval;
+} YYSTYPE;
+extern YYSTYPE yylval;
+extern YYSTYPE yylval;
diff --git a/gnu/usr.bin/perl/perl/regcomp.c b/gnu/usr.bin/perl/perl/regcomp.c
new file mode 100644
index 000000000000..8337e9cfd0d5
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/regcomp.c
@@ -0,0 +1,1478 @@
+/* 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.
+ */
+
+/* $RCSfile: regcomp.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ * $Log: regcomp.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.5  92/06/08  15:23:36  lwall
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: /^stuff/ wrongly assumed an implicit $* == 1
+ * patch20: /x{0}/ was wrongly interpreted as /x{0,}/
+ * patch20: added \W, \S and \D inside /[...]/
+ * 
+ * Revision 4.0.1.4  91/11/05  22:55:14  lwall
+ * patch11: Erratum
+ * 
+ * Revision 4.0.1.3  91/11/05  18:22:28  lwall
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: initial .* in pattern had dependency on value of $*
+ * patch11: certain patterns made use of garbage pointers from uncleared memory
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.2  91/06/07  11:48:24  lwall
+ * patch4: new copyright notice
+ * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx"
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * 
+ * Revision 4.0.1.1  91/04/12  09:04:45  lwall
+ * patch1: random cleanup in cpp namespace
+ * 
+ * Revision 4.0  91/03/20  01:39:01  lwall
+ * 4.0 baseline.
+ * 
+ */
+/*SUPPRESS 112*/
+/*
+ * regcomp and regexec -- 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, 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	HASWIDTH	01	/* Known never to match null string. */
+#define	SIMPLE		02	/* Simple enough to be STAR/PLUS operand. */
+#define	SPSTART		04	/* Starts with * or +. */
+#define	WORST		0	/* Worst case. */
+
+/*
+ * Global work variables for regcomp().
+ */
+static char *regprecomp;		/* uncompiled string. */
+static char *regparse;		/* Input-scan pointer. */
+static char *regxend;		/* End of input for compile */
+static int regnpar;		/* () count. */
+static char *regcode;		/* Code-emit pointer; &regdummy = don't. */
+static long regsize;		/* Code size. */
+static int regfold;
+static int regsawbracket;	/* Did we do {d,d} trick? */
+static int regsawback;		/* Did we see \1, ...? */
+
+/*
+ * Forward declarations for regcomp()'s friends.
+ */
+STATIC int regcurly();
+STATIC char *reg();
+STATIC char *regbranch();
+STATIC char *regpiece();
+STATIC char *regatom();
+STATIC char *regclass();
+STATIC char *regnode();
+STATIC char *reganode();
+STATIC void regc();
+STATIC void reginsert();
+STATIC void regtail();
+STATIC void regoptail();
+
+/*
+ - regcomp - 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 *
+regcomp(exp,xend,fold)
+char *exp;
+char *xend;
+int fold;
+{
+	register regexp *r;
+	register char *scan;
+	register STR *longish;
+	STR *longest;
+	register int len;
+	register char *first;
+	int flags;
+	int backish;
+	int backest;
+	int curback;
+	int minlen;
+	int sawplus = 0;
+	int sawopen = 0;
+
+	if (exp == NULL)
+		fatal("NULL regexp argument");
+
+	/* First pass: determine size, legality. */
+	regfold = fold;
+	regparse = exp;
+	regxend = xend;
+	regprecomp = nsavestr(exp,xend-exp);
+	regsawbracket = 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. */
+	if (regsawbracket)
+	    Copy(regprecomp,exp,xend-exp,char);
+	r->prelen = xend-exp;
+	r->precomp = regprecomp;
+	r->subbeg = r->subbase = NULL;
+	regparse = exp;
+	regnpar = 1;
+	regcode = r->program;
+	regc((char)MAGIC);
+	if (reg(0, &flags) == NULL)
+		return(NULL);
+
+	/* Dig out information for optimizations. */
+	r->regstart = Nullstr;	/* Worst-case defaults. */
+	r->reganch = 0;
+	r->regmust = Nullstr;
+	r->regback = -1;
+	r->regstclass = Nullch;
+	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) == CURLY && ARG1(first) > 0) ) {
+			if (OP(first) == PLUS)
+			    sawplus = 1;
+			else
+			    first += regarglen[OP(first)];
+			first = NEXTOPER(first);
+		}
+
+		/* Starting-point info. */
+	    again:
+		if (OP(first) == EXACTLY) {
+			r->regstart =
+			    str_make(OPERAND(first)+1,*OPERAND(first));
+			if (r->regstart->str_cur > !(sawstudy|fold))
+				fbmcompile(r->regstart,fold);
+		}
+		else if ((exp = index(simple,OP(first))) && exp > simple)
+			r->regstclass = first;
+		else if (OP(first) == BOUND || OP(first) == NBOUND)
+			r->regstclass = first;
+		else if (OP(first) == BOL) {
+			r->reganch = ROPT_ANCH;
+			first = NEXTOPER(first);
+		    	goto again;
+		}
+		else if ((OP(first) == STAR && 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 */
+
+#ifdef DEBUGGING
+		if (debug & 512)
+		    fprintf(stderr,"first %d next %d offset %d\n",
+		      OP(first), OP(NEXTOPER(first)), first - scan);
+#endif
+		/*
+		 * 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 = str_make("",0);
+		longest = str_make("",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);
+			}
+			if (OP(scan) == EXACTLY) {
+			    char *t;
+
+			    first = scan;
+			    while (OP(t = regnext(scan)) == CLOSE)
+				scan = t;
+			    minlen += *OPERAND(first);
+			    if (curback - backish == len) {
+				str_ncat(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);
+				str_nset(longish, OPERAND(first)+1,len);
+				backish = curback;
+				curback += len;
+				first = regnext(scan);
+			    }
+			    else
+				curback += *OPERAND(first);
+			}
+			else if (index(varies,OP(scan))) {
+			    curback = -30000;
+			    len = 0;
+			    if (longish->str_cur > longest->str_cur) {
+				str_sset(longest,longish);
+				backest = backish;
+			    }
+			    str_nset(longish,"",0);
+			    if (OP(scan) == PLUS &&
+			      index(simple,OP(NEXTOPER(scan))))
+				minlen++;
+			    else if (OP(scan) == CURLY &&
+			      index(simple,OP(NEXTOPER(scan)+4)))
+				minlen += ARG1(scan);
+			}
+			else if (index(simple,OP(scan))) {
+			    curback++;
+			    minlen++;
+			    len = 0;
+			    if (longish->str_cur > longest->str_cur) {
+				str_sset(longest,longish);
+				backest = backish;
+			    }
+			    str_nset(longish,"",0);
+			}
+			scan = regnext(scan);
+		}
+
+		/* Prefer earlier on tie, unless we can tail match latter */
+
+		if (longish->str_cur + (OP(first) == EOL) > longest->str_cur) {
+		    str_sset(longest,longish);
+		    backest = backish;
+		}
+		else
+		    str_nset(longish,"",0);
+		if (longest->str_cur
+		    &&
+		    (!r->regstart
+		     ||
+		     !fbminstr((unsigned char*) r->regstart->str_ptr,
+			  (unsigned char *) r->regstart->str_ptr
+			    + r->regstart->str_cur,
+			  longest)
+		    )
+		   )
+		{
+			r->regmust = longest;
+			if (backest < 0)
+				backest = -1;
+			r->regback = backest;
+			if (longest->str_cur
+			  > !(sawstudy || fold || OP(first) == EOL) )
+				fbmcompile(r->regmust,fold);
+			r->regmust->str_u.str_useful = 100;
+			if (OP(first) == EOL && longish->str_cur)
+			    r->regmust->str_pok |= SP_TAIL;
+		}
+		else {
+			str_free(longest);
+			longest = Nullstr;
+		}
+		str_free(longish);
+	}
+
+	r->do_folding = fold;
+	r->nparens = regnpar - 1;
+	r->minlen = minlen;
+	Newz(1002, r->startp, regnpar, char*);
+	Newz(1002, r->endp, regnpar, char*);
+#ifdef DEBUGGING
+	if (debug & 512)
+		regdump(r);
+#endif
+	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)
+int paren;			/* Parenthesized? */
+int *flagp;
+{
+	register char *ret;
+	register char *br;
+	register char *ender;
+	register int parno;
+	int flags;
+
+	*flagp = HASWIDTH;	/* Tentatively. */
+
+	/* Make an OPEN node, if parenthesized. */
+	if (paren) {
+		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 == '|') {
+		regparse++;
+		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. */
+	if (paren)
+	    ender = reganode(CLOSE, parno);
+	else
+	    ender = regnode(END);
+	regtail(ret, ender);
+
+	/* Hook the tails of the branches to the closing node. */
+	for (br = ret; br != NULL; br = regnext(br))
+		regoptail(br, ender);
+
+	/* Check for proper termination. */
+	if (paren && *regparse++ != ')') {
+		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)
+int *flagp;
+{
+	register char *ret;
+	register char *chain;
+	register char *latest;
+	int flags;
+
+	*flagp = WORST;		/* Tentatively. */
+
+	ret = regnode(BRANCH);
+	chain = NULL;
+	while (regparse < regxend && *regparse != '|' && *regparse != ')') {
+		latest = regpiece(&flags);
+		if (latest == NULL)
+			return(NULL);
+		*flagp |= flags&HASWIDTH;
+		if (chain == NULL)	/* First piece. */
+			*flagp |= flags&SPSTART;
+		else
+			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)
+int *flagp;
+{
+	register char *ret;
+	register char op;
+	register char *next;
+	int flags;
+	char *origparse = regparse;
+	int orignpar = regnpar;
+	char *max;
+	int iter;
+	char ch;
+
+	ret = regatom(&flags);
+	if (ret == NULL)
+		return(NULL);
+
+	op = *regparse;
+
+	/* Here's a total kludge: if after the atom there's a {\d+,?\d*}
+	 * then we decrement the first number by one and reset our
+	 * parsing back to the beginning of the same atom.  If the first number
+	 * is down to 0, decrement the second number instead and fake up
+	 * a ? after it.  Given the way this compiler doesn't keep track
+	 * of offsets on the first pass, this is the only way to replicate
+	 * a piece of code.  Sigh.
+	 */
+	if (op == '{' && regcurly(regparse)) {
+	    next = regparse + 1;
+	    max = Nullch;
+	    while (isDIGIT(*next) || *next == ',') {
+		if (*next == ',') {
+		    if (max)
+			break;
+		    else
+			max = next;
+		}
+		next++;
+	    }
+	    if (*next == '}') {		/* got one */
+		if (!max)
+		    max = next;
+		regparse++;
+		iter = atoi(regparse);
+		if (flags&SIMPLE) {	/* we can do it right after all */
+		    int tmp;
+
+		    reginsert(CURLY, ret);
+		    if (iter > 0)
+			*flagp = (WORST|HASWIDTH);
+		    if (*max == ',')
+			max++;
+		    else
+			max = regparse;
+		    tmp = atoi(max);
+		    if (!tmp && *max != '0')
+			tmp = 32767;		/* meaning "infinity" */
+		    if (tmp && tmp < iter)
+			fatal("Can't do {n,m} with n > m");
+		    if (regcode != &regdummy) {
+#ifdef REGALIGN
+			*(unsigned short *)(ret+3) = iter;
+			*(unsigned short *)(ret+5) = tmp;
+#else
+			ret[3] = iter >> 8; ret[4] = iter & 0377;
+			ret[5] = tmp  >> 8; ret[6] = tmp  & 0377;
+#endif
+		    }
+		    regparse = next;
+		    goto nest_check;
+		}
+		regsawbracket++;	/* remember we clobbered exp */
+		if (iter > 0) {
+		    ch = *max;
+		    sprintf(regparse,"%.*d", max-regparse, iter - 1);
+		    *max = ch;
+		    if (*max == ',' && max[1] != '}') {
+			if (atoi(max+1) <= 0)
+			    fatal("Can't do {n,m} with n > m");
+			ch = *next;
+			sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1);
+			*next = ch;
+		    }
+		    if (iter != 1 || *max == ',') {
+			regparse = origparse;	/* back up input pointer */
+			regnpar = orignpar;	/* don't make more parens */
+		    }
+		    else {
+			regparse = next;
+			goto nest_check;
+		    }
+		    *flagp = flags;
+		    return ret;
+		}
+		if (*max == ',') {
+		    max++;
+		    iter = atoi(max);
+		    if (max == next) {		/* any number more? */
+			regparse = next;
+			op = '*';		/* fake up one with a star */
+		    }
+		    else if (iter > 0) {
+			op = '?';		/* fake up optional atom */
+			ch = *next;
+			sprintf(max,"%.*d", next-max, iter - 1);
+			*next = ch;
+			if (iter == 1)
+			    regparse = next;
+			else {
+			    regparse = origparse - 1; /* offset ++ below */
+			    regnpar = orignpar;
+			}
+		    }
+		    else
+			fatal("Can't do {n,0}");
+		}
+		else
+		    fatal("Can't do {0}");
+	    }
+	}
+
+	if (!ISMULT1(op)) {
+		*flagp = flags;
+		return(ret);
+	}
+
+	if (!(flags&HASWIDTH) && op != '?')
+		FAIL("regexp *+ operand could be empty");
+	*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
+
+	if (op == '*' && (flags&SIMPLE))
+		reginsert(STAR, ret);
+	else if (op == '*') {
+		/* Emit x* as (x&|), where & means "self". */
+		reginsert(BRANCH, ret);			/* Either x */
+		regoptail(ret, regnode(BACK));		/* and loop */
+		regoptail(ret, ret);			/* back */
+		regtail(ret, regnode(BRANCH));		/* or */
+		regtail(ret, regnode(NOTHING));		/* null. */
+	} else if (op == '+' && (flags&SIMPLE))
+		reginsert(PLUS, ret);
+	else if (op == '+') {
+		/* Emit x+ as x(&|), where & means "self". */
+		next = regnode(BRANCH);			/* Either */
+		regtail(ret, next);
+		regtail(regnode(BACK), ret);		/* loop back */
+		regtail(next, regnode(BRANCH));		/* or */
+		regtail(ret, regnode(NOTHING));		/* null. */
+	} else if (op == '?') {
+		/* Emit x? as (x|) */
+		reginsert(BRANCH, ret);			/* Either x */
+		regtail(ret, regnode(BRANCH));		/* or */
+		next = regnode(NOTHING);		/* null. */
+		regtail(ret, next);
+		regoptail(ret, next);
+	}
+      nest_check:
+	regparse++;
+	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)
+int *flagp;
+{
+	register char *ret;
+	int flags;
+
+	*flagp = WORST;		/* Tentatively. */
+
+	switch (*regparse++) {
+	case '^':
+		ret = regnode(BOL);
+		break;
+	case '$':
+		ret = regnode(EOL);
+		break;
+	case '.':
+		ret = regnode(ANY);
+		*flagp |= HASWIDTH|SIMPLE;
+		break;
+	case '[':
+		ret = regclass();
+		*flagp |= HASWIDTH|SIMPLE;
+		break;
+	case '(':
+		ret = reg(1, &flags);
+		if (ret == NULL)
+			return(NULL);
+		*flagp |= flags&(HASWIDTH|SPSTART);
+		break;
+	case '|':
+	case ')':
+		FAIL("internal urp in regexp");	/* Supposed to be caught earlier. */
+		break;
+	case '?':
+	case '+':
+	case '*':
+		FAIL("?+* follows nothing in regexp");
+		break;
+	case '\\':
+		switch (*regparse) {
+		case 'w':
+			ret = regnode(ALNUM);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			break;
+		case 'W':
+			ret = regnode(NALNUM);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			break;
+		case 'b':
+			ret = regnode(BOUND);
+			*flagp |= SIMPLE;
+			regparse++;
+			break;
+		case 'B':
+			ret = regnode(NBOUND);
+			*flagp |= SIMPLE;
+			regparse++;
+			break;
+		case 's':
+			ret = regnode(SPACE);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			break;
+		case 'S':
+			ret = regnode(NSPACE);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			break;
+		case 'd':
+			ret = regnode(DIGIT);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			break;
+		case 'D':
+			ret = regnode(NDIGIT);
+			*flagp |= HASWIDTH|SIMPLE;
+			regparse++;
+			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':
+			{
+			    int num = atoi(regparse);
+
+			    if (num > 9 && num >= regnpar)
+				goto defchar;
+			    else {
+				regsawback = 1;
+				ret = reganode(REF, num);
+				while (isDIGIT(*regparse))
+				    regparse++;
+				*flagp |= SIMPLE;
+			    }
+			}
+			break;
+		case '\0':
+			if (regparse >= regxend)
+			    FAIL("trailing \\ in regexp");
+			/* FALL THROUGH */
+		default:
+			goto defchar;
+		}
+		break;
+	default: {
+			register int len;
+			register char ender;
+			register char *p;
+			char *oldp;
+			int numlen;
+
+		    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 '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 = scanhex(++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 = scanoct(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;
+			    default:
+				ender = *p++;
+				break;
+			    }
+			    if (regfold && 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;
+			if (len <= 0)
+				FAIL("internal disaster in regexp");
+			*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;
+int def;
+register int 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 int class;
+	register int lastclass;
+	register int range = 0;
+	register char *ret;
+	register int def;
+	int numlen;
+
+	ret = regnode(ANYOF);
+	if (*regparse == '^') {	/* Complement of range. */
+		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 = scanhex(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 = scanoct(--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 (regfold && isUPPER(lastclass))
+				regset(bits,def,tolower(lastclass));
+		}
+		lastclass = class;
+	}
+	if (*regparse != ']')
+		FAIL("unmatched [] in regexp");
+	regparse++;
+	return ret;
+}
+
+/*
+ - regnode - emit a node
+ */
+static char *			/* Location. */
+regnode(op)
+char op;
+{
+	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
+ */
+static char *			/* Location. */
+reganode(op, arg)
+char op;
+unsigned short arg;
+{
+	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
+ */
+static void
+regc(b)
+char b;
+{
+	if (regcode != &regdummy)
+		*regcode++ = b;
+	else
+		regsize++;
+}
+
+/*
+ - reginsert - insert an operator in front of already-emitted operand
+ *
+ * Means relocating the operand.
+ */
+static void
+reginsert(op, opnd)
+char op;
+char *opnd;
+{
+	register char *src;
+	register char *dst;
+	register char *place;
+	register offset = (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 int 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 || OP(p) != BRANCH)
+		return;
+	regtail(NEXTOPER(p), val);
+}
+
+/*
+ - regcurly - a little FSA that accepts {\d+,?\d*}
+ */
+STATIC int
+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[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++;
+			while (*s != '\0') {
+				(void)putchar(*s);
+				s++;
+			}
+			s++;
+		}
+		(void)putchar('\n');
+	}
+
+	/* Header fields of interest. */
+	if (r->regstart)
+		fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
+	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 %d ", r->regmust->str_ptr,
+		  r->regback);
+	fprintf(stderr, "minlen %d ", r->minlen);
+	fprintf(stderr,"\n");
+}
+
+/*
+ - regprop - printable representation of opcode
+ */
+char *
+regprop(op)
+char *op;
+{
+	register char *p;
+
+	(void) strcpy(buf, ":");
+
+	switch (OP(op)) {
+	case BOL:
+		p = "BOL";
+		break;
+	case EOL:
+		p = "EOL";
+		break;
+	case ANY:
+		p = "ANY";
+		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 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;
+	default:
+		FAIL("corrupted regexp opcode");
+	}
+	if (p != NULL)
+		(void) strcat(buf, p);
+	return(buf);
+}
+#endif /* DEBUGGING */
+
+void
+regfree(r)
+struct regexp *r;
+{
+	if (r->precomp) {
+		Safefree(r->precomp);
+		r->precomp = Nullch;
+	}
+	if (r->subbase) {
+		Safefree(r->subbase);
+		r->subbase = Nullch;
+	}
+	if (r->regmust) {
+		str_free(r->regmust);
+		r->regmust = Nullstr;
+	}
+	if (r->regstart) {
+		str_free(r->regstart);
+		r->regstart = Nullstr;
+	}
+	Safefree(r->startp);
+	Safefree(r->endp);
+	Safefree(r);
+}
diff --git a/gnu/usr.bin/perl/perl/regcomp.h b/gnu/usr.bin/perl/perl/regcomp.h
new file mode 100644
index 000000000000..6dcd482fcd5f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/regcomp.h
@@ -0,0 +1,200 @@
+/* $RCSfile: regcomp.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ * $Log: regcomp.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  11:49:40  lwall
+ * patch4: no change
+ * 
+ * Revision 4.0  91/03/20  01:39:09  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+/*
+ * 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	str 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 STR* 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 regcomp() 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 regexec() needs it and regcomp() 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	EOL	2	/* no	Match "" at end of line. */
+#define	ANY	3	/* no	Match any one character. */
+#define	ANYOF	4	/* str	Match character in (or not in) this class. */
+#define	CURLY	5	/* str	Match this simple thing {n,m} times. */
+#define	BRANCH	6	/* node	Match this alternative, or the next... */
+#define	BACK	7	/* no	Match "", "next" ptr points backward. */
+#define	EXACTLY	8	/* str	Match this string (preceded by length). */
+#define	NOTHING	9	/* no	Match empty string. */
+#define	STAR	10	/* node	Match this (simple) thing 0 or more times. */
+#define	PLUS	11	/* node	Match this (simple) thing 1 or more times. */
+#define ALNUM	12	/* no	Match any alphanumeric character */
+#define NALNUM	13	/* no	Match any non-alphanumeric character */
+#define BOUND	14	/* no	Match "" at any word boundary */
+#define NBOUND	15	/* no	Match "" at any word non-boundary */
+#define SPACE	16	/* no	Match any whitespace character */
+#define NSPACE	17	/* no	Match any non-whitespace character */
+#define DIGIT	18	/* no	Match any numeric character */
+#define NDIGIT	19	/* no	Match any non-numeric character */
+#define REF	20	/* num	Match some already matched string */
+#define	OPEN	21	/* num	Mark this point in input as start of #n. */
+#define	CLOSE	22	/* num	Analogous to OPEN. */
+
+/*
+ * 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
+extern char regarglen[];
+#else
+char regarglen[] = {0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,2};
+#endif
+
+/* The following have no fixed length. */
+#ifndef DOINIT
+extern char varies[];
+#else
+char varies[] = {BRANCH,BACK,STAR,PLUS,CURLY,REF,0};
+#endif
+
+/* The following always have a length of 1. */
+#ifndef DOINIT
+extern char simple[];
+#else
+char simple[] = {ANY,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)
+#else
+#define	NEXTOPER(p)	((p) + 3)
+#endif
+
+#define MAGIC 0234
+
+/*
+ * Utility definitions.
+ */
+#ifndef lint
+#ifndef CHARBITS
+#define	UCHARAT(p)	((int)*(unsigned char *)(p))
+#else
+#define	UCHARAT(p)	((int)*(p)&CHARBITS)
+#endif
+#else /* lint */
+#define UCHARAT(p)	regdummy
+#endif /* lint */
+
+#define	FAIL(m)	fatal("/%s/: %s",regprecomp,m)
+
+char *regnext();
+#ifdef DEBUGGING
+void regdump();
+char *regprop();
+#endif
+
diff --git a/gnu/usr.bin/perl/perl/regexec.c b/gnu/usr.bin/perl/perl/regexec.c
new file mode 100644
index 000000000000..7802465f734d
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/regexec.c
@@ -0,0 +1,910 @@
+/* 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.
+ */
+
+/* $RCSfile: regexec.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ * $Log: regexec.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  15:25:50  lwall
+ * patch20: pattern modifiers i and g didn't interact right
+ * patch20: in some cases $` and $' didn't get set by match
+ * patch20: /x{0}/ was wrongly interpreted as /x{0,}/
+ * 
+ * Revision 4.0.1.3  91/11/05  18:23:55  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: initial .* in pattern had dependency on value of $*
+ * 
+ * Revision 4.0.1.2  91/06/07  11:50:33  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * 
+ * Revision 4.0.1.1  91/04/12  09:07:39  lwall
+ * patch1: regexec only allocated space for 9 subexpresssions
+ * 
+ * Revision 4.0  91/03/20  01:39:16  lwall
+ * 4.0 baseline.
+ * 
+ */
+/*SUPPRESS 112*/
+/*
+ * regcomp and regexec -- 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, 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
+int regnarrate = 0;
+#endif
+
+/*
+ * regexec and friends
+ */
+
+/*
+ * Global work variables for regexec().
+ */
+static char *regprecomp;
+static char *reginput;		/* String-input pointer. */
+static char regprev;		/* char before regbol, \n if none */
+static char *regbol;		/* Beginning of input, for ^ check. */
+static char *regeol;		/* End of input, for $ check. */
+static char **regstartp;	/* Pointer to startp array. */
+static char **regendp;		/* Ditto for endp. */
+static char *reglastparen;	/* Similarly for lastparen. */
+static char *regtill;
+
+static int regmyp_size = 0;
+static char **regmystartp = Null(char**);
+static char **regmyendp   = Null(char**);
+
+/*
+ * Forwards.
+ */
+STATIC int regtry();
+STATIC int regmatch();
+STATIC int regrepeat();
+
+extern int multiline;
+
+/*
+ - regexec - match a regexp against a string
+ */
+int
+regexec(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 */
+int minend;	/* end of match must be at least minend after stringarg */
+STR *screamer;
+int safebase;	/* no need to remember string in subbase */
+{
+	register char *s;
+	register int i;
+	register char *c;
+	register char *string = stringarg;
+	register int tmp;
+	int minlen = 0;		/* must match at least this many chars */
+	int dontbother = 0;	/* how many characters not to try at end */
+
+	/* Be paranoid... */
+	if (prog == NULL || string == NULL) {
+		fatal("NULL regexp parameter");
+		return(0);
+	}
+
+	if (string == strbeg)	/* is ^ valid at stringarg? */
+	    regprev = '\n';
+	else {
+	    regprev = stringarg[-1];
+	    if (!multiline && regprev == '\n')
+		regprev = '\0';		/* force ^ to NOT match */
+	}
+	regprecomp = prog->precomp;
+	/* Check validity of program. */
+	if (UCHARAT(prog->program) != MAGIC) {
+		FAIL("corrupted regexp program");
+	}
+
+	if (prog->do_folding) {
+		i = strend - string;
+		New(1101,c,i+1,char);
+		Copy(string, c, i+1, char);
+		string = c;
+		strend = string + i;
+		for (s = string; s < strend; s++)
+			if (isUPPER(*s))
+				*s = tolower(*s);
+	}
+
+	/* If there is a "must appear" string, look for it. */
+	s = string;
+	if (prog->regmust != Nullstr &&
+	    (!(prog->reganch & ROPT_ANCH)
+	     || (multiline && prog->regback >= 0)) ) {
+		if (stringarg == strbeg && screamer) {
+			if (screamfirst[prog->regmust->str_rare] >= 0)
+				s = screaminstr(screamer,prog->regmust);
+			else
+				s = Nullch;
+		}
+#ifndef lint
+		else
+			s = fbminstr((unsigned char*)s, (unsigned char*)strend,
+			    prog->regmust);
+#endif
+		if (!s) {
+			++prog->regmust->str_u.str_useful;	/* hooray */
+			goto phooey;	/* not present */
+		}
+		else if (prog->regback >= 0) {
+			s -= prog->regback;
+			if (s < string)
+			    s = string;
+			minlen = prog->regback + prog->regmust->str_cur;
+		}
+		else if (--prog->regmust->str_u.str_useful < 0) { /* boo */
+			str_free(prog->regmust);
+			prog->regmust = Nullstr;	/* disable regmust */
+			s = string;
+		}
+		else {
+			s = string;
+			minlen = prog->regmust->str_cur;
+		}
+	}
+
+	/* Mark beginning of line for ^ . */
+	regbol = string;
+
+	/* Mark end of line for $ (and such) */
+	regeol = strend;
+
+	/* see how far we have to get to not match where we matched before */
+	regtill = string+minend;
+
+	/* Allocate our backreference arrays */
+	if ( regmyp_size < prog->nparens + 1 ) {
+	    /* Allocate or enlarge the arrays */
+	    regmyp_size = prog->nparens + 1;
+	    if ( regmyp_size < 10 ) regmyp_size = 10;	/* minimum */
+	    if ( regmystartp ) {
+		/* reallocate larger */
+		Renew(regmystartp,regmyp_size,char*);
+		Renew(regmyendp,  regmyp_size,char*);
+	    }
+	    else {
+		/* Initial allocation */
+		New(1102,regmystartp,regmyp_size,char*);
+		New(1102,regmyendp,  regmyp_size,char*);
+	    }
+	
+	}
+
+	/* Simplest case:  anchored match need be tried only once. */
+	/*  [unless multiline is set] */
+	if (prog->reganch & ROPT_ANCH) {
+		if (regtry(prog, string))
+			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 > string)
+			    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 = prog->regstart->str_ptr[0];
+		    while (s < strend) {
+			    if (*s == i) {
+				    if (regtry(prog, s))
+					    goto got_it;
+				    s++;
+				    while (s < strend && *s == i)
+					s++;
+			    }
+			    s++;
+		    }
+		}
+		else if (prog->regstart->str_pok == 3) {
+		    /* We know what string it must start with. */
+#ifndef lint
+		    while ((s = fbminstr((unsigned char*)s,
+		      (unsigned char*)strend, prog->regstart)) != NULL)
+#else
+		    while (s = Nullch)
+#endif
+		    {
+			    if (regtry(prog, s))
+				    goto got_it;
+			    s++;
+		    }
+		}
+		else {
+		    c = prog->regstart->str_ptr;
+		    while ((s = ninstr(s, strend,
+		      c, c + prog->regstart->str_cur )) != NULL) {
+			    if (regtry(prog, s))
+				    goto got_it;
+			    s++;
+		    }
+		}
+		goto phooey;
+	}
+	/*SUPPRESS 560*/
+	if (c = prog->regstclass) {
+		int 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 != string) {
+			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 != string) {
+			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:
+	prog->subbeg = strbeg;
+	prog->subend = strend;
+	if ((!safebase && (prog->nparens || sawampersand)) || prog->do_folding){
+		strend += dontbother;	/* uncheat */
+		if (safebase)			/* no need for $digit later */
+		    s = strbeg;
+		else if (strbeg != prog->subbase) {
+		    i = strend - string + (stringarg - strbeg);
+		    s = nsavestr(strbeg,i);	/* so $digit will work later */
+		    if (prog->subbase)
+			    Safefree(prog->subbase);
+		    prog->subbeg = prog->subbase = s;
+		    prog->subend = s+i;
+		}
+		else {
+		    i = strend - string + (stringarg - strbeg);
+		    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] - string);
+			    prog->endp[i] = s + (prog->endp[i] - string);
+			}
+		}
+		if (prog->do_folding)
+			Safefree(string);
+	}
+	return(1);
+
+    phooey:
+	if (prog->do_folding)
+		Safefree(string);
+	return(0);
+}
+
+/*
+ - regtry - try match at specific point
+ */
+static int			/* 0 failure, 1 success */
+regtry(prog, string)
+regexp *prog;
+char *string;
+{
+	register int i;
+	register char **sp;
+	register char **ep;
+
+	reginput = string;
+	regstartp = prog->startp;
+	regendp = prog->endp;
+	reglastparen = &prog->lastparen;
+	prog->lastparen = 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] = string;
+		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 int			/* 0 failure, 1 success */
+regmatch(prog)
+char *prog;
+{
+	register char *scan;	/* Current node. */
+	char *next;		/* Next node. */
+	register int nextchar;
+	register int n;		/* no or next */
+	register int ln;        /* len or last */
+	register char *s;	/* operand or save */
+	register char *locinput = reginput;
+
+	nextchar = *locinput;
+	scan = prog;
+#ifdef DEBUGGING
+	if (scan != NULL && regnarrate)
+		fprintf(stderr, "%s(\n", regprop(scan));
+#endif
+	while (scan != NULL) {
+#ifdef DEBUGGING
+		if (regnarrate)
+			fprintf(stderr, "%s...\n", regprop(scan));
+#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;
+			}
+			return(0);
+		case EOL:
+			if ((nextchar || locinput < regeol) && nextchar != '\n')
+				return(0);
+			if (!multiline && regeol - locinput > 1)
+				return 0;
+			/* regtill = regbol; */
+			break;
+		case ANY:
+			if ((nextchar == '\0' && locinput >= regeol) ||
+			  nextchar == '\n')
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case EXACTLY:
+			s = OPERAND(scan);
+			ln = *s++;
+			/* Inline the first character, for speed. */
+			if (*s != nextchar)
+				return(0);
+			if (regeol - locinput < ln)
+				return 0;
+			if (ln > 1 && bcmp(s, locinput, ln) != 0)
+				return(0);
+			locinput += ln;
+			nextchar = *locinput;
+			break;
+		case ANYOF:
+			s = OPERAND(scan);
+			if (nextchar < 0)
+				nextchar = UCHARAT(locinput);
+			if (s[nextchar >> 3] & (1 << (nextchar&7)))
+				return(0);
+			if (!nextchar && locinput >= regeol)
+				return 0;
+			nextchar = *++locinput;
+			break;
+		case ALNUM:
+			if (!nextchar)
+				return(0);
+			if (!isALNUM(nextchar))
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case NALNUM:
+			if (!nextchar && locinput >= regeol)
+				return(0);
+			if (isALNUM(nextchar))
+				return(0);
+			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))
+				return(0);
+			break;
+		case SPACE:
+			if (!nextchar && locinput >= regeol)
+				return(0);
+			if (!isSPACE(nextchar))
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case NSPACE:
+			if (!nextchar)
+				return(0);
+			if (isSPACE(nextchar))
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case DIGIT:
+			if (!isDIGIT(nextchar))
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case NDIGIT:
+			if (!nextchar && locinput >= regeol)
+				return(0);
+			if (isDIGIT(nextchar))
+				return(0);
+			nextchar = *++locinput;
+			break;
+		case REF:
+			n = ARG1(scan);  /* which paren pair */
+			s = regmystartp[n];
+			if (!s)
+			    return(0);
+			if (!regmyendp[n])
+			    return(0);
+			if (s == regmyendp[n])
+			    break;
+			/* Inline the first character, for speed. */
+			if (*s != nextchar)
+				return(0);
+			ln = regmyendp[n] - s;
+			if (locinput + ln > regeol)
+				return 0;
+			if (ln > 1 && bcmp(s, locinput, ln) != 0)
+				return(0);
+			locinput += ln;
+			nextchar = *locinput;
+			break;
+
+		case NOTHING:
+			break;
+		case BACK:
+			break;
+		case OPEN:
+			n = ARG1(scan);  /* which paren pair */
+			reginput = locinput;
+
+			regmystartp[n] = locinput;	/* for REF */
+			if (regmatch(next)) {
+				/*
+				 * Don't set startp if some later
+				 * invocation of the same parentheses
+				 * already has.
+				 */
+				if (regstartp[n] == NULL)
+					regstartp[n] = locinput;
+				return(1);
+			} else
+				return(0);
+			/* NOTREACHED */
+		case CLOSE: {
+				n = ARG1(scan);  /* which paren pair */
+				reginput = locinput;
+
+				regmyendp[n] = locinput;	/* for REF */
+				if (regmatch(next)) {
+					/*
+					 * Don't set endp if some later
+					 * invocation of the same parentheses
+					 * already has.
+					 */
+					if (regendp[n] == NULL) {
+						regendp[n] = locinput;
+						if (n > *reglastparen)
+						    *reglastparen = n;
+					}
+					return(1);
+				} else
+					return(0);
+			}
+			/*NOTREACHED*/
+		case BRANCH: {
+				if (OP(next) != BRANCH)		/* No choice. */
+					next = NEXTOPER(scan);	/* Avoid recursion. */
+				else {
+					do {
+						reginput = locinput;
+						if (regmatch(NEXTOPER(scan)))
+							return(1);
+#ifdef REGALIGN
+						/*SUPPRESS 560*/
+						if (n = NEXT(scan))
+						    scan += n;
+						else
+						    scan = NULL;
+#else
+						scan = regnext(scan);
+#endif
+					} while (scan != NULL && OP(scan) == BRANCH);
+					return(0);
+					/* NOTREACHED */
+				}
+			}
+			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;
+			n = regrepeat(scan, n);
+			if (!multiline && OP(next) == EOL && ln < n)
+			    ln = n;			/* why back off? */
+			while (n >= ln) {
+				/* If it could work, try it. */
+				if (nextchar == -1000 || *reginput == nextchar)
+					if (regmatch(next))
+						return(1);
+				/* Couldn't or didn't -- back up. */
+				n--;
+				reginput = locinput + n;
+			}
+			return(0);
+		case END:
+			reginput = locinput; /* put where regtry can find it */
+			return(1);	/* Success! */
+		default:
+			printf("%x %d\n",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*/
+#ifdef lint
+	return 0;
+#endif
+}
+
+/*
+ - 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 int
+regrepeat(p, max)
+char *p;
+int max;
+{
+	register char *scan;
+	register char *opnd;
+	register int 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 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:		/* Oh dear.  Called inappropriately. */
+		FAIL("internal regexp foulup");
+		/* NOTREACHED */
+	}
+
+	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 int 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/perl/regexp.h b/gnu/usr.bin/perl/perl/regexp.h
new file mode 100644
index 000000000000..66a1b8818d8f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/regexp.h
@@ -0,0 +1,53 @@
+/*
+ * Definitions etc. for regexp(3) routines.
+ *
+ * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
+ * not the System V one.
+ */
+
+/* $RCSfile: regexp.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ * $Log: regexp.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  91/11/05  18:24:31  lwall
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: initial .* in pattern had dependency on value of $*
+ * 
+ * Revision 4.0.1.1  91/06/07  11:51:18  lwall
+ * patch4: new copyright notice
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: $` was busted inside s///
+ * 
+ * Revision 4.0  91/03/20  01:39:23  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+typedef struct regexp {
+	char **startp;
+	char **endp;
+	STR *regstart;		/* Internal use only. */
+	char *regstclass;
+	STR *regmust;		/* Internal use only. */
+	int regback;		/* Can regmust locate first try? */
+	int minlen;		/* mininum possible length of $& */
+	int prelen;		/* length of precomp */
+	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 */
+	char reganch;		/* Internal use only. */
+	char do_folding;	/* do case-insensitive match? */
+	char lastparen;		/* last paren matched */
+	char nparens;		/* number of parentheses */
+	char program[1];	/* Unwarranted chumminess with compiler. */
+} regexp;
+
+#define ROPT_ANCH 1
+#define ROPT_SKIP 2
+#define ROPT_IMPLICIT 4
+
+regexp *regcomp();
+int regexec();
diff --git a/gnu/usr.bin/perl/perl/spat.h b/gnu/usr.bin/perl/perl/spat.h
new file mode 100644
index 000000000000..2a840e2855fb
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/spat.h
@@ -0,0 +1,46 @@
+/* $RCSfile: spat.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ *    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: spat.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  11:51:59  lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * 
+ * Revision 4.0  91/03/20  01:39:36  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+struct scanpat {
+    SPAT	*spat_next;		/* list of all scanpats */
+    REGEXP	*spat_regexp;		/* compiled expression */
+    ARG		*spat_repl;		/* replacement string for subst */
+    ARG		*spat_runtime;		/* compile pattern at runtime */
+    STR		*spat_short;		/* for a fast bypass of execute() */
+    short	spat_flags;
+    char	spat_slen;
+};
+
+#define SPAT_USED 1			/* spat has been used once already */
+#define SPAT_ONCE 2			/* use pattern only once per reset */
+#define SPAT_SCANFIRST 4		/* initial constant not anchored */
+#define SPAT_ALL 8			/* initial constant is whole pat */
+#define SPAT_SKIPWHITE 16		/* skip leading whitespace for split */
+#define SPAT_FOLD 32			/* case insensitivity */
+#define SPAT_CONST 64			/* subst replacement is constant */
+#define SPAT_KEEP 128			/* keep 1st runtime pattern forever */
+#define SPAT_GLOBAL 256			/* pattern had a g modifier */
+
+EXT SPAT *curspat;		/* what to do \ interps from */
+EXT SPAT *lastspat;		/* what to use in place of null pattern */
+
+EXT char *hint INIT(Nullch);	/* hint from cmd_exec to do_match et al */
+
+#define Nullspat Null(SPAT*)
diff --git a/gnu/usr.bin/perl/perl/stab.c b/gnu/usr.bin/perl/perl/stab.c
new file mode 100644
index 000000000000..70827255d7bf
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/stab.c
@@ -0,0 +1,1055 @@
+/* $RCSfile: stab.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ *    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: stab.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.5  1993/02/05  19:42:47  lwall
+ * patch36: length returned wrong value on certain semi-magical variables
+ *
+ * Revision 4.0.1.4  92/06/08  15:32:19  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: the debugger now warns you on lines that can't set a breakpoint
+ * patch20: the debugger made perl forget the last pattern used by //
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * 
+ * Revision 4.0.1.3  91/11/05  18:35:33  lwall
+ * patch11: length($x) was sometimes wrong for numeric $x
+ * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
+ * patch11: *foo = undef coredumped
+ * patch11: solitary subroutine references no longer trigger typo warnings
+ * patch11: local(*FILEHANDLE) had a memory leak
+ * 
+ * Revision 4.0.1.2  91/06/07  11:55:53  lwall
+ * patch4: new copyright notice
+ * patch4: added $^P variable to control calling of perldb routines
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: $` was busted inside s///
+ * patch4: default top-of-form format is now FILEHANDLE_TOP
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * patch4: $^D |= 1024 now does syntax tree dump at run-time
+ * 
+ * Revision 4.0.1.1  91/04/12  09:10:24  lwall
+ * patch1: Configure now differentiates getgroups() type from getgid() type
+ * patch1: you may now use "die" and "caller" in a signal handler
+ * 
+ * Revision 4.0  91/03/20  01:39:41  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+static char *sig_name[] = {
+    SIG_NAME,0
+};
+
+#ifdef VOIDSIG
+#define handlertype void
+#else
+#define handlertype int
+#endif
+
+static handlertype sighandler();
+
+static int origalen = 0;
+
+STR *
+stab_str(str)
+STR *str;
+{
+    STAB *stab = str->str_u.str_stab;
+    register int paren;
+    register char *s;
+    register int i;
+
+    if (str->str_rare)
+	return stab_val(stab);
+
+    switch (*stab->str_magic->str_ptr) {
+    case '\004':		/* ^D */
+#ifdef DEBUGGING
+	str_numset(stab_val(stab),(double)(debug & 32767));
+#endif
+	break;
+    case '\006':		/* ^F */
+	str_numset(stab_val(stab),(double)maxsysfd);
+	break;
+    case '\t':			/* ^I */
+	if (inplace)
+	    str_set(stab_val(stab), inplace);
+	else
+	    str_sset(stab_val(stab),&str_undef);
+	break;
+    case '\020':		/* ^P */
+	str_numset(stab_val(stab),(double)perldb);
+	break;
+    case '\024':		/* ^T */
+	str_numset(stab_val(stab),(double)basetime);
+	break;
+    case '\027':		/* ^W */
+	str_numset(stab_val(stab),(double)dowarn);
+	break;
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curspat) {
+	    paren = atoi(stab_ename(stab));
+	  getparen:
+	    if (curspat->spat_regexp &&
+	      paren <= curspat->spat_regexp->nparens &&
+	      (s = curspat->spat_regexp->startp[paren]) ) {
+		i = curspat->spat_regexp->endp[paren] - s;
+		if (i >= 0)
+		    str_nset(stab_val(stab),s,i);
+		else
+		    str_sset(stab_val(stab),&str_undef);
+	    }
+	    else
+		str_sset(stab_val(stab),&str_undef);
+	}
+	break;
+    case '+':
+	if (curspat) {
+	    paren = curspat->spat_regexp->lastparen;
+	    goto getparen;
+	}
+	break;
+    case '`':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->subbeg) ) {
+		i = curspat->spat_regexp->startp[0] - s;
+		if (i >= 0)
+		    str_nset(stab_val(stab),s,i);
+		else
+		    str_nset(stab_val(stab),"",0);
+	    }
+	    else
+		str_nset(stab_val(stab),"",0);
+	}
+	break;
+    case '\'':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->endp[0]) ) {
+		str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
+	    }
+	    else
+		str_nset(stab_val(stab),"",0);
+	}
+	break;
+    case '.':
+#ifndef lint
+	if (last_in_stab && stab_io(last_in_stab)) {
+	    str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
+	}
+#endif
+	break;
+    case '?':
+	str_numset(stab_val(stab),(double)statusvalue);
+	break;
+    case '^':
+	s = stab_io(curoutstab)->top_name;
+	if (s)
+	    str_set(stab_val(stab),s);
+	else {
+	    str_set(stab_val(stab),stab_ename(curoutstab));
+	    str_cat(stab_val(stab),"_TOP");
+	}
+	break;
+    case '~':
+	s = stab_io(curoutstab)->fmt_name;
+	if (!s)
+	    s = stab_ename(curoutstab);
+	str_set(stab_val(stab),s);
+	break;
+#ifndef lint
+    case '=':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
+	break;
+    case '-':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
+	break;
+    case '%':
+	str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
+	break;
+#endif
+    case ':':
+	break;
+    case '/':
+	break;
+    case '[':
+	str_numset(stab_val(stab),(double)arybase);
+	break;
+    case '|':
+	if (!stab_io(curoutstab))
+	    stab_io(curoutstab) = stio_new();
+	str_numset(stab_val(stab),
+	   (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
+	break;
+    case ',':
+	str_nset(stab_val(stab),ofs,ofslen);
+	break;
+    case '\\':
+	str_nset(stab_val(stab),ors,orslen);
+	break;
+    case '#':
+	str_set(stab_val(stab),ofmt);
+	break;
+    case '!':
+	str_numset(stab_val(stab), (double)errno);
+	str_set(stab_val(stab), errno ? strerror(errno) : "");
+	stab_val(stab)->str_nok = 1;	/* what a wonderful hack! */
+	break;
+    case '<':
+	str_numset(stab_val(stab),(double)uid);
+	break;
+    case '>':
+	str_numset(stab_val(stab),(double)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
+	{
+	    GROUPSTYPE gary[NGROUPS];
+
+	    i = getgroups(NGROUPS,gary);
+	    while (--i >= 0) {
+		(void)sprintf(s," %ld", (long)gary[i]);
+		while (*s) s++;
+	    }
+	}
+#endif
+	str_set(stab_val(stab),buf);
+	break;
+    case '*':
+	break;
+    case '0':
+	break;
+    default:
+	{
+	    struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
+
+	    if (uf && uf->uf_val)
+		(*uf->uf_val)(uf->uf_index, stab_val(stab));
+	}
+	break;
+    }
+    return stab_val(stab);
+}
+
+STRLEN
+stab_len(str)
+STR *str;
+{
+    STAB *stab = str->str_u.str_stab;
+    int paren;
+    int i;
+    char *s;
+
+    if (str->str_rare)
+	return str_len(stab_val(stab));
+
+    switch (*stab->str_magic->str_ptr) {
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curspat) {
+	    paren = atoi(stab_ename(stab));
+	  getparen:
+	    if (curspat->spat_regexp &&
+	      paren <= curspat->spat_regexp->nparens &&
+	      (s = curspat->spat_regexp->startp[paren]) ) {
+		i = curspat->spat_regexp->endp[paren] - s;
+		if (i >= 0)
+		    return i;
+		else
+		    return 0;
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case '+':
+	if (curspat) {
+	    paren = curspat->spat_regexp->lastparen;
+	    goto getparen;
+	}
+	break;
+    case '`':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->subbeg) ) {
+		i = curspat->spat_regexp->startp[0] - s;
+		if (i >= 0)
+		    return i;
+		else
+		    return 0;
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case '\'':
+	if (curspat) {
+	    if (curspat->spat_regexp &&
+	      (s = curspat->spat_regexp->endp[0]) ) {
+		return (STRLEN) (curspat->spat_regexp->subend - s);
+	    }
+	    else
+		return 0;
+	}
+	break;
+    case ',':
+	return (STRLEN)ofslen;
+    case '\\':
+	return (STRLEN)orslen;
+    }
+    return str_len(stab_str(str));
+}
+
+void
+stabset(mstr,str)
+register STR *mstr;
+STR *str;
+{
+    STAB *stab;
+    register char *s;
+    int i;
+
+    switch (mstr->str_rare) {
+    case 'E':
+	my_setenv(mstr->str_ptr,str_get(str));
+				/* And you'll never guess what the dog had */
+				/*   in its mouth... */
+#ifdef TAINT
+	if (strEQ(mstr->str_ptr,"PATH")) {
+	    char *strend = str->str_ptr + str->str_cur;
+
+	    s = str->str_ptr;
+	    while (s < strend) {
+		s = cpytill(tokenbuf,s,strend,':',&i);
+		s++;
+		if (*tokenbuf != '/'
+		  || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+		    str->str_tainted = 2;
+	    }
+	}
+#endif
+	break;
+    case 'S':
+	s = str_get(str);
+	i = whichsig(mstr->str_ptr);	/* ...no, a brick */
+	if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
+	    warn("No such signal: SIG%s", mstr->str_ptr);
+	if (strEQ(s,"IGNORE"))
+#ifndef lint
+	    (void)signal(i,SIG_IGN);
+#else
+	    ;
+#endif
+	else if (strEQ(s,"DEFAULT") || !*s)
+	    (void)signal(i,SIG_DFL);
+	else {
+	    (void)signal(i,sighandler);
+	    if (!index(s,'\'')) {
+		sprintf(tokenbuf, "main'%s",s);
+		str_set(str,tokenbuf);
+	    }
+	}
+	break;
+#ifdef SOME_DBM
+    case 'D':
+	stab = mstr->str_u.str_stab;
+	hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
+	break;
+#endif
+    case 'L':
+	{
+	    CMD *cmd;
+
+	    stab = mstr->str_u.str_stab;
+	    i = str_true(str);
+	    str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
+	    if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
+		cmd->c_flags &= ~CF_OPTIMIZE;
+		cmd->c_flags |= i? CFT_D1 : CFT_D0;
+	    }
+	    else
+		warn("Can't break at that line\n");
+	}
+	break;
+    case '#':
+	stab = mstr->str_u.str_stab;
+	afill(stab_array(stab), (int)str_gnum(str) - arybase);
+	break;
+    case 'X':	/* merely a copy of a * string */
+	break;
+    case '*':
+	s = str->str_pok ? str_get(str) : "";
+	if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
+	    stab = mstr->str_u.str_stab;
+	    if (!*s) {
+		STBP *stbp;
+
+		/*SUPPRESS 701*/
+		(void)savenostab(stab);	/* schedule a free of this stab */
+		if (stab->str_len)
+		    Safefree(stab->str_ptr);
+		Newz(601,stbp, 1, STBP);
+		stab->str_ptr = stbp;
+		stab->str_len = stab->str_cur = sizeof(STBP);
+		stab->str_pok = 1;
+		strcpy(stab_magic(stab),"StB");
+		stab_val(stab) = Str_new(70,0);
+		stab_line(stab) = curcmd->c_line;
+		stab_estab(stab) = stab;
+	    }
+	    else {
+		stab = stabent(s,TRUE);
+		if (!stab_xarray(stab))
+		    aadd(stab);
+		if (!stab_xhash(stab))
+		    hadd(stab);
+		if (!stab_io(stab))
+		    stab_io(stab) = stio_new();
+	    }
+	    str_sset(str, (STR*) stab);
+	}
+	break;
+    case 's': {
+	    struct lstring *lstr = (struct lstring*)str;
+	    char *tmps;
+
+	    mstr->str_rare = 0;
+	    str->str_magic = Nullstr;
+	    tmps = str_get(str);
+	    str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
+	      tmps,str->str_cur);
+	}
+	break;
+
+    case 'v':
+	do_vecset(mstr,str);
+	break;
+
+    case 0:
+	/*SUPPRESS 560*/
+	if (!(stab = mstr->str_u.str_stab))
+	    break;
+	switch (*stab->str_magic->str_ptr) {
+	case '\004':	/* ^D */
+#ifdef DEBUGGING
+	    debug = (int)(str_gnum(str)) | 32768;
+	    if (debug & 1024)
+		dump_all();
+#endif
+	    break;
+	case '\006':	/* ^F */
+	    maxsysfd = (int)str_gnum(str);
+	    break;
+	case '\t':	/* ^I */
+	    if (inplace)
+		Safefree(inplace);
+	    if (str->str_pok || str->str_nok)
+		inplace = savestr(str_get(str));
+	    else
+		inplace = Nullch;
+	    break;
+	case '\020':	/* ^P */
+	    i = (int)str_gnum(str);
+	    if (i != perldb) {
+		static SPAT *oldlastspat;
+
+		if (perldb)
+		    oldlastspat = lastspat;
+		else
+		    lastspat = oldlastspat;
+	    }
+	    perldb = i;
+	    break;
+	case '\024':	/* ^T */
+	    basetime = (time_t)str_gnum(str);
+	    break;
+	case '\027':	/* ^W */
+	    dowarn = (bool)str_gnum(str);
+	    break;
+	case '.':
+	    if (localizing)
+		savesptr((STR**)&last_in_stab);
+	    break;
+	case '^':
+	    Safefree(stab_io(curoutstab)->top_name);
+	    stab_io(curoutstab)->top_name = s = savestr(str_get(str));
+	    stab_io(curoutstab)->top_stab = stabent(s,TRUE);
+	    break;
+	case '~':
+	    Safefree(stab_io(curoutstab)->fmt_name);
+	    stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
+	    stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
+	    break;
+	case '=':
+	    stab_io(curoutstab)->page_len = (long)str_gnum(str);
+	    break;
+	case '-':
+	    stab_io(curoutstab)->lines_left = (long)str_gnum(str);
+	    if (stab_io(curoutstab)->lines_left < 0L)
+		stab_io(curoutstab)->lines_left = 0L;
+	    break;
+	case '%':
+	    stab_io(curoutstab)->page = (long)str_gnum(str);
+	    break;
+	case '|':
+	    if (!stab_io(curoutstab))
+		stab_io(curoutstab) = stio_new();
+	    stab_io(curoutstab)->flags &= ~IOF_FLUSH;
+	    if (str_gnum(str) != 0.0) {
+		stab_io(curoutstab)->flags |= IOF_FLUSH;
+	    }
+	    break;
+	case '*':
+	    i = (int)str_gnum(str);
+	    multiline = (i != 0);
+	    break;
+	case '/':
+	    if (str->str_pok) {
+		rs = str_get(str);
+		rslen = str->str_cur;
+		if (rspara = !rslen) {
+		    rs = "\n\n";
+		    rslen = 2;
+		}
+		rschar = rs[rslen - 1];
+	    }
+	    else {
+		rschar = 0777;	/* fake a non-existent char */
+		rslen = 1;
+	    }
+	    break;
+	case '\\':
+	    if (ors)
+		Safefree(ors);
+	    ors = savestr(str_get(str));
+	    orslen = str->str_cur;
+	    break;
+	case ',':
+	    if (ofs)
+		Safefree(ofs);
+	    ofs = savestr(str_get(str));
+	    ofslen = str->str_cur;
+	    break;
+	case '#':
+	    if (ofmt)
+		Safefree(ofmt);
+	    ofmt = savestr(str_get(str));
+	    break;
+	case '[':
+	    arybase = (int)str_gnum(str);
+	    break;
+	case '?':
+	    statusvalue = U_S(str_gnum(str));
+	    break;
+	case '!':
+	    errno = (int)str_gnum(str);		/* will anyone ever use this? */
+	    break;
+	case '<':
+	    uid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_RUID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETRUID
+	    (void)setruid((UIDTYPE)uid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
+#else
+	    if (uid == euid)		/* special case $< = $> */
+		(void)setuid(uid);
+	    else
+		fatal("setruid() not implemented");
+#endif
+#endif
+	    uid = (int)getuid();
+	    break;
+	case '>':
+	    euid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_EUID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETEUID
+	    (void)seteuid((UIDTYPE)euid);
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
+#else
+	    if (euid == uid)		/* special case $> = $< */
+		setuid(euid);
+	    else
+		fatal("seteuid() not implemented");
+#endif
+#endif
+	    euid = (int)geteuid();
+	    break;
+	case '(':
+	    gid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_RGID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETRGID
+	    (void)setrgid((GIDTYPE)gid);
+#else
+#ifdef HAS_SETREGID
+	    (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
+#else
+	    if (gid == egid)			/* special case $( = $) */
+		(void)setgid(gid);
+	    else
+		fatal("setrgid() not implemented");
+#endif
+#endif
+	    gid = (int)getgid();
+	    break;
+	case ')':
+	    egid = (int)str_gnum(str);
+	    if (delaymagic) {
+		delaymagic |= DM_EGID;
+		break;				/* don't do magic till later */
+	    }
+#ifdef HAS_SETEGID
+	    (void)setegid((GIDTYPE)egid);
+#else
+#ifdef HAS_SETREGID
+	    (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
+#else
+	    if (egid == gid)			/* special case $) = $( */
+		(void)setgid(egid);
+	    else
+		fatal("setegid() not implemented");
+#endif
+#endif
+	    egid = (int)getegid();
+	    break;
+	case ':':
+	    chopset = str_get(str);
+	    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 = str_get(str);
+	    i = str->str_cur;
+	    if (i >= origalen) {
+		i = origalen;
+		str->str_cur = i;
+		str->str_ptr[i] = '\0';
+		Copy(s, origargv[0], i, char);
+	    }
+	    else {
+		Copy(s, origargv[0], i, char);
+		s = origargv[0]+i;
+		*s++ = '\0';
+		while (++i < origalen)
+		    *s++ = ' ';
+	    }
+	    break;
+	default:
+	    {
+		struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
+
+		if (uf && uf->uf_set)
+		    (*uf->uf_set)(uf->uf_index, str);
+	    }
+	    break;
+	}
+	break;
+    }
+}
+
+int
+whichsig(sig)
+char *sig;
+{
+    register char **sigv;
+
+    for (sigv = sig_name+1; *sigv; sigv++)
+	if (strEQ(sig,*sigv))
+	    return sigv - sig_name;
+#ifdef SIGCLD
+    if (strEQ(sig,"CHLD"))
+	return SIGCLD;
+#endif
+#ifdef SIGCHLD
+    if (strEQ(sig,"CLD"))
+	return SIGCHLD;
+#endif
+    return 0;
+}
+
+static handlertype
+sighandler(sig)
+int sig;
+{
+    STAB *stab;
+    STR *str;
+    int oldsave = savestack->ary_fill;
+    int oldtmps_base = tmps_base;
+    register CSV *csv;
+    SUBR *sub;
+
+#ifdef OS2		/* or anybody else who requires SIG_ACK */
+    signal(sig, SIG_ACK);
+#endif
+    stab = stabent(
+	str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
+	  TRUE)), TRUE);
+    sub = stab_sub(stab);
+    if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
+	if (sig_name[sig][1] == 'H')
+	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
+	      TRUE);
+	else
+	    stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
+	      TRUE);
+	sub = stab_sub(stab);	/* gag */
+    }
+    if (!sub) {
+	if (dowarn)
+	    warn("SIG%s handler \"%s\" not defined.\n",
+		sig_name[sig], stab_ename(stab) );
+	return;
+    }
+    /*SUPPRESS 701*/
+    saveaptr(&stack);
+    str = Str_new(15, sizeof(CSV));
+    str->str_state = SS_SCSV;
+    (void)apush(savestack,str);
+    csv = (CSV*)str->str_ptr;
+    csv->sub = sub;
+    csv->stab = stab;
+    csv->curcsv = curcsv;
+    csv->curcmd = curcmd;
+    csv->depth = sub->depth;
+    csv->wantarray = G_SCALAR;
+    csv->hasargs = TRUE;
+    csv->savearray = stab_xarray(defstab);
+    csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
+    stack->ary_flags = 0;
+    curcsv = csv;
+    str = str_mortal(&str_undef);
+    str_set(str,sig_name[sig]);
+    (void)apush(stab_xarray(defstab),str);
+    sub->depth++;
+    if (sub->depth >= 2) {	/* save temporaries on recursion? */
+	if (sub->depth == 100 && dowarn)
+	    warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
+	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+    }
+
+    tmps_base = tmps_max;		/* protect our mortal string */
+    (void)cmd_exec(sub->cmd,G_SCALAR,0);		/* so do it already */
+    tmps_base = oldtmps_base;
+
+    restorelist(oldsave);		/* put everything back */
+}
+
+STAB *
+aadd(stab)
+register STAB *stab;
+{
+    if (!stab_xarray(stab))
+	stab_xarray(stab) = anew(stab);
+    return stab;
+}
+
+STAB *
+hadd(stab)
+register STAB *stab;
+{
+    if (!stab_xhash(stab))
+	stab_xhash(stab) = hnew(COEFFSIZE);
+    return stab;
+}
+
+STAB *
+fstab(name)
+char *name;
+{
+    char tmpbuf[1200];
+    STAB *stab;
+
+    sprintf(tmpbuf,"'_<%s", name);
+    stab = stabent(tmpbuf, TRUE);
+    str_set(stab_val(stab), name);
+    if (perldb)
+	(void)hadd(aadd(stab));
+    return stab;
+}
+
+STAB *
+stabent(name,add)
+register char *name;
+int add;
+{
+    register STAB *stab;
+    register STBP *stbp;
+    int len;
+    register char *namend;
+    HASH *stash;
+    char *sawquote = Nullch;
+    char *prevquote = Nullch;
+    bool global = FALSE;
+
+    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;
+    }
+    for (namend = name; *namend; namend++) {
+	if (*namend == '\'' && namend[1])
+	    prevquote = sawquote, sawquote = namend;
+    }
+    if (sawquote == name && name[1]) {
+	stash = defstash;
+	sawquote = Nullch;
+	name++;
+    }
+    else if (!isALPHA(*name) || global)
+	stash = defstash;
+    else if ((CMD*)curcmd == &compiling)
+	stash = curstash;
+    else
+	stash = curcmd->c_stash;
+    if (sawquote) {
+	char tmpbuf[256];
+	char *s, *d;
+
+	*sawquote = '\0';
+	/*SUPPRESS 560*/
+	if (s = prevquote) {
+	    strncpy(tmpbuf,name,s-name+1);
+	    d = tmpbuf+(s-name+1);
+	    *d++ = '_';
+	    strcpy(d,s+1);
+	}
+	else {
+	    *tmpbuf = '_';
+	    strcpy(tmpbuf+1,name);
+	}
+	stab = stabent(tmpbuf,TRUE);
+	if (!(stash = stab_xhash(stab)))
+	    stash = stab_xhash(stab) = hnew(0);
+	if (!stash->tbl_name)
+	    stash->tbl_name = savestr(name);
+	name = sawquote+1;
+	*sawquote = '\'';
+    }
+    len = namend - name;
+    stab = (STAB*)hfetch(stash,name,len,add);
+    if (stab == (STAB*)&str_undef)
+	return Nullstab;
+    if (stab->str_pok) {
+	stab->str_pok |= SP_MULTI;
+	return stab;
+    }
+    else {
+	if (stab->str_len)
+	    Safefree(stab->str_ptr);
+	Newz(602,stbp, 1, STBP);
+	stab->str_ptr = stbp;
+	stab->str_len = stab->str_cur = sizeof(STBP);
+	stab->str_pok = 1;
+	strcpy(stab_magic(stab),"StB");
+	stab_val(stab) = Str_new(72,0);
+	stab_line(stab) = curcmd->c_line;
+	stab_estab(stab) = stab;
+	str_magic((STR*)stab, stab, '*', name, len);
+	stab_stash(stab) = stash;
+	if (isDIGIT(*name) && *name != '0') {
+	    stab_flags(stab) = SF_VMAGIC;
+	    str_magic(stab_val(stab), stab, 0, Nullch, 0);
+	}
+	if (add & 2)
+	    stab->str_pok |= SP_MULTI;
+	return stab;
+    }
+}
+
+void
+stab_fullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    HASH *tb = stab_stash(stab);
+
+    if (!tb)
+	return;
+    str_set(str,tb->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab->str_magic);
+}
+
+void
+stab_efullname(str,stab)
+STR *str;
+STAB *stab;
+{
+    HASH *tb = stab_estash(stab);
+
+    if (!tb)
+	return;
+    str_set(str,tb->tbl_name);
+    str_ncat(str,"'", 1);
+    str_scat(str,stab_estab(stab)->str_magic);
+}
+
+STIO *
+stio_new()
+{
+    STIO *stio;
+
+    Newz(603,stio,1,STIO);
+    stio->page_len = 60;
+    return stio;
+}
+
+void
+stab_check(min,max)
+int min;
+register int max;
+{
+    register HENT *entry;
+    register int i;
+    register STAB *stab;
+
+    for (i = min; i <= max; i++) {
+	for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
+	    stab = (STAB*)entry->hent_val;
+	    if (stab->str_pok & SP_MULTI)
+		continue;
+	    curcmd->c_line = stab_line(stab);
+	    warn("Possible typo: \"%s\"", stab_name(stab));
+	}
+    }
+}
+
+static int gensym = 0;
+
+STAB *
+genstab()
+{
+    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
+    return stabent(tokenbuf,TRUE);
+}
+
+/* hopefully this is only called on local symbol table entries */
+
+void
+stab_clear(stab)
+register STAB *stab;
+{
+    STIO *stio;
+    SUBR *sub;
+
+    if (!stab || !stab->str_ptr)
+	return;
+    afree(stab_xarray(stab));
+    stab_xarray(stab) = Null(ARRAY*);
+    (void)hfree(stab_xhash(stab), FALSE);
+    stab_xhash(stab) = Null(HASH*);
+    str_free(stab_val(stab));
+    stab_val(stab) = Nullstr;
+    /*SUPPRESS 560*/
+    if (stio = stab_io(stab)) {
+	do_close(stab,FALSE);
+	Safefree(stio->top_name);
+	Safefree(stio->fmt_name);
+	Safefree(stio);
+    }
+    /*SUPPRESS 560*/
+    if (sub = stab_sub(stab)) {
+	afree(sub->tosave);
+	cmd_free(sub->cmd);
+    }
+    Safefree(stab->str_ptr);
+    stab->str_ptr = Null(STBP*);
+    stab->str_len = 0;
+    stab->str_cur = 0;
+}
+
+#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+#define MICROPORT
+#endif
+
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+ARRAY *stab_array(stab)
+register STAB *stab;
+{
+    if (((STBP*)(stab->str_ptr))->stbp_array) 
+	return ((STBP*)(stab->str_ptr))->stbp_array;
+    else
+	return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
+}
+
+HASH *stab_hash(stab)
+register STAB *stab;
+{
+    if (((STBP*)(stab->str_ptr))->stbp_hash)
+	return ((STBP*)(stab->str_ptr))->stbp_hash;
+    else
+	return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
+}
+#endif			/* Microport 2.4 hack */
diff --git a/gnu/usr.bin/perl/perl/stab.h b/gnu/usr.bin/perl/perl/stab.h
new file mode 100644
index 000000000000..7bce082e7a9a
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/stab.h
@@ -0,0 +1,145 @@
+/* $RCSfile: stab.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ *    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: stab.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.3  92/06/08  15:33:44  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * 
+ * Revision 4.0.1.2  91/11/05  18:36:15  lwall
+ * patch11: length($x) was sometimes wrong for numeric $x
+ * 
+ * Revision 4.0.1.1  91/06/07  11:56:35  lwall
+ * patch4: new copyright notice
+ * patch4: length($`), length($&), length($') now optimized to avoid string copy
+ * 
+ * Revision 4.0  91/03/20  01:39:49  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+struct stabptrs {
+    char        stbp_magic[4];
+    STR		*stbp_val;	/* scalar value */
+    struct stio *stbp_io;	/* filehandle value */
+    FCMD	*stbp_form;	/* format value */
+    ARRAY	*stbp_array;	/* array value */
+    HASH	*stbp_hash;	/* associative array value */
+    STAB	*stbp_stab;	/* effective stab, if *glob */
+    SUBR	*stbp_sub;	/* subroutine value */
+    int		stbp_lastexpr;	/* used by nothing_in_common() */
+    line_t	stbp_line;	/* line first declared at (for -w) */
+    char	stbp_flags;
+};
+
+#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+#define MICROPORT
+#endif
+
+#define stab_magic(stab)	(((STBP*)(stab->str_ptr))->stbp_magic)
+#define stab_val(stab)		(((STBP*)(stab->str_ptr))->stbp_val)
+#define stab_io(stab)		(((STBP*)(stab->str_ptr))->stbp_io)
+#define stab_form(stab)		(((STBP*)(stab->str_ptr))->stbp_form)
+#define stab_xarray(stab)	(((STBP*)(stab->str_ptr))->stbp_array)
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+ARRAY *stab_array();
+#else
+#define stab_array(stab)	(((STBP*)(stab->str_ptr))->stbp_array ? \
+				 ((STBP*)(stab->str_ptr))->stbp_array : \
+				 ((STBP*)(aadd(stab)->str_ptr))->stbp_array)
+#endif
+#define stab_xhash(stab)	(((STBP*)(stab->str_ptr))->stbp_hash)
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+HASH *stab_hash();
+#else
+#define stab_hash(stab)		(((STBP*)(stab->str_ptr))->stbp_hash ? \
+				 ((STBP*)(stab->str_ptr))->stbp_hash : \
+				 ((STBP*)(hadd(stab)->str_ptr))->stbp_hash)
+#endif			/* Microport 2.4 hack */
+#define stab_sub(stab)		(((STBP*)(stab->str_ptr))->stbp_sub)
+#define stab_lastexpr(stab)	(((STBP*)(stab->str_ptr))->stbp_lastexpr)
+#define stab_line(stab)		(((STBP*)(stab->str_ptr))->stbp_line)
+#define stab_flags(stab)	(((STBP*)(stab->str_ptr))->stbp_flags)
+
+#define stab_stab(stab)		(stab->str_magic->str_u.str_stab)
+#define stab_estab(stab)	(((STBP*)(stab->str_ptr))->stbp_stab)
+
+#define stab_name(stab)		(stab->str_magic->str_ptr)
+#define stab_ename(stab)	stab_name(stab_estab(stab))
+
+#define stab_stash(stab)	(stab->str_magic->str_u.str_stash)
+#define stab_estash(stab)	stab_stash(stab_estab(stab))
+
+#define SF_VMAGIC 1		/* call routine to dereference STR val */
+#define SF_MULTI 2		/* seen more than once */
+
+struct stio {
+    FILE	*ifp;		/* ifp and ofp are normally the same */
+    FILE	*ofp;		/* but sockets need separate streams */
+#ifdef HAS_READDIR
+    DIR		*dirp;		/* for opendir, readdir, etc */
+#endif
+    long	lines;		/* $. */
+    long	page;		/* $% */
+    long	page_len;	/* $= */
+    long	lines_left;	/* $- */
+    char	*top_name;	/* $^ */
+    STAB	*top_stab;	/* $^ */
+    char	*fmt_name;	/* $~ */
+    STAB	*fmt_stab;	/* $~ */
+    short	subprocess;	/* -| or |- */
+    char	type;
+    char	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 */
+
+struct sub {
+    CMD		*cmd;
+    int		(*usersub)();
+    int		userindex;
+    STAB	*filestab;
+    long	depth;	/* >= 2 indicates recursive call */
+    ARRAY	*tosave;
+};
+
+#define Nullstab Null(STAB*)
+
+STRLEN stab_len();
+
+#define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab))
+#define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : str_len(stab_val(tmpstab)))
+#define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
+#define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
+
+EXT STAB *tmpstab;
+
+EXT STAB *stab_index[128];
+
+EXT unsigned short statusvalue;
+
+EXT int delaymagic INIT(0);
+#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
+
+STAB *aadd();
+STAB *hadd();
+STAB *fstab();
+void stabset();
+void stab_fullname();
+void stab_efullname();
+void stab_check();
diff --git a/gnu/usr.bin/perl/perl/str.c b/gnu/usr.bin/perl/perl/str.c
new file mode 100644
index 000000000000..f034292e1076
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/str.c
@@ -0,0 +1,1599 @@
+/* $RCSfile: str.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.7  1993/02/05  19:43:47  lwall
+ * patch36: the non-std stdio input code wasn't null-proof
+ *
+ * Revision 4.0.1.6  92/06/11  21:14:21  lwall
+ * patch34: quotes containing subscripts containing variables didn't parse right
+ * 
+ * Revision 4.0.1.5  92/06/08  15:40:43  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: paragraph mode now skips extra newlines automatically
+ * patch20: fixed memory leak in doube-quote interpretation
+ * patch20: made /\$$foo/ look for literal '$foo'
+ * patch20: "$var{$foo'bar}" didn't scan subscript correctly
+ * patch20: a splice on non-existent array elements could dump core
+ * patch20: running taintperl explicitly now does checks even if $< == $>
+ * 
+ * Revision 4.0.1.4  91/11/05  18:40:51  lwall
+ * patch11: $foo .= <BAR> could overrun malloced memory
+ * patch11: \$ didn't always make it through double-quoter to regexp routines
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
+ * Revision 4.0.1.3  91/06/10  01:27:54  lwall
+ * patch10: $) and $| incorrectly handled in run-time patterns
+ * 
+ * Revision 4.0.1.2  91/06/07  11:58:13  lwall
+ * patch4: new copyright notice
+ * patch4: taint check on undefined string could cause core dump
+ * 
+ * Revision 4.0.1.1  91/04/12  09:15:30  lwall
+ * patch1: fixed undefined environ problem
+ * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment
+ * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo
+ * 
+ * Revision 4.0  91/03/20  01:39:55  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void ucase();
+static void lcase();
+
+#ifndef str_get
+char *
+str_get(str)
+STR *str;
+{
+#ifdef TAINT
+    tainted |= str->str_tainted;
+#endif
+    return str->str_pok ? str->str_ptr : str_2ptr(str);
+}
+#endif
+
+/* dlb ... guess we have a "crippled cc".
+ * dlb the following functions are usually macros.
+ */
+#ifndef str_true
+int
+str_true(Str)
+STR *Str;
+{
+	if (Str->str_pok) {
+	    if (*Str->str_ptr > '0' ||
+	      Str->str_cur > 1 ||
+	      (Str->str_cur && *Str->str_ptr != '0'))
+		return 1;
+	    return 0;
+	}
+	if (Str->str_nok)
+		return (Str->str_u.str_nval != 0.0);
+	return 0;
+}
+#endif /* str_true */
+
+#ifndef str_gnum
+double str_gnum(Str)
+STR *Str;
+{
+#ifdef TAINT
+	tainted |= Str->str_tainted;
+#endif /* TAINT*/
+	if (Str->str_nok)
+		return Str->str_u.str_nval;
+	return str_2num(Str);
+}
+#endif /* str_gnum */
+/* dlb ... end of crutch */
+
+char *
+str_grow(str,newlen)
+register STR *str;
+#ifndef DOSISH
+register int newlen;
+#else
+unsigned long newlen;
+#endif
+{
+    register char *s = str->str_ptr;
+
+#ifdef MSDOS
+    if (newlen >= 0x10000) {
+	fprintf(stderr, "Allocation too large: %lx\n", newlen);
+	exit(1);
+    }
+#endif /* MSDOS */
+    if (str->str_state == SS_INCR) {		/* data before str_ptr? */
+	str->str_len += str->str_u.str_useful;
+	str->str_ptr -= str->str_u.str_useful;
+	str->str_u.str_useful = 0L;
+	Move(s, str->str_ptr, str->str_cur+1, char);
+	s = str->str_ptr;
+	str->str_state = SS_NORM;			/* normal again */
+	if (newlen > str->str_len)
+	    newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
+    }
+    if (newlen > str->str_len) {		/* need more room? */
+        if (str->str_len)
+	    Renew(s,newlen,char);
+        else
+	    New(703,s,newlen,char);
+	str->str_ptr = s;
+        str->str_len = newlen;
+    }
+    return s;
+}
+
+void
+str_numset(str,num)
+register STR *str;
+double num;
+{
+    if (str->str_pok) {
+	str->str_pok = 0;	/* invalidate pointer */
+	if (str->str_state == SS_INCR)
+	    Str_Grow(str,0);
+    }
+    str->str_u.str_nval = num;
+    str->str_state = SS_NORM;
+    str->str_nok = 1;			/* validate number */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+char *
+str_2ptr(str)
+register STR *str;
+{
+    register char *s;
+    int olderrno;
+
+    if (!str)
+	return "";
+    if (str->str_nok) {
+	STR_GROW(str, 30);
+	s = str->str_ptr;
+	olderrno = errno;	/* some Xenix systems wipe out errno here */
+#if defined(scs) && defined(ns32000)
+	gcvt(str->str_u.str_nval,20,s);
+#else
+#ifdef apollo
+	if (str->str_u.str_nval == 0.0)
+	    (void)strcpy(s,"0");
+	else
+#endif /*apollo*/
+	(void)sprintf(s,"%.20g",str->str_u.str_nval);
+#endif /*scs*/
+	errno = olderrno;
+	while (*s) s++;
+#ifdef hcx
+	if (s[-1] == '.')
+	    s--;
+#endif
+    }
+    else {
+	if (str == &str_undef)
+	    return No;
+	if (dowarn)
+	    warn("Use of uninitialized variable");
+	STR_GROW(str, 30);
+	s = str->str_ptr;
+    }
+    *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_state == SS_INCR)
+	Str_Grow(str,0);       /* just force copy down */
+    str->str_state = SS_NORM;
+    if (str->str_len && str->str_pok)
+	str->str_u.str_nval = atof(str->str_ptr);
+    else  {
+	if (str == &str_undef)
+	    return 0.0;
+	if (dowarn)
+	    warn("Use of uninitialized variable");
+	str->str_u.str_nval = 0.0;
+    }
+    str->str_nok = 1;
+#ifdef DEBUGGING
+    if (debug & 32)
+	fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
+#endif
+    return str->str_u.str_nval;
+}
+
+/* Note: str_sset() should not be called with a source string that needs
+ * be reused, since it may destroy the source string if it is marked
+ * as temporary.
+ */
+
+void
+str_sset(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+#ifdef TAINT
+    if (sstr)
+	tainted |= sstr->str_tainted;
+#endif
+    if (sstr == dstr || dstr == &str_undef)
+	return;
+    if (!sstr)
+	dstr->str_pok = dstr->str_nok = 0;
+    else if (sstr->str_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 dstr->str_ptr
+	 * has to be allocated and sstr->str_ptr has to be freed.
+	 */
+
+	if (sstr->str_pok & SP_TEMP) {		/* slated for free anyway? */
+	    if (dstr->str_ptr) {
+		if (dstr->str_state == SS_INCR)
+		    dstr->str_ptr -= dstr->str_u.str_useful;
+		Safefree(dstr->str_ptr);
+	    }
+	    dstr->str_ptr = sstr->str_ptr;
+	    dstr->str_len = sstr->str_len;
+	    dstr->str_cur = sstr->str_cur;
+	    dstr->str_state = sstr->str_state;
+	    dstr->str_pok = sstr->str_pok & ~SP_TEMP;
+#ifdef TAINT
+	    dstr->str_tainted = sstr->str_tainted;
+#endif
+	    sstr->str_ptr = Nullch;
+	    sstr->str_len = 0;
+	    sstr->str_pok = 0;			/* wipe out any weird flags */
+	    sstr->str_state = 0;		/* so sstr frees uneventfully */
+	}
+	else {					/* have to copy actual string */
+	    if (dstr->str_ptr) {
+		if (dstr->str_state == SS_INCR) {
+			Str_Grow(dstr,0);
+		}
+	    }
+	    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+	}
+	/*SUPPRESS 560*/
+	if (dstr->str_nok = sstr->str_nok)
+	    dstr->str_u.str_nval = sstr->str_u.str_nval;
+	else {
+#ifdef STRUCTCOPY
+	    dstr->str_u = sstr->str_u;
+#else
+	    dstr->str_u.str_nval = sstr->str_u.str_nval;
+#endif
+	    if (dstr->str_cur == sizeof(STBP)) {
+		char *tmps = dstr->str_ptr;
+
+		if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
+		    if (dstr->str_magic && dstr->str_magic->str_rare == 'X') {
+			str_free(dstr->str_magic);
+			dstr->str_magic = Nullstr;
+		    }
+		    if (!dstr->str_magic) {
+			dstr->str_magic = str_smake(sstr->str_magic);
+			dstr->str_magic->str_rare = 'X';
+		    }
+		}
+	    }
+	}
+    }
+    else if (sstr->str_nok)
+	str_numset(dstr,sstr->str_u.str_nval);
+    else {
+	if (dstr->str_state == SS_INCR)
+	    Str_Grow(dstr,0);       /* just force copy down */
+
+#ifdef STRUCTCOPY
+	dstr->str_u = sstr->str_u;
+#else
+	dstr->str_u.str_nval = sstr->str_u.str_nval;
+#endif
+	dstr->str_pok = dstr->str_nok = 0;
+    }
+}
+
+void
+str_nset(str,ptr,len)
+register STR *str;
+register char *ptr;
+register STRLEN len;
+{
+    if (str == &str_undef)
+	return;
+    STR_GROW(str, len + 1);
+    if (ptr)
+	Move(ptr,str->str_ptr,len,char);
+    str->str_cur = len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+void
+str_set(str,ptr)
+register STR *str;
+register char *ptr;
+{
+    register STRLEN len;
+
+    if (str == &str_undef)
+	return;
+    if (!ptr)
+	ptr = "";
+    len = strlen(ptr);
+    STR_GROW(str, len + 1);
+    Move(ptr,str->str_ptr,len+1,char);
+    str->str_cur = len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted = tainted;
+#endif
+}
+
+void
+str_chop(str,ptr)	/* like set but assuming ptr is in str */
+register STR *str;
+register char *ptr;
+{
+    register STRLEN delta;
+
+    if (!ptr || !(str->str_pok))
+	return;
+    delta = ptr - str->str_ptr;
+    str->str_len -= delta;
+    str->str_cur -= delta;
+    str->str_ptr += delta;
+    if (str->str_state == SS_INCR)
+	str->str_u.str_useful += delta;
+    else {
+	str->str_u.str_useful = delta;
+	str->str_state = SS_INCR;
+    }
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer (and unstudy str) */
+}
+
+void
+str_ncat(str,ptr,len)
+register STR *str;
+register char *ptr;
+register STRLEN len;
+{
+    if (str == &str_undef)
+	return;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    STR_GROW(str, str->str_cur + len + 1);
+    Move(ptr,str->str_ptr+str->str_cur,len,char);
+    str->str_cur += len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted |= tainted;
+#endif
+}
+
+void
+str_scat(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+    if (!sstr)
+	return;
+#ifdef TAINT
+    tainted |= sstr->str_tainted;
+#endif
+    if (!(sstr->str_pok))
+	(void)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 STRLEN len;
+
+    if (str == &str_undef)
+	return;
+    if (!ptr)
+	return;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    len = strlen(ptr);
+    STR_GROW(str, str->str_cur + len + 1);
+    Move(ptr,str->str_ptr+str->str_cur,len+1,char);
+    str->str_cur += len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+#ifdef TAINT
+    str->str_tainted |= tainted;
+#endif
+}
+
+char *
+str_append_till(str,from,fromend,delim,keeplist)
+register STR *str;
+register char *from;
+register char *fromend;
+register int delim;
+char *keeplist;
+{
+    register char *to;
+    register STRLEN len;
+
+    if (str == &str_undef)
+	return Nullch;
+    if (!from)
+	return Nullch;
+    len = fromend - from;
+    STR_GROW(str, 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 < fromend; from++,to++) {
+	if (*from == '\\' && from+1 < fromend && delim != '\\') {
+	    if (!keeplist) {
+		if (from[1] == delim || from[1] == '\\')
+		    from++;
+		else
+		    *to++ = *from++;
+	    }
+	    else if (from[1] && index(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 *
+#ifdef LEAKTEST
+str_new(x,len)
+int x;
+#else
+str_new(len)
+#endif
+STRLEN len;
+{
+    register STR *str;
+    
+    if (freestrroot) {
+	str = freestrroot;
+	freestrroot = str->str_magic;
+	str->str_magic = Nullstr;
+	str->str_state = SS_NORM;
+    }
+    else {
+	Newz(700+x,str,1,STR);
+    }
+    if (len)
+	STR_GROW(str, len + 1);
+    return str;
+}
+
+void
+str_magic(str, stab, how, name, namlen)
+register STR *str;
+STAB *stab;
+int how;
+char *name;
+STRLEN namlen;
+{
+    if (str == &str_undef || str->str_magic)
+	return;
+    str->str_magic = Str_new(75,namlen);
+    str = str->str_magic;
+    str->str_u.str_stab = stab;
+    str->str_rare = how;
+    if (name)
+	str_nset(str,name,namlen);
+}
+
+void
+str_insert(bigstr,offset,len,little,littlelen)
+STR *bigstr;
+STRLEN offset;
+STRLEN len;
+char *little;
+STRLEN littlelen;
+{
+    register char *big;
+    register char *mid;
+    register char *midend;
+    register char *bigend;
+    register int i;
+
+    if (bigstr == &str_undef)
+	return;
+    bigstr->str_nok = 0;
+    bigstr->str_pok = SP_VALID;	/* disable possible screamer */
+
+    i = littlelen - len;
+    if (i > 0) {			/* string might grow */
+	STR_GROW(bigstr, bigstr->str_cur + i + 1);
+	big = bigstr->str_ptr;
+	mid = big + offset + len;
+	midend = bigend = big + bigstr->str_cur;
+	bigend += i;
+	*bigend = '\0';
+	while (midend > mid)		/* shove everything down */
+	    *--bigend = *--midend;
+	Move(little,big+offset,littlelen,char);
+	bigstr->str_cur += i;
+	STABSET(bigstr);
+	return;
+    }
+    else if (i == 0) {
+	Move(little,bigstr->str_ptr+offset,len,char);
+	STABSET(bigstr);
+	return;
+    }
+
+    big = bigstr->str_ptr;
+    mid = big + offset;
+    midend = mid + len;
+    bigend = big + bigstr->str_cur;
+
+    if (midend > bigend)
+	fatal("panic: str_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';
+	bigstr->str_cur = mid - big;
+    }
+    /*SUPPRESS 560*/
+    else if (i = mid - big) {	/* faster from front */
+	midend -= littlelen;
+	mid = midend;
+	str_chop(bigstr,midend-i);
+	big += i;
+	while (i--)
+	    *--midend = *--big;
+	if (littlelen)
+	    Move(little, mid, littlelen,char);
+    }
+    else if (littlelen) {
+	midend -= littlelen;
+	str_chop(bigstr,midend);
+	Move(little,midend,littlelen,char);
+    }
+    else {
+	str_chop(bigstr,midend);
+    }
+    STABSET(bigstr);
+}
+
+/* make str point to what nstr did */
+
+void
+str_replace(str,nstr)
+register STR *str;
+register STR *nstr;
+{
+    if (str == &str_undef)
+	return;
+    if (str->str_state == SS_INCR)
+	Str_Grow(str,0);	/* just force copy down */
+    if (nstr->str_state == SS_INCR)
+	Str_Grow(nstr,0);
+    if (str->str_ptr)
+	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;
+    str->str_nok = nstr->str_nok;
+#ifdef STRUCTCOPY
+    str->str_u = nstr->str_u;
+#else
+    str->str_u.str_nval = nstr->str_u.str_nval;
+#endif
+#ifdef TAINT
+    str->str_tainted = nstr->str_tainted;
+#endif
+    if (nstr->str_magic)
+	str_free(nstr->str_magic);
+    Safefree(nstr);
+}
+
+void
+str_free(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_state) {
+	if (str->str_state == SS_FREE)	/* already freed */
+	    return;
+	if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
+	    str->str_ptr -= str->str_u.str_useful;
+	    str->str_len += str->str_u.str_useful;
+	}
+    }
+    if (str->str_magic)
+	str_free(str->str_magic);
+    str->str_magic = freestrroot;
+#ifdef LEAKTEST
+    if (str->str_len) {
+	Safefree(str->str_ptr);
+	str->str_ptr = Nullch;
+    }
+    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
+	arg_free(str->str_u.str_args);
+    Safefree(str);
+#else /* LEAKTEST */
+    if (str->str_len) {
+	if (str->str_len > 127) {	/* next user not likely to want more */
+	    Safefree(str->str_ptr);	/* so give it back to malloc */
+	    str->str_ptr = Nullch;
+	    str->str_len = 0;
+	}
+	else
+	    str->str_ptr[0] = '\0';
+    }
+    if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
+	arg_free(str->str_u.str_args);
+    str->str_cur = 0;
+    str->str_nok = 0;
+    str->str_pok = 0;
+    str->str_state = SS_FREE;
+#ifdef TAINT
+    str->str_tainted = 0;
+#endif
+    freestrroot = str;
+#endif /* LEAKTEST */
+}
+
+STRLEN
+str_len(str)
+register STR *str;
+{
+    if (!str)
+	return 0;
+    if (!(str->str_pok))
+	(void)str_2ptr(str);
+    if (str->str_ptr)
+	return str->str_cur;
+    else
+	return 0;
+}
+
+int
+str_eq(str1,str2)
+register STR *str1;
+register STR *str2;
+{
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur);
+    if (!str2 || str2 == &str_undef)
+	return !str1->str_cur;
+
+    if (!str1->str_pok)
+	(void)str_2ptr(str1);
+    if (!str2->str_pok)
+	(void)str_2ptr(str2);
+
+    if (str1->str_cur != str2->str_cur)
+	return 0;
+
+    return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
+}
+
+int
+str_cmp(str1,str2)
+register STR *str1;
+register STR *str2;
+{
+    int retval;
+
+    if (!str1 || str1 == &str_undef)
+	return (str2 == Nullstr || str2 == &str_undef || !str2->str_cur)?0:-1;
+    if (!str2 || str2 == &str_undef)
+	return str1->str_cur != 0;
+
+    if (!str1->str_pok)
+	(void)str_2ptr(str1);
+    if (!str2->str_pok)
+	(void)str_2ptr(str2);
+
+    if (str1->str_cur < str2->str_cur) {
+	/*SUPPRESS 560*/
+	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
+	    return retval < 0 ? -1 : 1;
+	else
+	    return -1;
+    }
+    /*SUPPRESS 560*/
+    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
+	return retval < 0 ? -1 : 1;
+    else if (str1->str_cur == str2->str_cur)
+	return 0;
+    else
+	return 1;
+}
+
+char *
+str_gets(str,fp,append)
+register STR *str;
+register FILE *fp;
+int append;
+{
+    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 int newline = rschar;/* (assuming >= 6 registers) */
+    int i;
+    STRLEN bpx;
+    int shortbuffered;
+
+    if (str == &str_undef)
+	return Nullch;
+    if (rspara) {		/* have to do this both before and after */
+	do {			/* to make sure file boundaries work right */
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	} while (i != EOF);
+    }
+#ifdef STDSTDIO		/* Here is some breathtakingly efficient cheating */
+    cnt = fp->_cnt;			/* get count into register */
+    str->str_nok = 0;			/* invalidate number */
+    str->str_pok = 1;			/* validate pointer */
+    if (str->str_len - append <= cnt + 1) { /* make sure we have the room */
+	if (cnt > 80 && str->str_len > append) {
+	    shortbuffered = cnt - str->str_len + append + 1;
+	    cnt -= shortbuffered;
+	}
+	else {
+	    shortbuffered = 0;
+	    STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
+	}
+    }
+    else
+	shortbuffered = 0;
+    bp = str->str_ptr + append;		/* move these two too to registers */
+    ptr = fp->_ptr;
+    for (;;) {
+      screamer:
+	while (--cnt >= 0) {			/* this */	/* eat */
+	    if ((*bp++ = *ptr++) == newline)	/* really */	/* dust */
+		goto thats_all_folks;		/* screams */	/* sed :-) */ 
+	}
+	
+	if (shortbuffered) {			/* oh well, must extend */
+	    cnt = shortbuffered;
+	    shortbuffered = 0;
+	    bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	    str->str_cur = bpx;
+	    STR_GROW(str, str->str_len + append + cnt + 2);
+	    bp = str->str_ptr + bpx;	/* reconstitute our pointer */
+	    continue;
+	}
+
+	fp->_cnt = cnt;			/* deregisterize cnt and ptr */
+	fp->_ptr = ptr;
+	i = _filbuf(fp);		/* get more characters */
+	cnt = fp->_cnt;
+	ptr = fp->_ptr;			/* reregisterize cnt and ptr */
+
+	bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	str->str_cur = bpx;
+	STR_GROW(str, bpx + cnt + 2);
+	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_really_all_folks;
+	*bp++ = i;			/* now go back to screaming loop */
+    }
+
+thats_all_folks:
+    if (rslen > 1 && (bp - str->str_ptr < rslen || bcmp(bp - rslen, rs, rslen)))
+	goto screamer;	/* go back to the fray */
+thats_really_all_folks:
+    if (shortbuffered)
+	cnt += shortbuffered;
+    fp->_cnt = cnt;			/* put these back or we're in trouble */
+    fp->_ptr = ptr;
+    *bp = '\0';
+    str->str_cur = bp - str->str_ptr;	/* set length */
+
+#else /* !STDSTDIO */	/* The big, slow, and stupid way */
+
+    {
+	static char buf[8192];
+	char * bpe = buf + sizeof(buf) - 3;
+
+screamer:
+	bp = buf;
+	while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
+
+	if (append)
+	    str_ncat(str, buf, bp - buf);
+	else
+	    str_nset(str, buf, bp - buf);
+	if (i != EOF			/* joy */
+	    &&
+	    (i != newline
+	     ||
+	     (rslen > 1
+	      &&
+	      (str->str_cur < rslen
+	       ||
+	       bcmp(str->str_ptr + str->str_cur - rslen, rs, rslen)
+	      )
+	     )
+	    )
+	   )
+	{
+	    append = -1;
+	    goto screamer;
+	}
+    }
+
+#endif /* STDSTDIO */
+
+    if (rspara) {
+        while (i != EOF) {
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	}
+    }
+    return str->str_cur - append ? str->str_ptr : Nullch;
+}
+
+ARG *
+parselist(str)
+STR *str;
+{
+    register CMD *cmd;
+    register ARG *arg;
+    CMD *oldcurcmd = curcmd;
+    int oldperldb = perldb;
+    int retval;
+
+    perldb = 0;
+    str_sset(linestr,str);
+    in_eval++;
+    oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
+    bufend = bufptr + linestr->str_cur;
+    if (++loop_ptr >= loop_max) {
+        loop_max += 128;
+        Renew(loop_stack, loop_max, struct loop);
+    }
+    loop_stack[loop_ptr].loop_label = "_EVAL_";
+    loop_stack[loop_ptr].loop_sp = 0;
+#ifdef DEBUGGING
+    if (debug & 4) {
+        deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+    }
+#endif
+    if (setjmp(loop_stack[loop_ptr].loop_env)) {
+	in_eval--;
+	loop_ptr--;
+	perldb = oldperldb;
+	fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
+    }
+#ifdef DEBUGGING
+    if (debug & 4) {
+	char *tmps = loop_stack[loop_ptr].loop_label;
+	deb("(Popping label #%d %s)\n",loop_ptr,
+	    tmps ? tmps : "" );
+    }
+#endif
+    loop_ptr--;
+    error_count = 0;
+    curcmd = &compiling;
+    curcmd->c_line = oldcurcmd->c_line;
+    retval = yyparse();
+    curcmd = oldcurcmd;
+    perldb = oldperldb;
+    in_eval--;
+    if (retval || error_count)
+	fatal("Invalid component in string or format");
+    cmd = eval_root;
+    arg = cmd->c_expr;
+    if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
+	fatal("panic: error in parselist %d %x %d", cmd->c_type,
+	  cmd->c_next, arg ? arg->arg_type : -1);
+    cmd->c_expr = Nullarg;
+    cmd_free(cmd);
+    eval_root = Nullcmd;
+    return arg;
+}
+
+void
+intrpcompile(src)
+STR *src;
+{
+    register char *s = str_get(src);
+    register char *send = s + src->str_cur;
+    register STR *str;
+    register char *t;
+    STR *toparse;
+    STRLEN len;
+    register int brackets;
+    register char *d;
+    STAB *stab;
+    char *checkpoint;
+    int sawcase = 0;
+
+    toparse = Str_new(76,0);
+    str = Str_new(77,0);
+
+    str_nset(str,"",0);
+    str_nset(toparse,"",0);
+    t = s;
+    while (s < send) {
+	if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) {
+	    str_ncat(str, t, s - t);
+	    ++s;
+	    if (isALPHA(*s)) {
+		str_ncat(str, "$c", 2);
+		sawcase = (*s != 'E');
+	    }
+	    else {
+		if (*nointrp) {		/* in a regular expression */
+		    if (*s == '@')	/* always strip \@ */ /*SUPPRESS 530*/
+			;
+		    else		/* don't strip \\, \[, \{ etc. */
+			str_ncat(str,s-1,1);
+		}
+		str_ncat(str, "$b", 2);
+	    }
+	    str_ncat(str, s, 1);
+	    ++s;
+	    t = s;
+	}
+	else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) {
+	    str_ncat(str, t, s - t);
+	    str_ncat(str, "$b", 2);
+	    str_ncat(str, s, 2);
+	    s += 2;
+	    t = s;
+	}
+	else if ((*s == '@' || *s == '$') && s+1 < send) {
+	    str_ncat(str,t,s-t);
+	    t = s;
+	    if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+		s++;
+	    s = scanident(s,send,tokenbuf);
+	    if (*t == '@' &&
+	      (!(stab = stabent(tokenbuf,FALSE)) || 
+		 (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
+		str_ncat(str,"@",1);
+		s = ++t;
+		continue;	/* grandfather @ from old scripts */
+	    }
+	    str_ncat(str,"$a",2);
+	    str_ncat(toparse,",",1);
+	    if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
+	      (stab = stabent(tokenbuf,FALSE)) &&
+	      ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
+		brackets = 0;
+		checkpoint = s;
+		do {
+		    switch (*s) {
+		    case '[':
+			brackets++;
+			break;
+		    case '{':
+			brackets++;
+			break;
+		    case ']':
+			brackets--;
+			break;
+		    case '}':
+			brackets--;
+			break;
+		    case '$':
+		    case '%':
+		    case '@':
+		    case '&':
+		    case '*':
+			s = scanident(s,send,tokenbuf);
+			continue;
+		    case '\'':
+		    case '"':
+			/*SUPPRESS 68*/
+			s = cpytill(tokenbuf,s+1,send,*s,&len);
+			if (s >= send)
+			    fatal("Unterminated string");
+			break;
+		    }
+		    s++;
+		} while (brackets > 0 && s < send);
+		if (s > send)
+		    fatal("Unmatched brackets in string");
+		if (*nointrp) {		/* we're in a regular expression */
+		    d = checkpoint;
+		    if (*d == '{' && s[-1] == '}') {	/* maybe {n,m} */
+			++d;
+			if (isDIGIT(*d)) {	/* matches /^{\d,?\d*}$/ */
+			    if (*++d == ',')
+				++d;
+			    while (isDIGIT(*d))
+				d++;
+			    if (d == s - 1)
+				s = checkpoint;		/* Is {n,m}! Backoff! */
+			}
+		    }
+		    else if (*d == '[' && s[-1] == ']') { /* char class? */
+			int weight = 2;		/* let's weigh the evidence */
+			char seen[256];
+			unsigned char un_char = 0, last_un_char;
+
+			Zero(seen,256,char);
+			*--s = '\0';
+			if (d[1] == '^')
+			    weight += 150;
+			else if (d[1] == '$')
+			    weight -= 3;
+			if (isDIGIT(d[1])) {
+			    if (d[2]) {
+				if (isDIGIT(d[2]) && !d[3])
+				    weight -= 10;
+			    }
+			    else
+				weight -= 100;
+			}
+			for (d++; d < s; d++) {
+			    last_un_char = un_char;
+			    un_char = (unsigned char)*d;
+			    switch (*d) {
+			    case '&':
+			    case '$':
+				weight -= seen[un_char] * 10;
+				if (isALNUM(d[1])) {
+				    d = scanident(d,s,tokenbuf);
+				    if (stabent(tokenbuf,FALSE))
+					weight -= 100;
+				    else
+					weight -= 10;
+				}
+				else if (*d == '$' && d[1] &&
+				  index("[#!%*<>()-=",d[1])) {
+				    if (!d[2] || /*{*/ index("])} =",d[2]))
+					weight -= 10;
+				    else
+					weight -= 1;
+				}
+				break;
+			    case '\\':
+				un_char = 254;
+				if (d[1]) {
+				    if (index("wds",d[1]))
+					weight += 100;
+				    else if (seen['\''] || seen['"'])
+					weight += 1;
+				    else if (index("rnftb",d[1]))
+					weight += 40;
+				    else if (isDIGIT(d[1])) {
+					weight += 40;
+					while (d[1] && isDIGIT(d[1]))
+					    d++;
+				    }
+				}
+				else
+				    weight += 100;
+				break;
+			    case '-':
+				if (last_un_char < (unsigned char) d[1]
+				  || d[1] == '\\') {
+				    if (index("aA01! ",last_un_char))
+					weight += 30;
+				    if (index("zZ79~",d[1]))
+					weight += 30;
+				}
+				else
+				    weight -= 1;
+			    default:
+				if (isALPHA(*d) && d[1] && isALPHA(d[1])) {
+				    bufptr = d;
+				    if (yylex() != WORD)
+					weight -= 150;
+				    d = bufptr;
+				}
+				if (un_char == last_un_char + 1)
+				    weight += 5;
+				weight -= seen[un_char];
+				break;
+			    }
+			    seen[un_char]++;
+			}
+#ifdef DEBUGGING
+			if (debug & 512)
+			    fprintf(stderr,"[%s] weight %d\n",
+			      checkpoint+1,weight);
+#endif
+			*s++ = ']';
+			if (weight >= 0)	/* probably a character class */
+			    s = checkpoint;
+		    }
+		}
+	    }
+	    if (*t == '@')
+		str_ncat(toparse, "join($\",", 8);
+	    if (t[1] == '{' && s[-1] == '}') {
+		str_ncat(toparse, t, 1);
+		str_ncat(toparse, t+2, s - t - 3);
+	    }
+	    else
+		str_ncat(toparse, t, s - t);
+	    if (*t == '@')
+		str_ncat(toparse, ")", 1);
+	    t = s;
+	}
+	else
+	    s++;
+    }
+    str_ncat(str,t,s-t);
+    if (sawcase)
+	str_ncat(str, "$cE", 3);
+    if (toparse->str_ptr && *toparse->str_ptr == ',') {
+	*toparse->str_ptr = '(';
+	str_ncat(toparse,",$$);",5);
+	str->str_u.str_args = parselist(toparse);
+	str->str_u.str_args->arg_len--;		/* ignore $$ reference */
+    }
+    else
+	str->str_u.str_args = Nullarg;
+    str_free(toparse);
+    str->str_pok |= SP_INTRP;
+    str->str_nok = 0;
+    str_replace(src,str);
+}
+
+STR *
+interp(str,src,sp)
+register STR *str;
+STR *src;
+int sp;
+{
+    register char *s;
+    register char *t;
+    register char *send;
+    register STR **elem;
+    int docase = 0;
+    int l = 0;
+    int u = 0;
+    int L = 0;
+    int U = 0;
+
+    if (str == &str_undef)
+	return Nullstr;
+    if (!(src->str_pok & SP_INTRP)) {
+	int oldsave = savestack->ary_fill;
+
+	(void)savehptr(&curstash);
+	curstash = curcmd->c_stash;	/* so stabent knows right package */
+	intrpcompile(src);
+	restorelist(oldsave);
+    }
+    s = src->str_ptr;		/* assumed valid since str_pok set */
+    t = s;
+    send = s + src->str_cur;
+
+    if (src->str_u.str_args) {
+	(void)eval(src->str_u.str_args,G_ARRAY,sp);
+	/* Assuming we have correct # of args */
+	elem = stack->ary_array + sp;
+    }
+
+    str_nset(str,"",0);
+    while (s < send) {
+	if (*s == '$' && s+1 < send) {
+	    if (s-t > 0)
+		str_ncat(str,t,s-t);
+	    switch(*++s) {
+	    default:
+		fatal("panic: unknown interp cookie\n");
+		break;
+	    case 'a':
+		str_scat(str,*++elem);
+		break;
+	    case 'b':
+		str_ncat(str,++s,1);
+		break;
+	    case 'c':
+		if (docase && str->str_cur >= docase) {
+		    char *b = str->str_ptr + --docase;
+
+		    if (L)
+			lcase(b, str->str_ptr + str->str_cur);
+		    else if (U)
+			ucase(b, str->str_ptr + str->str_cur);
+
+		    if (u)	/* note that l & u are independent of L & U */
+			ucase(b, b+1);
+		    else if (l)
+			lcase(b, b+1);
+		    l = u = 0;
+		}
+		docase = str->str_cur + 1;
+		switch (*++s) {
+		case 'u':
+		    u = 1;
+		    l = 0;
+		    break;
+		case 'U':
+		    U = 1;
+		    L = 0;
+		    break;
+		case 'l':
+		    l = 1;
+		    u = 0;
+		    break;
+		case 'L':
+		    L = 1;
+		    U = 0;
+		    break;
+		case 'E':
+		    docase = L = U = l = u = 0;
+		    break;
+		}
+		break;
+	    }
+	    t = ++s;
+	}
+	else
+	    s++;
+    }
+    if (s-t > 0)
+	str_ncat(str,t,s-t);
+    return str;
+}
+
+static void
+ucase(s,send)
+register char *s;
+register char *send;
+{
+    while (s < send) {
+	if (isLOWER(*s))
+	    *s = toupper(*s);
+	s++;
+    }
+}
+
+static void
+lcase(s,send)
+register char *s;
+register char *send;
+{
+    while (s < send) {
+	if (isUPPER(*s))
+	    *s = tolower(*s);
+	s++;
+    }
+}
+
+void
+str_inc(str)
+register STR *str;
+{
+    register char *d;
+
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_nok) {
+	str->str_u.str_nval += 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok || !*str->str_ptr) {
+	str->str_u.str_nval = 1.0;
+	str->str_nok = 1;
+	str->str_pok = 0;
+	return;
+    }
+    d = str->str_ptr;
+    while (isALPHA(*d)) d++;
+    while (isDIGIT(*d)) d++;
+    if (*d) {
+        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
+	return;
+    }
+    d--;
+    while (d >= str->str_ptr) {
+	if (isDIGIT(*d)) {
+	    if (++*d <= '9')
+		return;
+	    *(d--) = '0';
+	}
+	else {
+	    ++*d;
+	    if (isALPHA(*d))
+		return;
+	    *(d--) -= 'z' - 'a' + 1;
+	}
+    }
+    /* oh,oh, the number grew */
+    STR_GROW(str, str->str_cur + 2);
+    str->str_cur++;
+    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
+	*d = d[-1];
+    if (isDIGIT(d[1]))
+	*d = '1';
+    else
+	*d = d[1];
+}
+
+void
+str_dec(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return;
+    if (str->str_nok) {
+	str->str_u.str_nval -= 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok) {
+	str->str_u.str_nval = -1.0;
+	str->str_nok = 1;
+	return;
+    }
+    str_numset(str,atof(str->str_ptr) - 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 cmd_exec won't free it until it has been assigned to a
+ * permanent location. */
+
+static long tmps_size = -1;
+
+STR *
+str_mortal(oldstr)
+STR *oldstr;
+{
+    register STR *str = Str_new(78,0);
+
+    str_sset(str,oldstr);
+    if (++tmps_max > tmps_size) {
+	tmps_size = tmps_max;
+	if (!(tmps_size & 127)) {
+	    if (tmps_size)
+		Renew(tmps_list, tmps_size + 128, STR*);
+	    else
+		New(702,tmps_list, 128, STR*);
+	}
+    }
+    tmps_list[tmps_max] = str;
+    if (str->str_pok)
+	str->str_pok |= SP_TEMP;
+    return str;
+}
+
+/* same thing without the copying */
+
+STR *
+str_2mortal(str)
+register STR *str;
+{
+    if (!str || str == &str_undef)
+	return str;
+    if (++tmps_max > tmps_size) {
+	tmps_size = tmps_max;
+	if (!(tmps_size & 127)) {
+	    if (tmps_size)
+		Renew(tmps_list, tmps_size + 128, STR*);
+	    else
+		New(704,tmps_list, 128, STR*);
+	}
+    }
+    tmps_list[tmps_max] = str;
+    if (str->str_pok)
+	str->str_pok |= SP_TEMP;
+    return str;
+}
+
+STR *
+str_make(s,len)
+char *s;
+STRLEN len;
+{
+    register STR *str = Str_new(79,0);
+
+    if (!len)
+	len = strlen(s);
+    str_nset(str,s,len);
+    return str;
+}
+
+STR *
+str_nmake(n)
+double n;
+{
+    register STR *str = Str_new(80,0);
+
+    str_numset(str,n);
+    return str;
+}
+
+/* make an exact duplicate of old */
+
+STR *
+str_smake(old)
+register STR *old;
+{
+    register STR *new = Str_new(81,0);
+
+    if (!old)
+	return Nullstr;
+    if (old->str_state == SS_FREE) {
+	warn("semi-panic: attempt to dup freed string");
+	return Nullstr;
+    }
+    if (old->str_state == SS_INCR && !(old->str_pok & 2))
+	Str_Grow(old,0);
+    if (new->str_ptr)
+	Safefree(new->str_ptr);
+    StructCopy(old,new,STR);
+    if (old->str_ptr) {
+	new->str_ptr = nsavestr(old->str_ptr,old->str_len);
+	new->str_pok &= ~SP_TEMP;
+    }
+    return new;
+}
+
+void
+str_reset(s,stash)
+register char *s;
+HASH *stash;
+{
+    register HENT *entry;
+    register STAB *stab;
+    register STR *str;
+    register int i;
+    register SPAT *spat;
+    register int max;
+
+    if (!*s) {		/* reset ?? searches */
+	for (spat = stash->tbl_spatroot;
+	  spat != Nullspat;
+	  spat = spat->spat_next) {
+	    spat->spat_flags &= ~SPAT_USED;
+	}
+	return;
+    }
+
+    /* reset variables */
+
+    if (!stash->tbl_array)
+	return;
+    while (*s) {
+	i = *s;
+	if (s[1] == '-') {
+	    s += 2;
+	}
+	max = *s++;
+	for ( ; i <= max; i++) {
+	    for (entry = stash->tbl_array[i];
+	      entry;
+	      entry = entry->hent_next) {
+		stab = (STAB*)entry->hent_val;
+		str = stab_val(stab);
+		str->str_cur = 0;
+		str->str_nok = 0;
+#ifdef TAINT
+		str->str_tainted = tainted;
+#endif
+		if (str->str_ptr != Nullch)
+		    str->str_ptr[0] = '\0';
+		if (stab_xarray(stab)) {
+		    aclear(stab_xarray(stab));
+		}
+		if (stab_xhash(stab)) {
+		    hclear(stab_xhash(stab), FALSE);
+		    if (stab == envstab)
+			environ[0] = Nullch;
+		}
+	    }
+	}
+    }
+}
+
+#ifdef TAINT
+void
+taintproper(s)
+char *s;
+{
+#ifdef DEBUGGING
+    if (debug & 2048)
+	fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
+#endif
+    if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) {
+	if (!unsafe)
+	    fatal("%s", s);
+	else if (dowarn)
+	    warn("%s", s);
+    }
+}
+
+void
+taintenv()
+{
+    register STR *envstr;
+
+    envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
+    if (envstr == &str_undef || envstr->str_tainted) {
+	tainted = 1;
+	if (envstr->str_tainted == 2)
+	    taintproper("Insecure directory in PATH");
+	else
+	    taintproper("Insecure PATH");
+    }
+    envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
+    if (envstr != &str_undef && envstr->str_tainted) {
+	tainted = 1;
+	taintproper("Insecure IFS");
+    }
+}
+#endif /* TAINT */
diff --git a/gnu/usr.bin/perl/perl/str.h b/gnu/usr.bin/perl/perl/str.h
new file mode 100644
index 000000000000..7eb4b6971717
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/str.h
@@ -0,0 +1,171 @@
+/* $RCSfile: str.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:39 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:39  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  15:41:45  lwall
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: removed implicit int declarations on functions
+ * 
+ * Revision 4.0.1.3  91/11/05  18:41:47  lwall
+ * patch11: random cleanup
+ * patch11: solitary subroutine references no longer trigger typo warnings
+ * 
+ * Revision 4.0.1.2  91/06/07  11:58:33  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0.1.1  91/04/12  09:16:12  lwall
+ * patch1: you may now use "die" and "caller" in a signal handler
+ * 
+ * Revision 4.0  91/03/20  01:40:04  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+struct string {
+    char *	str_ptr;	/* pointer to malloced string */
+    STRLEN	str_len;	/* allocated size */
+    union {
+	double	str_nval;	/* numeric value, if any */
+	long	str_useful;	/* is this search optimization effective? */
+	ARG	*str_args;	/* list of args for interpreted string */
+	HASH	*str_hash;	/* string represents an assoc array (stab?) */
+	ARRAY	*str_array;	/* string represents an array */
+	CMD	*str_cmd;	/* command for this source line */
+	struct {
+	    STAB *stb_stab;	/* magic stab for magic "key" string */
+	    HASH *stb_stash;	/* which symbol table this stab is in */
+	} stb_u;
+    } str_u;
+    STRLEN	str_cur;	/* length of str_ptr as a C string */
+    STR		*str_magic;	/* while free, link to next free str */
+				/* while in use, ptr to "key" for magic items */
+    unsigned char str_pok;	/* state of str_ptr */
+    unsigned char str_nok;	/* state of str_nval */
+    unsigned char str_rare;	/* used by search strings */
+    unsigned char str_state;	/* one of SS_* below */
+				/* also used by search strings for backoff */
+#ifdef TAINT
+    bool	str_tainted;	/* 1 if possibly under control of $< */
+#endif
+};
+
+struct stab {	/* should be identical, except for str_ptr */
+    STBP *	str_ptr;	/* pointer to malloced string */
+    STRLEN	str_len;	/* allocated size */
+    union {
+	double	str_nval;	/* numeric value, if any */
+	long	str_useful;	/* is this search optimization effective? */
+	ARG	*str_args;	/* list of args for interpreted string */
+	HASH	*str_hash;	/* string represents an assoc array (stab?) */
+	ARRAY	*str_array;	/* string represents an array */
+	CMD	*str_cmd;	/* command for this source line */
+	struct {
+	    STAB *stb_stab;	/* magic stab for magic "key" string */
+	    HASH *stb_stash;	/* which symbol table this stab is in */
+	} stb_u;
+    } str_u;
+    STRLEN	str_cur;	/* length of str_ptr as a C string */
+    STR		*str_magic;	/* while free, link to next free str */
+				/* while in use, ptr to "key" for magic items */
+    unsigned char str_pok;	/* state of str_ptr */
+    unsigned char str_nok;	/* state of str_nval */
+    unsigned char str_rare;	/* used by search strings */
+    unsigned char str_state;	/* one of SS_* below */
+				/* also used by search strings for backoff */
+#ifdef TAINT
+    bool	str_tainted;	/* 1 if possibly under control of $< */
+#endif
+};
+
+#define str_stab stb_u.stb_stab
+#define str_stash stb_u.stb_stash
+
+/* some extra info tacked to some lvalue strings */
+
+struct lstring {
+    struct string lstr;
+    STRLEN	lstr_offset;
+    STRLEN	lstr_len;
+};
+
+/* These are the values of str_pok:		*/
+#define SP_VALID	1	/* str_ptr is valid */
+#define SP_FBM		2	/* string was compiled for fbm search */
+#define SP_STUDIED	4	/* string was studied */
+#define SP_CASEFOLD	8	/* case insensitive fbm search */
+#define SP_INTRP	16	/* string was compiled for interping */
+#define SP_TAIL		32	/* fbm string is tail anchored: /foo$/  */
+#define SP_MULTI	64	/* symbol table entry probably isn't a typo */
+#define SP_TEMP		128	/* string slated to die, so can be plundered */
+
+#define Nullstr Null(STR*)
+
+/* These are the values of str_state:		*/
+#define SS_NORM		0	/* normal string */
+#define SS_INCR		1	/* normal string, incremented ptr */
+#define SS_SARY		2	/* array on save stack */
+#define SS_SHASH	3	/* associative array on save stack */
+#define SS_SINT		4	/* integer on save stack */
+#define SS_SLONG	5	/* long on save stack */
+#define SS_SSTRP	6	/* STR* on save stack */
+#define SS_SHPTR	7	/* HASH* on save stack */
+#define SS_SNSTAB	8	/* non-stab on save stack */
+#define SS_SCSV		9	/* callsave structure on save stack */
+#define SS_SAPTR	10	/* ARRAY* on save stack */
+#define SS_HASH		253	/* carrying an hash */
+#define SS_ARY		254	/* carrying an array */
+#define SS_FREE		255	/* in free list */
+/* str_state may have any value 0-255 when used to hold fbm pattern, in which */
+/* case it indicates offset to rarest character in screaminstr key */
+
+/* the following macro updates any magic values this str is associated with */
+
+#ifdef TAINT
+#define STABSET(x) \
+    (x)->str_tainted |= tainted; \
+    if ((x)->str_magic) \
+	stabset((x)->str_magic,(x))
+#else
+#define STABSET(x) \
+    if ((x)->str_magic) \
+	stabset((x)->str_magic,(x))
+#endif
+
+#define STR_SSET(dst,src) if (dst != src) str_sset(dst,src)
+
+EXT STR **tmps_list;
+EXT int tmps_max INIT(-1);
+EXT int tmps_base INIT(-1);
+
+char *str_2ptr();
+double str_2num();
+STR *str_mortal();
+STR *str_2mortal();
+STR *str_make();
+STR *str_nmake();
+STR *str_smake();
+int str_cmp();
+int str_eq();
+void str_magic();
+void str_insert();
+void str_numset();
+void str_sset();
+void str_nset();
+void str_set();
+void str_chop();
+void str_cat();
+void str_scat();
+void str_ncat();
+void str_reset();
+void str_taintproper();
+void str_taintenv();
+STRLEN str_len();
+
+#define MULTI	(3)
diff --git a/gnu/usr.bin/perl/perl/t/README b/gnu/usr.bin/perl/perl/t/README
new file mode 100644
index 000000000000..47ab845193c5
--- /dev/null
+++ b/gnu/usr.bin/perl/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@netlabs.com.
diff --git a/gnu/usr.bin/perl/perl/t/TEST b/gnu/usr.bin/perl/perl/t/TEST
new file mode 100755
index 000000000000..957a868c5cdd
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/TEST
@@ -0,0 +1,102 @@
+#!./perl
+
+# $RCSfile: TEST,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:01 $
+
+# 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';
+
+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;
+    }
+}
+$bad = 0;
+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";
+    } 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 {
+    if ($bad == 1) {
+	die "Failed 1 test.\n";
+    } else {
+	die "Failed $bad tests.\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/perl/t/base/cond.t b/gnu/usr.bin/perl/perl/t/base/cond.t
new file mode 100755
index 000000000000..7d49f4e9b591
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/base/cond.t
@@ -0,0 +1,19 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/base/cond.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+# 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/perl/t/base/if.t b/gnu/usr.bin/perl/perl/t/base/if.t
new file mode 100755
index 000000000000..2a9b82c77e7d
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/base/if.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/base/if.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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/perl/t/base/lex.t b/gnu/usr.bin/perl/perl/t/base/lex.t
new file mode 100755
index 000000000000..cd6321d9f081
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/base/lex.t
@@ -0,0 +1,78 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/base/lex.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+print "1..18\n";
+
+$ # this is the register <space>
+= 'x';
+
+print "#1	:$ : eq :x:\n";
+if ($  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.
diff --git a/gnu/usr.bin/perl/perl/t/base/pat.t b/gnu/usr.bin/perl/perl/t/base/pat.t
new file mode 100755
index 000000000000..2c8d9a9f2b85
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/base/pat.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/base/pat.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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/perl/t/base/term.t b/gnu/usr.bin/perl/perl/t/base/term.t
new file mode 100755
index 000000000000..c049c5872364
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/base/term.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/base/term.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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") || (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, "../Makefile") || (die "Can't open ../Makefile.");
+if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
diff --git a/gnu/usr.bin/perl/perl/t/cmd/elsif.t b/gnu/usr.bin/perl/perl/t/cmd/elsif.t
new file mode 100755
index 000000000000..0e3457f6ad1f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/elsif.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/cmd/elsif.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+sub foo {
+    if ($_[0] == 1) {
+	1;
+    }
+    elsif ($_[0] == 2) {
+	2;
+    }
+    elsif ($_[0] == 3) {
+	3;
+    }
+    else {
+	4;
+    }
+}
+
+print "1..4\n";
+
+if (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";}
+if (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";}
+if (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";}
diff --git a/gnu/usr.bin/perl/perl/t/cmd/for.t b/gnu/usr.bin/perl/perl/t/cmd/for.t
new file mode 100755
index 000000000000..4a0c9226bae8
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/for.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/cmd/for.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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/perl/t/cmd/mod.t b/gnu/usr.bin/perl/perl/t/cmd/mod.t
new file mode 100755
index 000000000000..eeb44d97b5d8
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/mod.t
@@ -0,0 +1,33 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/cmd/mod.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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\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,'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/perl/t/cmd/subval.t b/gnu/usr.bin/perl/perl/t/cmd/subval.t
new file mode 100755
index 000000000000..f7f411b34ab1
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/subval.t
@@ -0,0 +1,179 @@
+#!./perl
+
+# $RCSfile: subval.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:05 $
+
+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 (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
+if (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
+if (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
+
+if (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
+if (do foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
+if (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
+if (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if (do foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
+if (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
+if (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
+if (do 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 {
+    local($arg) = @_;
+    local($foo);
+    $level++;
+    if ($arg <= 2) {
+	$foo = 1;
+    }
+    else {
+	$foo = do fib($arg-1) + do 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 (do 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/perl/t/cmd/switch.t b/gnu/usr.bin/perl/perl/t/cmd/switch.t
new file mode 100755
index 000000000000..d0d4c932ad0d
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/switch.t
@@ -0,0 +1,75 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/cmd/switch.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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 1\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/perl/t/cmd/while.t b/gnu/usr.bin/perl/perl/t/cmd/while.t
new file mode 100755
index 000000000000..006e251a9d2e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/cmd/while.t
@@ -0,0 +1,110 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/cmd/while.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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";}
+
+`/bin/rm -f 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/perl/t/comp/cmdopt.t b/gnu/usr.bin/perl/perl/t/comp/cmdopt.t
new file mode 100755
index 000000000000..3c47130602ca
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/cmdopt.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/comp/cmdopt.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+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 registers
+
+$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' && $x) { print "ok 25\n";} else { print "not ok 25\n";}
+if ($a ne 'a' && $x) { print "not ok 26\n";} else { print "ok 26\n";}
+$x = '';
+if ($a eq 'a' && $x) { print "not ok 27\n";} else { print "ok 27\n";}
+if ($a ne 'a' && $x) { print "not ok 28\n";} else { print "ok 28\n";}
+
+$x = 1;
+if ($a eq 'a' || $x) { print "ok 29\n";} else { print "not ok 29\n";}
+if ($a ne 'a' || $x) { print "ok 30\n";} else { print "not ok 30\n";}
+$x = '';
+if ($a eq 'a' || $x) { print "ok 31\n";} else { print "not ok 31\n";}
+if ($a ne 'a' || $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/perl/t/comp/cpp.t b/gnu/usr.bin/perl/perl/t/comp/cpp.t
new file mode 100755
index 000000000000..8cceb73ca8a0
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/cpp.t
@@ -0,0 +1,51 @@
+#!./perl -P
+
+# $RCSfile: cpp.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:06 $
+
+open(CONFIG,"../config.sh") || die;
+while (<CONFIG>) {
+    if (/^cppstdin/) {
+	if (/^cppstdin='(.*cppstdin)'/ && ! -e $1) {
+	    print "1..0\n";
+	    exit; 		# Can't test till after install, alas.
+	}
+	last;
+    }
+}
+close CONFIG;
+
+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/perl/t/comp/decl.t b/gnu/usr.bin/perl/perl/t/comp/decl.t
new file mode 100755
index 000000000000..f1c84c2190ce
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/decl.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/comp/decl.t,v 1.1.1.1 1993/08/23 21:30:07 nate Exp $
+
+# 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/perl/t/comp/multiline.t b/gnu/usr.bin/perl/perl/t/comp/multiline.t
new file mode 100755
index 000000000000..78df482d3e7c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/multiline.t
@@ -0,0 +1,40 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/comp/multiline.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+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";}
+`/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/perl/t/comp/package.t b/gnu/usr.bin/perl/perl/t/comp/package.t
new file mode 100755
index 000000000000..5237011a6219
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/package.t
@@ -0,0 +1,33 @@
+#!./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\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/perl/t/comp/script.t b/gnu/usr.bin/perl/perl/t/comp/script.t
new file mode 100755
index 000000000000..9dcf90195856
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/script.t
@@ -0,0 +1,23 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/comp/script.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+print "1..3\n";
+
+$x = `./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 eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = `./perl <Comp.script`;
+
+if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
+
+`/bin/rm -f Comp.script`;
diff --git a/gnu/usr.bin/perl/perl/t/comp/term.t b/gnu/usr.bin/perl/perl/t/comp/term.t
new file mode 100755
index 000000000000..70b23fd8a6ae
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/comp/term.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/comp/term.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+# 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/perl/t/io/argv.t b/gnu/usr.bin/perl/perl/t/io/argv.t
new file mode 100755
index 000000000000..99c593620eee
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/argv.t
@@ -0,0 +1,36 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/argv.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+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`;
diff --git a/gnu/usr.bin/perl/perl/t/io/dup.t b/gnu/usr.bin/perl/perl/t/io/dup.t
new file mode 100755
index 000000000000..8d11eca79973
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/dup.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/dup.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+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/perl/t/io/fs.t b/gnu/usr.bin/perl/perl/t/io/fs.t
new file mode 100755
index 000000000000..1d95cdc3530c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/fs.t
@@ -0,0 +1,85 @@
+#!./perl
+
+# $RCSfile: fs.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:05 $
+
+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`;
+
+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 (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (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/perl/t/io/inplace.t b/gnu/usr.bin/perl/perl/t/io/inplace.t
new file mode 100755
index 000000000000..b22afdaa4b98
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/inplace.t
@@ -0,0 +1,21 @@
+#!./perl
+
+$^I = '.bak';
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/inplace.t,v 1.1.1.1 1993/08/23 21:30:05 nate Exp $
+
+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/perl/t/io/pipe.t b/gnu/usr.bin/perl/perl/t/io/pipe.t
new file mode 100755
index 000000000000..791a9c715f85
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/pipe.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/pipe.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+$| = 1;
+print "1..8\n";
+
+open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]');
+print PIPE "OK 1\n";
+print PIPE "ok 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/perl/t/io/print.t b/gnu/usr.bin/perl/perl/t/io/print.t
new file mode 100755
index 000000000000..11854427410b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/print.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/print.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+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/perl/t/io/tell.t b/gnu/usr.bin/perl/perl/t/io/tell.t
new file mode 100755
index 000000000000..27e69a0fd7ee
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/io/tell.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/io/tell.t,v 1.1.1.1 1993/08/23 21:30:06 nate Exp $
+
+print "1..13\n";
+
+$TST = 'tst';
+
+open($TST, '../Makefile') || (die "Can't open ../Makefile");
+
+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/perl/t/lib/big.t b/gnu/usr.bin/perl/perl/t/lib/big.t
new file mode 100755
index 000000000000..9b27a5f1086b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/lib/big.t
@@ -0,0 +1,280 @@
+#!./perl
+require "../../lib/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/perl/t/op/Op.dbmx.db b/gnu/usr.bin/perl/perl/t/op/Op.dbmx.db
new file mode 100644
index 000000000000..33a09bba6d1c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/Op.dbmx.db
diff --git a/gnu/usr.bin/perl/perl/t/op/append.t b/gnu/usr.bin/perl/perl/t/op/append.t
new file mode 100755
index 000000000000..92c6f48e80c4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/append.t
@@ -0,0 +1,21 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/append.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/array.t b/gnu/usr.bin/perl/perl/t/op/array.t
new file mode 100755
index 000000000000..39e05e3fbbb4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/array.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/array.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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 we can recover element 5
+if ($#ary == 5) {print "ok 10\n";} else {print "not ok 10\n";}
+if ($ary[5] == 5) {print "ok 11\n";} else {print "not 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/perl/t/op/auto.t b/gnu/usr.bin/perl/perl/t/op/auto.t
new file mode 100755
index 000000000000..5301f934d8ed
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/auto.t
@@ -0,0 +1,48 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/auto.t,v 1.1.1.1 1993/08/23 21:30:01 nate Exp $
+
+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/perl/t/op/chop.t b/gnu/usr.bin/perl/perl/t/op/chop.t
new file mode 100755
index 000000000000..d691d734105b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/chop.t
@@ -0,0 +1,30 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/chop.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+print "1..4\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";
diff --git a/gnu/usr.bin/perl/perl/t/op/cond.t b/gnu/usr.bin/perl/perl/t/op/cond.t
new file mode 100755
index 000000000000..054a5ff7f0d7
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/cond.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/cond.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/dbm.t b/gnu/usr.bin/perl/perl/t/op/dbm.t
new file mode 100755
index 000000000000..23d4d98c9412
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/dbm.t
@@ -0,0 +1,106 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:02 $
+
+if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h'
+    && !-r '/usr/include/rpcsvc/dbm.h') {
+    print "1..0\n";
+    exit;
+}
+
+print "1..12\n";
+
+unlink <Op.dbmx.*>;
+umask(0);
+print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('Op.dbmx.pag');
+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'};
+
+dbmclose(h);
+print (dbmopen(h,'Op.dbmx',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('Op.dbmx.pag');
+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', 'Op.dbmx.pag';
diff --git a/gnu/usr.bin/perl/perl/t/op/delete.t b/gnu/usr.bin/perl/perl/t/op/delete.t
new file mode 100755
index 000000000000..e4e1fea10658
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/delete.t
@@ -0,0 +1,29 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/delete.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+print "1..6\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";}
diff --git a/gnu/usr.bin/perl/perl/t/op/do.t b/gnu/usr.bin/perl/perl/t/op/do.t
new file mode 100755
index 000000000000..370012c129b1
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/do.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/do.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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/perl/t/op/each.t b/gnu/usr.bin/perl/perl/t/op/each.t
new file mode 100755
index 000000000000..532d1b01f3f4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/each.t
@@ -0,0 +1,53 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/each.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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/perl/t/op/eval.t b/gnu/usr.bin/perl/perl/t/op/eval.t
new file mode 100755
index 000000000000..b21b44d8354c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/eval.t
@@ -0,0 +1,57 @@
+#!./perl
+
+# $RCSfile: eval.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:02 $
+
+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/perl/t/op/exec.t b/gnu/usr.bin/perl/perl/t/op/exec.t
new file mode 100755
index 000000000000..69909f740790
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/exec.t
@@ -0,0 +1,21 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/exec.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+$| = 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/perl/t/op/exp.t b/gnu/usr.bin/perl/perl/t/op/exp.t
new file mode 100755
index 000000000000..2195e54067d6
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/exp.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/exp.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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/perl/t/op/flip.t b/gnu/usr.bin/perl/perl/t/op/flip.t
new file mode 100755
index 000000000000..74ba5085ac5f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/flip.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/flip.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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,'../Makefile');
+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/perl/t/op/fork.t b/gnu/usr.bin/perl/perl/t/op/fork.t
new file mode 100755
index 000000000000..10b54a2a2c5b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/fork.t
@@ -0,0 +1,16 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/fork.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+$| = 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/perl/t/op/glob.t b/gnu/usr.bin/perl/perl/t/op/glob.t
new file mode 100755
index 000000000000..68b0844cad74
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/glob.t
@@ -0,0 +1,22 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/glob.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/goto.t b/gnu/usr.bin/perl/perl/t/op/goto.t
new file mode 100755
index 000000000000..44ef343201e4
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/goto.t
@@ -0,0 +1,33 @@
+#!./perl
+
+# $RCSfile: goto.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:03 $
+
+print "1..3\n";
+
+while (0) {
+    $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 =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/perl/t/op/groups.t b/gnu/usr.bin/perl/perl/t/op/groups.t
new file mode 100755
index 000000000000..e1520cc3d6b3
--- /dev/null
+++ b/gnu/usr.bin/perl/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/perl/t/op/index.t b/gnu/usr.bin/perl/perl/t/op/index.t
new file mode 100755
index 000000000000..769314b5e37f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/index.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/index.t,v 1.1.1.1 1993/08/23 21:30:01 nate Exp $
+
+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/perl/t/op/int.t b/gnu/usr.bin/perl/perl/t/op/int.t
new file mode 100755
index 000000000000..09434b8675a6
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/int.t
@@ -0,0 +1,17 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/int.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/join.t b/gnu/usr.bin/perl/perl/t/op/join.t
new file mode 100755
index 000000000000..a6678e979011
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/join.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/join.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/list.t b/gnu/usr.bin/perl/perl/t/op/list.t
new file mode 100755
index 000000000000..52b2347bfd30
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/list.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/list.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/local.t b/gnu/usr.bin/perl/perl/t/op/local.t
new file mode 100755
index 000000000000..67396e7cddeb
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/local.t
@@ -0,0 +1,45 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/local.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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 do 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 do foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
diff --git a/gnu/usr.bin/perl/perl/t/op/magic.t b/gnu/usr.bin/perl/perl/t/op/magic.t
new file mode 100755
index 000000000000..1f47a9936ace
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/magic.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/magic.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+$| = 1;		# command buffering
+
+print "1..5\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 ($! == 2) {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', '$| = 1;		# command buffering',
+
+'-e', '$SIG{"INT"} = "ok3"; kill 2,$$;',
+'-e', '$SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";',
+'-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";',
+
+'-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }';
+
+@val1 = @ENV{keys(%ENV)};	# can we slice ENV?
+@val2 = values(%ENV);
+
+print join(':',@val1) eq join(':',@val2) ? "ok 5\n" : "not ok 5\n";
diff --git a/gnu/usr.bin/perl/perl/t/op/mkdir.t b/gnu/usr.bin/perl/perl/t/op/mkdir.t
new file mode 100755
index 000000000000..0290ed4e5bbc
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/mkdir.t
@@ -0,0 +1,15 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/mkdir.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/oct.t b/gnu/usr.bin/perl/perl/t/op/oct.t
new file mode 100755
index 000000000000..9322cf0e73e1
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/oct.t
@@ -0,0 +1,9 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/oct.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+print "1..3\n";
+
+if (oct('01234') == 01234) {print "ok 1\n";} else {print "not ok 1\n";}
+if (oct('0x1234') == 0x1234) {print "ok 2\n";} else {print "not ok 2\n";}
+if (hex('01234') == 0x1234) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/perl/t/op/ord.t b/gnu/usr.bin/perl/perl/t/op/ord.t
new file mode 100755
index 000000000000..9d319882d4fe
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/ord.t
@@ -0,0 +1,14 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/ord.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+print "1..2\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";}
diff --git a/gnu/usr.bin/perl/perl/t/op/pack.t b/gnu/usr.bin/perl/perl/t/op/pack.t
new file mode 100755
index 000000000000..1dfaddf370ef
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/pack.t
@@ -0,0 +1,20 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/pack.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+print "1..3\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");
diff --git a/gnu/usr.bin/perl/perl/t/op/pat.t b/gnu/usr.bin/perl/perl/t/op/pat.t
new file mode 100755
index 000000000000..ce9f35c6ee66
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/pat.t
@@ -0,0 +1,184 @@
+#!./perl
+
+# $RCSfile: pat.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:01 $
+
+print "1..51\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";
diff --git a/gnu/usr.bin/perl/perl/t/op/push.t b/gnu/usr.bin/perl/perl/t/op/push.t
new file mode 100755
index 000000000000..3d738acfbda3
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/push.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/push.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+@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);
+    @list = split(' ',$list);
+    @get = split(' ',$get);
+    @leave = split(' ',$leave);
+    @x = (0,1,2,3,4,5,6,7);
+    @got = splice(@x,@list);
+    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/perl/t/op/range.t b/gnu/usr.bin/perl/perl/t/op/range.t
new file mode 100755
index 000000000000..6214f9527b99
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/range.t
@@ -0,0 +1,36 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/range.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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/perl/t/op/re_tests b/gnu/usr.bin/perl/perl/t/op/re_tests
new file mode 100644
index 000000000000..ee03d6fdbd18
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/re_tests
@@ -0,0 +1,274 @@
+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-
+()*	-	c	-	-
+*a	-	c	-	-
+^*	-	c	-	-
+$*	-	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	-	-
+(a*)*	-	c	-	-
+(a*)+	-	c	-	-
+(a|)*	-	c	-	-
+(a*|b)*	-	c	-	-
+(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|)*	-	c	-	-
+)(	-	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
+((a*|b))*	-	c	-	-
+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-
+'()*'i	-	c	-	-
+'*a'i	-	c	-	-
+'^*'i	-	c	-	-
+'$*'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*?'i	-	c	-	-
+'(a*)*'i	-	c	-	-
+'(a*)+'i	-	c	-	-
+'(a|)*'i	-	c	-	-
+'(a*|b)*'i	-	c	-	-
+'(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
+'(^)*'i	-	c	-	-
+'(ab|)*'i	-	c	-	-
+')('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
+'((a*|b))*'i	-	c	-	-
+'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
+'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
diff --git a/gnu/usr.bin/perl/perl/t/op/read.t b/gnu/usr.bin/perl/perl/t/op/read.t
new file mode 100755
index 000000000000..4151e5c6a674
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/read.t
@@ -0,0 +1,20 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/read.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+print "1..4\n";
+
+
+open(FOO,'op/read.t') || open(FOO,'./read.t') || open(FOO,'t/op/read.t') || die "Can't open op.read";
+seek(FOO,4,0);
+$got = read(FOO,$buf,4);
+print "This is got ... $got\n";
+
+print ($got == 4 ? "ok 1\n" : "not ok 1\n");
+print ($buf eq "perl" ? "ok 2\n" : "not ok 2 :$buf:\n");
+
+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/perl/t/op/readdir.t b/gnu/usr.bin/perl/perl/t/op/readdir.t
new file mode 100755
index 000000000000..18006991cdad
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/readdir.t
@@ -0,0 +1,20 @@
+#!./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$/, 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>;
+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/perl/t/op/regexp.t b/gnu/usr.bin/perl/perl/t/op/regexp.t
new file mode 100755
index 000000000000..58f6666e6949
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/regexp.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $RCSfile: regexp.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:03 $
+
+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/perl/t/op/repeat.t b/gnu/usr.bin/perl/perl/t/op/repeat.t
new file mode 100755
index 000000000000..68c61fc6a05e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/repeat.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/repeat.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/s.t b/gnu/usr.bin/perl/perl/t/op/s.t
new file mode 100755
index 000000000000..59300209cd39
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/s.t
@@ -0,0 +1,179 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/s.t,v 1.1.1.1 1993/08/23 21:30:01 nate Exp $
+
+print "1..51\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";
+
diff --git a/gnu/usr.bin/perl/perl/t/op/sleep.t b/gnu/usr.bin/perl/perl/t/op/sleep.t
new file mode 100755
index 000000000000..81113712d343
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/sleep.t
@@ -0,0 +1,8 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/sleep.t,v 1.1.1.1 1993/08/23 21:30:04 nate Exp $
+
+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/perl/t/op/sort.t b/gnu/usr.bin/perl/perl/t/op/sort.t
new file mode 100755
index 000000000000..4692ee4422fb
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/sort.t
@@ -0,0 +1,48 @@
+#!./perl
+
+# $RCSfile: sort.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:02 $
+
+print "1..10\n";
+
+sub reverse { $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 reverse @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 = 'reverse';
+$x = join('', sort $sub @harry);
+print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+
diff --git a/gnu/usr.bin/perl/perl/t/op/split.t b/gnu/usr.bin/perl/perl/t/op/split.t
new file mode 100755
index 000000000000..63bf3c7c76da
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/split.t
@@ -0,0 +1,57 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/split.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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`;
+print $foo =~ /DEBUGGING/ || $foo =~ /num\(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/perl/t/op/sprintf.t b/gnu/usr.bin/perl/perl/t/op/sprintf.t
new file mode 100755
index 000000000000..cdb4af5a2244
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/sprintf.t
@@ -0,0 +1,8 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/sprintf.t,v 1.1.1.1 1993/08/23 21:30:01 nate Exp $
+
+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/perl/t/op/stat.t b/gnu/usr.bin/perl/perl/t/op/stat.t
new file mode 100755
index 000000000000..a5db14fd124e
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/stat.t
@@ -0,0 +1,176 @@
+#!./perl
+
+# $RCSfile: stat.t,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:01 $
+
+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	:$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;
+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";}
+
+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') {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') {print "ok 43\n";} else {print "not ok 43\n";}
+if (! -T './perl') {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/perl/t/op/study.t b/gnu/usr.bin/perl/perl/t/op/study.t
new file mode 100755
index 000000000000..a0fdc4cd273c
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/study.t
@@ -0,0 +1,69 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/study.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/substr.t b/gnu/usr.bin/perl/perl/t/op/substr.t
new file mode 100755
index 000000000000..09f312f83762
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/substr.t
@@ -0,0 +1,47 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/substr.t,v 1.1.1.1 1993/08/23 21:30:01 nate Exp $
+
+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,6,-1) eq '' ? "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,7,-1) eq '' ? "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/perl/t/op/time.t b/gnu/usr.bin/perl/perl/t/op/time.t
new file mode 100755
index 000000000000..f8e5545f7b41
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/time.t
@@ -0,0 +1,43 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/time.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+print "1..5\n";
+
+($beguser,$begsys) = times;
+
+$beg = time;
+
+while (($now = time) == $beg) {}
+
+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;
+    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";}
+
+($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:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0)
+    {print "ok 5\n";}
+else
+    {print "not ok 5\n";}
diff --git a/gnu/usr.bin/perl/perl/t/op/undef.t b/gnu/usr.bin/perl/perl/t/op/undef.t
new file mode 100755
index 000000000000..b4827db0c547
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/undef.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/undef.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/unshift.t b/gnu/usr.bin/perl/perl/t/op/unshift.t
new file mode 100755
index 000000000000..53d73883822b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/unshift.t
@@ -0,0 +1,14 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/unshift.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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/perl/t/op/vec.t b/gnu/usr.bin/perl/perl/t/op/vec.t
new file mode 100755
index 000000000000..51344769b6cf
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/vec.t
@@ -0,0 +1,24 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/vec.t,v 1.1.1.1 1993/08/23 21:30:03 nate Exp $
+
+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/perl/t/op/write.t b/gnu/usr.bin/perl/perl/t/op/write.t
new file mode 100755
index 000000000000..d17f1951bb76
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/op/write.t
@@ -0,0 +1,129 @@
+#!./perl
+
+# $Header: /home/cvs/386BSD/ports/lang/perl/t/op/write.t,v 1.1.1.1 1993/08/23 21:30:02 nate Exp $
+
+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"; }
+
+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') || 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 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
+^<<<<<<<<< ~~
+$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
+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/perl/t/printme b/gnu/usr.bin/perl/perl/t/printme
new file mode 100644
index 000000000000..feefccb2d4f2
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/t/printme
@@ -0,0 +1,6 @@
+
+
+
+
+print "Hello World\n";
+
diff --git a/gnu/usr.bin/perl/perl/tdoio.c b/gnu/usr.bin/perl/perl/tdoio.c
new file mode 100644
index 000000000000..5dd8065b4f95
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/tdoio.c
@@ -0,0 +1,2948 @@
+/* $RCSfile: doio.c,v $$Revision: 1.2 $$Date: 1994/03/09 22:24: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: doio.c,v $
+ * Revision 1.2  1994/03/09  22:24:27  ache
+ * (cast) added for last argument of semctl
+ *
+ * Revision 1.1.1.1  1993/08/23  21:29:36  nate
+ * PERL!
+ *
+ * Revision 4.0.1.6  92/06/11  21:08:16  lwall
+ * patch34: some systems don't declare h_errno extern in header files
+ * 
+ * Revision 4.0.1.5  92/06/08  13:00:21  lwall
+ * patch20: some machines don't define ENOTSOCK in errno.h
+ * patch20: new warnings for failed use of stat operators on filenames with \n
+ * patch20: wait failed when STDOUT or STDERR reopened to a pipe
+ * patch20: end of file latch not reset on reopen of STDIN
+ * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround
+ * patch20: fixed memory leak on system() for vfork() machines
+ * patch20: get*by* routines now return something useful in a scalar context
+ * patch20: h_errno now accessible via $?
+ * 
+ * Revision 4.0.1.4  91/11/05  16:51:43  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: perl mistook some streams for sockets because they return mode 0 too
+ * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
+ * patch11: certain perl errors should set EBADF so that $! looks better
+ * patch11: truncate on a closed filehandle could dump
+ * patch11: stats of _ forgot whether prior stat was actually lstat
+ * patch11: -T returned true on NFS directory
+ * 
+ * Revision 4.0.1.3  91/06/10  01:21:19  lwall
+ * patch10: read didn't work from character special files open for writing
+ * patch10: close-on-exec wrongly set on system file descriptors
+ * 
+ * Revision 4.0.1.2  91/06/07  10:53:39  lwall
+ * patch4: new copyright notice
+ * patch4: system fd's are now treated specially
+ * patch4: added $^F variable to specify maximum system fd, default 2
+ * patch4: character special files now opened with bidirectional stdio buffers
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:41:06  lwall
+ * patch1: hopefully straightened out some of the Xenix mess
+ * 
+ * Revision 4.0  91/03/20  01:07:06  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include <unistd.h>
+#include <stdio.h>
+
+#ifdef HAS_SOCKET
+#include <sys/socket.h>
+#include <netdb.h>
+#ifndef ENOTSOCK
+#include <net/errno.h>
+#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
+
+#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>
+#endif
+#endif
+
+#ifdef I_PWD
+#include <pwd.h>
+#endif
+#ifdef I_GRP
+#include <grp.h>
+#endif
+#ifdef I_UTIME
+#include <utime.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+int laststatval = -1;
+int laststype = O_STAT;
+
+static char* warn_nl = "Unsuccessful %s on filename containing newline";
+
+bool
+do_open(stab,name,len)
+STAB *stab;
+register char *name;
+int len;
+{
+    FILE *fp;
+    register STIO *stio = stab_io(stab);
+    char *myname = savestr(name);
+    int result;
+    int fd;
+    int writing = 0;
+    char mode[3];		/* stdio file mode ("r\0" or "r+\0") */
+    FILE *saveifp = Nullfp;
+    FILE *saveofp = Nullfp;
+    char savetype = ' ';
+
+    mode[0] = mode[1] = mode[2] = '\0';
+    name = myname;
+    forkprocess = 1;		/* assume true if no fork */
+    while (len && isSPACE(name[len-1]))
+	name[--len] = '\0';
+    if (!stio)
+	stio = stab_io(stab) = stio_new();
+    else if (stio->ifp) {
+	fd = fileno(stio->ifp);
+	if (stio->type == '-')
+	    result = 0;
+	else if (fd <= maxsysfd) {
+	    saveifp = stio->ifp;
+	    saveofp = stio->ofp;
+	    savetype = stio->type;
+	    result = 0;
+	}
+	else if (stio->type == '|')
+	    result = mypclose(stio->ifp);
+	else if (stio->ifp != stio->ofp) {
+	    if (stio->ofp) {
+		result = fclose(stio->ofp);
+		fclose(stio->ifp);	/* clear stdio, fd already closed */
+	    }
+	    else
+		result = fclose(stio->ifp);
+	}
+	else
+	    result = fclose(stio->ifp);
+	if (result == EOF && fd > maxsysfd)
+	    fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
+	      stab_ename(stab));
+	stio->ofp = stio->ifp = Nullfp;
+    }
+    if (*name == '+' && len > 1 && name[len-1] != '|') {	/* scary */
+	mode[1] = *name++;
+	mode[2] = '\0';
+	--len;
+	writing = 1;
+    }
+    else  {
+	mode[1] = '\0';
+    }
+    stio->type = *name;
+    if (*name == '|') {
+	/*SUPPRESS 530*/
+	for (name++; isSPACE(*name); name++) ;
+#ifdef TAINT
+	taintenv();
+	taintproper("Insecure dependency in piped open");
+#endif
+	fp = mypopen(name,"w");
+	writing = 1;
+    }
+    else if (*name == '>') {
+#ifdef TAINT
+	taintproper("Insecure dependency in open");
+#endif
+	name++;
+	if (*name == '>') {
+	    mode[0] = stio->type = 'a';
+	    name++;
+	}
+	else
+	    mode[0] = 'w';
+	writing = 1;
+	if (*name == '&') {
+	  duplicity:
+	    name++;
+	    while (isSPACE(*name))
+		name++;
+	    if (isDIGIT(*name))
+		fd = atoi(name);
+	    else {
+		stab = stabent(name,FALSE);
+		if (!stab || !stab_io(stab)) {
+#ifdef EINVAL
+		    errno = EINVAL;
+#endif
+		    goto say_false;
+		}
+		if (stab_io(stab) && stab_io(stab)->ifp) {
+		    fd = fileno(stab_io(stab)->ifp);
+		    if (stab_io(stab)->type == 's')
+			stio->type = 's';
+		}
+		else
+		    fd = -1;
+	    }
+	    if (!(fp = fdopen(fd = dup(fd),mode))) {
+		close(fd);
+	    }
+	}
+	else {
+	    while (isSPACE(*name))
+		name++;
+	    if (strEQ(name,"-")) {
+		fp = stdout;
+		stio->type = '-';
+	    }
+	    else  {
+		fp = fopen(name,mode);
+	    }
+	}
+    }
+    else {
+	if (*name == '<') {
+	    mode[0] = 'r';
+	    name++;
+	    while (isSPACE(*name))
+		name++;
+	    if (*name == '&')
+		goto duplicity;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		stio->type = '-';
+	    }
+	    else
+		fp = fopen(name,mode);
+	}
+	else if (name[len-1] == '|') {
+#ifdef TAINT
+	    taintenv();
+	    taintproper("Insecure dependency in piped open");
+#endif
+	    name[--len] = '\0';
+	    while (len && isSPACE(name[len-1]))
+		name[--len] = '\0';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    fp = mypopen(name,"r");
+	    stio->type = '|';
+	}
+	else {
+	    stio->type = '<';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		stio->type = '-';
+	    }
+	    else
+		fp = fopen(name,"r");
+	}
+    }
+    if (!fp) {
+	if (dowarn && stio->type == '<' && index(name, '\n'))
+	    warn(warn_nl, "open");
+	Safefree(myname);
+	goto say_false;
+    }
+    Safefree(myname);
+    if (stio->type &&
+      stio->type != '|' && stio->type != '-') {
+	if (fstat(fileno(fp),&statbuf) < 0) {
+	    (void)fclose(fp);
+	    goto say_false;
+	}
+	if (S_ISSOCK(statbuf.st_mode))
+	    stio->type = '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), tokenbuf, &buflen) >= 0
+		|| errno != ENOTSOCK)
+		stio->type = '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;
+	    STR *str;
+
+	    dup2(fileno(fp), fd);
+	    str = afetch(fdpid,fileno(fp),TRUE);
+	    pid = str->str_u.str_useful;
+	    str->str_u.str_useful = 0;
+	    str = afetch(fdpid,fd,TRUE);
+	    str->str_u.str_useful = pid;
+	    fclose(fp);
+
+	}
+	fp = saveifp;
+	clearerr(fp);
+    }
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fd = fileno(fp);
+    fcntl(fd,F_SETFD,fd > maxsysfd);
+#endif
+    stio->ifp = fp;
+    if (writing) {
+	if (stio->type == 's'
+	  || (stio->type == '>' && S_ISCHR(statbuf.st_mode)) ) {
+	    if (!(stio->ofp = fdopen(fileno(fp),"w"))) {
+		fclose(fp);
+		stio->ifp = Nullfp;
+		goto say_false;
+	    }
+	}
+	else
+	    stio->ofp = fp;
+    }
+    return TRUE;
+
+say_false:
+    stio->ifp = saveifp;
+    stio->ofp = saveofp;
+    stio->type = savetype;
+    return FALSE;
+}
+
+FILE *
+nextargv(stab)
+register STAB *stab;
+{
+    register STR *str;
+#ifndef FLEXFILENAMES
+    int filedev;
+    int fileino;
+#endif
+    int fileuid;
+    int filegid;
+    static int filemode = 0;
+    static int lastfd;
+    static char *oldname;
+
+    if (!argvoutstab)
+	argvoutstab = stabent("ARGVOUT",TRUE);
+    if (filemode & (S_ISUID|S_ISGID)) {
+	fflush(stab_io(argvoutstab)->ifp);  /* chmod must follow last write */
+#ifdef HAS_FCHMOD
+	(void)fchmod(lastfd,filemode);
+#else
+	(void)chmod(oldname,filemode);
+#endif
+    }
+    filemode = 0;
+    while (alen(stab_xarray(stab)) >= 0) {
+	str = ashift(stab_xarray(stab));
+	str_sset(stab_val(stab),str);
+	STABSET(stab_val(stab));
+	oldname = str_get(stab_val(stab));
+	if (do_open(stab,oldname,stab_val(stab)->str_cur)) {
+	    if (inplace) {
+#ifdef TAINT
+		taintproper("Insecure dependency in inplace open");
+#endif
+		if (strEQ(oldname,"-")) {
+		    str_free(str);
+		    defoutstab = stabent("STDOUT",TRUE);
+		    return stab_io(stab)->ifp;
+		}
+#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(stab,FALSE);
+		    str_free(str);
+		    continue;
+		}
+		if (*inplace) {
+#ifdef SUFFIX
+		    add_suffix(str,inplace);
+#else
+		    str_cat(str,inplace);
+#endif
+#ifndef FLEXFILENAMES
+		    if (stat(str->str_ptr,&statbuf) >= 0
+		      && statbuf.st_dev == filedev
+		      && statbuf.st_ino == fileino ) {
+			warn("Can't do inplace edit: %s > 14 characters",
+			  str->str_ptr );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#endif
+#ifdef HAS_RENAME
+#ifndef DOSISH
+		    if (rename(oldname,str->str_ptr) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#else
+		    do_close(stab,FALSE);
+		    (void)unlink(str->str_ptr);
+		    (void)rename(oldname,str->str_ptr);
+		    do_open(stab,str->str_ptr,stab_val(stab)->str_cur);
+#endif /* MSDOS */
+#else
+		    (void)UNLINK(str->str_ptr);
+		    if (link(oldname,str->str_ptr) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+		    (void)UNLINK(oldname);
+#endif
+		}
+		else {
+#ifndef DOSISH
+		    if (UNLINK(oldname) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, str->str_ptr, strerror(errno) );
+			do_close(stab,FALSE);
+			str_free(str);
+			continue;
+		    }
+#else
+		    fatal("Can't do inplace edit without backup");
+#endif
+		}
+
+		str_nset(str,">",1);
+		str_cat(str,oldname);
+		errno = 0;		/* in case sprintf set errno */
+		if (!do_open(argvoutstab,str->str_ptr,str->str_cur)) {
+		    warn("Can't do inplace edit on %s: %s",
+		      oldname, strerror(errno) );
+		    do_close(stab,FALSE);
+		    str_free(str);
+		    continue;
+		}
+		defoutstab = argvoutstab;
+		lastfd = fileno(stab_io(argvoutstab)->ifp);
+		(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
+		}
+	    }
+	    str_free(str);
+	    return stab_io(stab)->ifp;
+	}
+	else
+	    fprintf(stderr,"Can't open %s: %s\n",str_get(str), strerror(errno));
+	str_free(str);
+    }
+    if (inplace) {
+	(void)do_close(argvoutstab,FALSE);
+	defoutstab = stabent("STDOUT",TRUE);
+    }
+    return Nullfp;
+}
+
+#ifdef HAS_PIPE
+void
+do_pipe(str, rstab, wstab)
+STR *str;
+STAB *rstab;
+STAB *wstab;
+{
+    register STIO *rstio;
+    register STIO *wstio;
+    int fd[2];
+
+    if (!rstab)
+	goto badexit;
+    if (!wstab)
+	goto badexit;
+
+    rstio = stab_io(rstab);
+    wstio = stab_io(wstab);
+
+    if (!rstio)
+	rstio = stab_io(rstab) = stio_new();
+    else if (rstio->ifp)
+	do_close(rstab,FALSE);
+    if (!wstio)
+	wstio = stab_io(wstab) = stio_new();
+    else if (wstio->ifp)
+	do_close(wstab,FALSE);
+
+    if (pipe(fd) < 0)
+	goto badexit;
+    rstio->ifp = fdopen(fd[0], "r");
+    wstio->ofp = fdopen(fd[1], "w");
+    wstio->ifp = wstio->ofp;
+    rstio->type = '<';
+    wstio->type = '>';
+    if (!rstio->ifp || !wstio->ofp) {
+	if (rstio->ifp) fclose(rstio->ifp);
+	else close(fd[0]);
+	if (wstio->ofp) fclose(wstio->ofp);
+	else close(fd[1]);
+	goto badexit;
+    }
+
+    str_sset(str,&str_yes);
+    return;
+
+badexit:
+    str_sset(str,&str_undef);
+    return;
+}
+#endif
+
+bool
+do_close(stab,explicit)
+STAB *stab;
+bool explicit;
+{
+    bool retval = FALSE;
+    register STIO *stio;
+    int status;
+
+    if (!stab)
+	stab = argvstab;
+    if (!stab) {
+	errno = EBADF;
+	return FALSE;
+    }
+    stio = stab_io(stab);
+    if (!stio) {		/* never opened */
+	if (dowarn && explicit)
+	    warn("Close on unopened file <%s>",stab_ename(stab));
+	return FALSE;
+    }
+    if (stio->ifp) {
+	if (stio->type == '|') {
+	    status = mypclose(stio->ifp);
+	    retval = (status == 0);
+	    statusvalue = (unsigned short)status & 0xffff;
+	}
+	else if (stio->type == '-')
+	    retval = TRUE;
+	else {
+	    if (stio->ofp && stio->ofp != stio->ifp) {		/* a socket */
+		retval = (fclose(stio->ofp) != EOF);
+		fclose(stio->ifp);	/* clear stdio, fd already closed */
+	    }
+	    else
+		retval = (fclose(stio->ifp) != EOF);
+	}
+	stio->ofp = stio->ifp = Nullfp;
+    }
+    if (explicit)
+	stio->lines = 0;
+    stio->type = ' ';
+    return retval;
+}
+
+bool
+do_eof(stab)
+STAB *stab;
+{
+    register STIO *stio;
+    int ch;
+
+    if (!stab) {			/* eof() */
+	if (argvstab)
+	    stio = stab_io(argvstab);
+	else
+	    return TRUE;
+    }
+    else
+	stio = stab_io(stab);
+
+    if (!stio)
+	return TRUE;
+
+    while (stio->ifp) {
+
+#ifdef STDSTDIO			/* (the code works without this) */
+	if (stio->ifp->_cnt > 0)	/* cheat a little, since */
+	    return FALSE;		/* this is the most usual case */
+#endif
+
+	ch = getc(stio->ifp);
+	if (ch != EOF) {
+	    (void)ungetc(ch, stio->ifp);
+	    return FALSE;
+	}
+#ifdef STDSTDIO
+	if (stio->ifp->_cnt < -1)
+	    stio->ifp->_cnt = -1;
+#endif
+	if (!stab) {			/* not necessarily a real EOF yet? */
+	    if (!nextargv(argvstab))	/* get another fp handy */
+		return TRUE;
+	}
+	else
+	    return TRUE;		/* normal fp, definitely end of file */
+    }
+    return TRUE;
+}
+
+long
+do_tell(stab)
+STAB *stab;
+{
+    register STIO *stio;
+
+    if (!stab)
+	goto phooey;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto phooey;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(stio->ifp))
+	(void)fseek (stio->ifp, 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return ftell(stio->ifp);
+
+phooey:
+    if (dowarn)
+	warn("tell() on unopened file");
+    errno = EBADF;
+    return -1L;
+}
+
+bool
+do_seek(stab, pos, whence)
+STAB *stab;
+long pos;
+int whence;
+{
+    register STIO *stio;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(stio->ifp))
+	(void)fseek (stio->ifp, 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return fseek(stio->ifp, pos, whence) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("seek() on unopened file");
+    errno = EBADF;
+    return FALSE;
+}
+
+int
+do_ctl(optype,stab,func,argstr)
+int optype;
+STAB *stab;
+int func;
+STR *argstr;
+{
+    register STIO *stio;
+    register char *s;
+    int retval;
+
+    if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
+	errno = EBADF;	/* well, sort of... */
+	return -1;
+    }
+
+    if (argstr->str_pok || !argstr->str_nok) {
+	if (!argstr->str_pok)
+	    s = str_get(argstr);
+
+#ifdef IOCPARM_MASK
+#ifndef IOCPARM_LEN
+#define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
+#endif
+#endif
+#ifdef IOCPARM_LEN
+	retval = IOCPARM_LEN(func);	/* on BSDish systes we're safe */
+#else
+	retval = 256;			/* otherwise guess at what's safe */
+#endif
+	if (argstr->str_cur < retval) {
+	    Str_Grow(argstr,retval+1);
+	    argstr->str_cur = retval;
+	}
+
+	s = argstr->str_ptr;
+	s[argstr->str_cur] = 17;	/* a little sanity check here */
+    }
+    else {
+	retval = (int)str_gnum(argstr);
+#ifdef DOSISH
+	s = (char*)(long)retval;		/* ouch */
+#else
+	s = (char*)retval;		/* ouch */
+#endif
+    }
+
+#ifndef lint
+    if (optype == O_IOCTL)
+	retval = ioctl(fileno(stio->ifp), func, s);
+    else
+#ifdef DOSISH
+	fatal("fcntl is not implemented");
+#else
+#ifdef HAS_FCNTL
+	retval = fcntl(fileno(stio->ifp), func, s);
+#else
+	fatal("fcntl is not implemented");
+#endif
+#endif
+#else /* lint */
+    retval = 0;
+#endif /* lint */
+
+    if (argstr->str_pok) {
+	if (s[argstr->str_cur] != 17)
+	    fatal("Return value overflowed string");
+	s[argstr->str_cur] = 0;		/* put our null back */
+    }
+    return retval;
+}
+
+int
+do_stat(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    int max = 13;
+
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (tmpstab != defstab) {
+	    laststype = O_STAT;
+	    statstab = tmpstab;
+	    str_set(statname,"");
+	    if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	      fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
+		max = 0;
+		laststatval = -1;
+	    }
+	}
+	else if (laststatval < 0)
+	    max = 0;
+    }
+    else {
+	str_set(statname,str_get(ary->ary_array[sp]));
+	statstab = Nullstab;
+#ifdef HAS_LSTAT
+	laststype = arg->arg_type;
+	if (arg->arg_type == O_LSTAT)
+	    laststatval = lstat(str_get(statname),&statcache);
+	else
+#endif
+	    laststatval = stat(str_get(statname),&statcache);
+	if (laststatval < 0) {
+	    if (dowarn && index(str_get(statname), '\n'))
+		warn(warn_nl, "stat");
+	    max = 0;
+	}
+    }
+
+    if (gimme != G_ARRAY) {
+	if (max)
+	    str_sset(str,&str_yes);
+	else
+	    str_sset(str,&str_undef);
+	STABSET(str);
+	ary->ary_array[sp] = str;
+	return sp;
+    }
+    sp--;
+    if (max) {
+#ifndef lint
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_dev)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_ino)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_mode)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_nlink)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_uid)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_gid)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_rdev)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_size)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_atime)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_mtime)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_ctime)));
+#ifdef STATBLOCKS
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_blksize)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_nmake((double)statcache.st_blocks)));
+#else
+	(void)astore(ary,++sp,
+	  str_2mortal(str_make("",0)));
+	(void)astore(ary,++sp,
+	  str_2mortal(str_make("",0)));
+#endif
+#else /* lint */
+	(void)astore(ary,++sp,str_nmake(0.0));
+#endif /* lint */
+    }
+    return sp;
+}
+
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+	/* code courtesy of William Kucharski */
+#define HAS_CHSIZE
+
+int chsize(fd, length)
+int 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 */
+
+int					/*SUPPRESS 590*/
+do_truncate(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    off_t len = (off_t)str_gnum(ary->ary_array[sp+1]);
+    int result = 1;
+    STAB *tmpstab;
+
+#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
+#ifdef HAS_TRUNCATE
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	  ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else if (truncate(str_get(ary->ary_array[sp]), len) < 0)
+	result = 0;
+#else
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+	tmpstab = arg[1].arg_ptr.arg_stab;
+	if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
+	  chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
+	    result = 0;
+    }
+    else {
+	int tmpfd;
+
+	if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0)
+	    result = 0;
+	else {
+	    if (chsize(tmpfd, len) < 0)
+		result = 0;
+	    close(tmpfd);
+	}
+    }
+#endif
+
+    if (result)
+	str_sset(str,&str_yes);
+    else
+	str_sset(str,&str_undef);
+    STABSET(str);
+    ary->ary_array[sp] = str;
+    return sp;
+#else
+    fatal("truncate not implemented");
+#endif
+}
+
+int
+looks_like_number(str)
+STR *str;
+{
+    register char *s;
+    register char *send;
+
+    if (!str->str_pok)
+	return TRUE;
+    s = str->str_ptr; 
+    send = s + str->str_cur;
+    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 == str->str_ptr)
+	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(str,fp)
+register STR *str;
+FILE *fp;
+{
+    register char *tmps;
+
+    if (!fp) {
+	if (dowarn)
+	    warn("print to unopened file");
+	errno = EBADF;
+	return FALSE;
+    }
+    if (!str)
+	return TRUE;
+    if (ofmt &&
+      ((str->str_nok && str->str_u.str_nval != 0.0)
+       || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
+	fprintf(fp, ofmt, str->str_u.str_nval);
+	return !ferror(fp);
+    }
+    else {
+	tmps = str_get(str);
+	if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
+	  && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
+	    STR *tmpstr = str_mortal(&str_undef);
+	    stab_efullname(tmpstr,((STAB*)str));/* a stab value, be nice */
+	    str = tmpstr;
+	    tmps = str->str_ptr;
+	    putc('*',fp);
+	}
+	if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
+	    return FALSE;
+    }
+    return TRUE;
+}
+
+bool
+do_aprint(arg,fp,arglast)
+register ARG *arg;
+register FILE *fp;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int retval;
+    register int items = arglast[2] - sp;
+
+    if (!fp) {
+	if (dowarn)
+	    warn("print to unopened file");
+	errno = EBADF;
+	return FALSE;
+    }
+    st += ++sp;
+    if (arg->arg_type == O_PRTF) {
+	do_sprintf(arg->arg_ptr.arg_str,items,st);
+	retval = do_print(arg->arg_ptr.arg_str,fp);
+    }
+    else {
+	retval = (items <= 0);
+	for (; items > 0; items--,st++) {
+	    if (retval && ofslen) {
+		if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
+		    retval = FALSE;
+		    break;
+		}
+	    }
+	    if (!(retval = do_print(*st, fp)))
+		break;
+	}
+	if (retval && orslen)
+	    if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
+		retval = FALSE;
+    }
+    return retval;
+}
+
+int
+mystat(arg,str)
+ARG *arg;
+STR *str;
+{
+    STIO *stio;
+
+    if (arg[1].arg_type & A_DONT) {
+	stio = stab_io(arg[1].arg_ptr.arg_stab);
+	if (stio && stio->ifp) {
+	    statstab = arg[1].arg_ptr.arg_stab;
+	    str_set(statname,"");
+	    laststype = O_STAT;
+	    return (laststatval = fstat(fileno(stio->ifp), &statcache));
+	}
+	else {
+	    if (arg[1].arg_ptr.arg_stab == defstab)
+		return laststatval;
+	    if (dowarn)
+		warn("Stat on unopened file <%s>",
+		  stab_ename(arg[1].arg_ptr.arg_stab));
+	    statstab = Nullstab;
+	    str_set(statname,"");
+	    return (laststatval = -1);
+	}
+    }
+    else {
+	statstab = Nullstab;
+	str_set(statname,str_get(str));
+	laststype = O_STAT;
+	laststatval = stat(str_get(str),&statcache);
+	if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+	    warn(warn_nl, "stat");
+	return laststatval;
+    }
+}
+
+int
+mylstat(arg,str)
+ARG *arg;
+STR *str;
+{
+    if (arg[1].arg_type & A_DONT) {
+	if (arg[1].arg_ptr.arg_stab == defstab) {
+	    if (laststype != O_LSTAT)
+		fatal("The stat preceding -l _ wasn't an lstat");
+	    return laststatval;
+	}
+	fatal("You can't use -l on a filehandle");
+    }
+
+    laststype = O_LSTAT;
+    statstab = Nullstab;
+    str_set(statname,str_get(str));
+#ifdef HAS_LSTAT
+    laststatval = lstat(str_get(str),&statcache);
+#else
+    laststatval = stat(str_get(str),&statcache);
+#endif
+    if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+	warn(warn_nl, "lstat");
+    return laststatval;
+}
+
+STR *
+do_fttext(arg,str)
+register ARG *arg;
+STR *str;
+{
+    int i;
+    int len;
+    int odd = 0;
+    STDCHAR tbuf[512];
+    register STDCHAR *s;
+    register STIO *stio;
+
+    if (arg[1].arg_type & A_DONT) {
+	if (arg[1].arg_ptr.arg_stab == defstab) {
+	    if (statstab)
+		stio = stab_io(statstab);
+	    else {
+		str = statname;
+		goto really_filename;
+	    }
+	}
+	else {
+	    statstab = arg[1].arg_ptr.arg_stab;
+	    str_set(statname,"");
+	    stio = stab_io(statstab);
+	}
+	if (stio && stio->ifp) {
+#if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */
+	    fstat(fileno(stio->ifp),&statcache);
+	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
+		return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
+	    if (stio->ifp->_cnt <= 0) {
+		i = getc(stio->ifp);
+		if (i != EOF)
+		    (void)ungetc(i,stio->ifp);
+	    }
+	    if (stio->ifp->_cnt <= 0)	/* null file is anything */
+		return &str_yes;
+	    len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
+	    s = stio->ifp->_base;
+#else
+	    fatal("-T and -B not implemented on filehandles");
+#endif
+	}
+	else {
+	    if (dowarn)
+		warn("Test on unopened file <%s>",
+		  stab_ename(arg[1].arg_ptr.arg_stab));
+	    errno = EBADF;
+	    return &str_undef;
+	}
+    }
+    else {
+	statstab = Nullstab;
+	str_set(statname,str_get(str));
+      really_filename:
+	i = open(str_get(str),0);
+	if (i < 0) {
+	    if (dowarn && index(str_get(str), '\n'))
+		warn(warn_nl, "open");
+	    return &str_undef;
+	}
+	fstat(i,&statcache);
+	len = read(i,tbuf,512);
+	(void)close(i);
+	if (len <= 0) {
+	    if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
+		return &str_no;		/* special case NFS directories */
+	    return &str_yes;		/* null file is anything */
+	}
+	s = tbuf;
+    }
+
+    /* now scan s to look for textiness */
+
+    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 * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
+	return &str_no;
+    else
+	return &str_yes;
+}
+
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
+bool
+do_aexec(really,arglast)
+STR *really;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char **a;
+    char *tmps;
+
+    if (items) {
+	New(401,Argv, items+1, char*);
+	a = Argv;
+	for (st += ++sp; items > 0; items--,st++) {
+	    if (*st)
+		*a++ = str_get(*st);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+#ifdef TAINT
+	if (*Argv[0] != '/')	/* will execvp use PATH? */
+	    taintenv();		/* testing IFS here is overkill, probably */
+#endif
+	if (really && *(tmps = str_get(really)))
+	    execvp(tmps,Argv);
+	else
+	    execvp(Argv[0],Argv);
+    }
+    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];
+
+    /* 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 */
+
+    /*SUPPRESS 530*/
+    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
+    if (*s == '=')
+	goto doshell;
+    for (s = cmd; *s; s++) {
+	if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\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 = nsavestr(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;
+	}
+    }
+    do_execfree();
+    return FALSE;
+}
+
+#ifdef HAS_SOCKET
+int
+do_socket(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int domain, type, protocol, fd;
+
+    if (!stab) {
+	errno = EBADF;
+	return FALSE;
+    }
+
+    stio = stab_io(stab);
+    if (!stio)
+	stio = stab_io(stab) = stio_new();
+    else if (stio->ifp)
+	do_close(stab,FALSE);
+
+    domain = (int)str_gnum(st[++sp]);
+    type = (int)str_gnum(st[++sp]);
+    protocol = (int)str_gnum(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in socket");
+#endif
+    fd = socket(domain,type,protocol);
+    if (fd < 0)
+	return FALSE;
+    stio->ifp = fdopen(fd, "r");	/* stdio gets confused about sockets */
+    stio->ofp = fdopen(fd, "w");
+    stio->type = 's';
+    if (!stio->ifp || !stio->ofp) {
+	if (stio->ifp) fclose(stio->ifp);
+	if (stio->ofp) fclose(stio->ofp);
+	if (!stio->ifp && !stio->ofp) close(fd);
+	return FALSE;
+    }
+
+    return TRUE;
+}
+
+int
+do_bind(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    char *addr;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    addr = str_get(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in bind");
+#endif
+    return bind(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("bind() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_connect(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    char *addr;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    addr = str_get(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in connect");
+#endif
+    return connect(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("connect() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_listen(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int backlog;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    backlog = (int)str_gnum(st[++sp]);
+    return listen(fileno(stio->ifp), backlog) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("listen() on closed fd");
+    errno = EBADF;
+    return FALSE;
+}
+
+void
+do_accept(str, nstab, gstab)
+STR *str;
+STAB *nstab;
+STAB *gstab;
+{
+    register STIO *nstio;
+    register STIO *gstio;
+    int len = sizeof buf;
+    int fd;
+
+    if (!nstab)
+	goto badexit;
+    if (!gstab)
+	goto nuts;
+
+    gstio = stab_io(gstab);
+    nstio = stab_io(nstab);
+
+    if (!gstio || !gstio->ifp)
+	goto nuts;
+    if (!nstio)
+	nstio = stab_io(nstab) = stio_new();
+    else if (nstio->ifp)
+	do_close(nstab,FALSE);
+
+    fd = accept(fileno(gstio->ifp),(struct sockaddr *)buf,&len);
+    if (fd < 0)
+	goto badexit;
+    nstio->ifp = fdopen(fd, "r");
+    nstio->ofp = fdopen(fd, "w");
+    nstio->type = 's';
+    if (!nstio->ifp || !nstio->ofp) {
+	if (nstio->ifp) fclose(nstio->ifp);
+	if (nstio->ofp) fclose(nstio->ofp);
+	if (!nstio->ifp && !nstio->ofp) close(fd);
+	goto badexit;
+    }
+
+    str_nset(str, buf, len);
+    return;
+
+nuts:
+    if (dowarn)
+	warn("accept() on closed fd");
+    errno = EBADF;
+badexit:
+    str_sset(str,&str_undef);
+    return;
+}
+
+int
+do_shutdown(stab, arglast)
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int how;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    how = (int)str_gnum(st[++sp]);
+    return shutdown(fileno(stio->ifp), how) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("shutdown() on closed fd");
+    errno = EBADF;
+    return FALSE;
+
+}
+
+int
+do_sopt(optype, stab, arglast)
+int optype;
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int fd;
+    unsigned int lvl;
+    unsigned int optname;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    fd = fileno(stio->ifp);
+    lvl = (unsigned int)str_gnum(st[sp+1]);
+    optname = (unsigned int)str_gnum(st[sp+2]);
+    switch (optype) {
+    case O_GSOCKOPT:
+	st[sp] = str_2mortal(Str_new(22,257));
+	st[sp]->str_cur = 256;
+	st[sp]->str_pok = 1;
+	if (getsockopt(fd, lvl, optname, st[sp]->str_ptr,
+			(int*)&st[sp]->str_cur) < 0)
+	    goto nuts;
+	break;
+    case O_SSOCKOPT:
+	st[sp] = st[sp+3];
+	if (setsockopt(fd, lvl, optname, st[sp]->str_ptr, st[sp]->str_cur) < 0)
+	    goto nuts;
+	st[sp] = &str_yes;
+	break;
+    }
+    
+    return sp;
+
+nuts:
+    if (dowarn)
+	warn("[gs]etsockopt() on closed fd");
+    st[sp] = &str_undef;
+    errno = EBADF;
+    return sp;
+
+}
+
+int
+do_getsockname(optype, stab, arglast)
+int optype;
+STAB *stab;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    int fd;
+
+    if (!stab)
+	goto nuts;
+
+    stio = stab_io(stab);
+    if (!stio || !stio->ifp)
+	goto nuts;
+
+    st[sp] = str_2mortal(Str_new(22,257));
+    st[sp]->str_cur = 256;
+    st[sp]->str_pok = 1;
+    fd = fileno(stio->ifp);
+    switch (optype) {
+    case O_GETSOCKNAME:
+	if (getsockname(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
+	    goto nuts2;
+	break;
+    case O_GETPEERNAME:
+	if (getpeername(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
+	    goto nuts2;
+	break;
+    }
+    
+    return sp;
+
+nuts:
+    if (dowarn)
+	warn("get{sock,peer}name() on closed fd");
+    errno = EBADF;
+nuts2:
+    st[sp] = &str_undef;
+    return sp;
+
+}
+
+int
+do_ghent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct hostent *gethostbyname();
+    struct hostent *gethostbyaddr();
+#ifdef HAS_GETHOSTENT
+    struct hostent *gethostent();
+#endif
+    struct hostent *hent;
+    unsigned long len;
+
+    if (which == O_GHBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	hent = gethostbyname(name);
+    }
+    else if (which == O_GHBYADDR) {
+	STR *addrstr = ary->ary_array[sp+1];
+	int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
+	char *addr = str_get(addrstr);
+
+	hent = gethostbyaddr(addr,addrstr->str_cur,addrtype);
+    }
+    else
+#ifdef HAS_GETHOSTENT
+	hent = gethostent();
+#else
+	fatal("gethostent not implemented");
+#endif
+
+#ifdef HOST_NOT_FOUND
+    if (!hent)
+	statusvalue = (unsigned short)h_errno & 0xffff;
+#endif
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (hent) {
+	    if (which == O_GHBYNAME) {
+#ifdef h_addr
+		str_nset(str, *hent->h_addr, hent->h_length);
+#else
+		str_nset(str, hent->h_addr, hent->h_length);
+#endif
+	    }
+	    else
+		str_set(str, hent->h_name);
+	}
+	return sp;
+    }
+
+    if (hent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, hent->h_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = hent->h_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)hent->h_addrtype);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	len = hent->h_length;
+	str_numset(str, (double)len);
+#ifdef h_addr
+	for (elem = hent->h_addr_list; *elem; elem++) {
+	    (void)astore(ary, ++sp, str = str_mortal(&str_no));
+	    str_nset(str, *elem, len);
+	}
+#else
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_nset(str, hent->h_addr, len);
+#endif /* h_addr */
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gnent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct netent *getnetbyname();
+    struct netent *getnetbyaddr();
+    struct netent *getnetent();
+    struct netent *nent;
+
+    if (which == O_GNBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	nent = getnetbyname(name);
+    }
+    else if (which == O_GNBYADDR) {
+	unsigned long addr = U_L(str_gnum(ary->ary_array[sp+1]));
+	int addrtype = (int)str_gnum(ary->ary_array[sp+2]);
+
+	nent = getnetbyaddr((long)addr,addrtype);
+    }
+    else
+	nent = getnetent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (nent) {
+	    if (which == O_GNBYNAME)
+		str_numset(str, (double)nent->n_net);
+	    else
+		str_set(str, nent->n_name);
+	}
+	return sp;
+    }
+
+    if (nent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, nent->n_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = nent->n_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)nent->n_addrtype);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)nent->n_net);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gpent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct protoent *getprotobyname();
+    struct protoent *getprotobynumber();
+    struct protoent *getprotoent();
+    struct protoent *pent;
+
+    if (which == O_GPBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	pent = getprotobyname(name);
+    }
+    else if (which == O_GPBYNUMBER) {
+	int proto = (int)str_gnum(ary->ary_array[sp+1]);
+
+	pent = getprotobynumber(proto);
+    }
+    else
+	pent = getprotoent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (pent) {
+	    if (which == O_GPBYNAME)
+		str_numset(str, (double)pent->p_proto);
+	    else
+		str_set(str, pent->p_name);
+	}
+	return sp;
+    }
+
+    if (pent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pent->p_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = pent->p_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pent->p_proto);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+int
+do_gsent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct servent *getservbyname();
+    struct servent *getservbynumber();
+    struct servent *getservent();
+    struct servent *sent;
+
+    if (which == O_GSBYNAME) {
+	char *name = str_get(ary->ary_array[sp+1]);
+	char *proto = str_get(ary->ary_array[sp+2]);
+
+	if (proto && !*proto)
+	    proto = Nullch;
+
+	sent = getservbyname(name,proto);
+    }
+    else if (which == O_GSBYPORT) {
+	int port = (int)str_gnum(ary->ary_array[sp+1]);
+	char *proto = str_get(ary->ary_array[sp+2]);
+
+	sent = getservbyport(port,proto);
+    }
+    else
+	sent = getservent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (sent) {
+	    if (which == O_GSBYNAME) {
+#ifdef HAS_NTOHS
+		str_numset(str, (double)ntohs(sent->s_port));
+#else
+		str_numset(str, (double)(sent->s_port));
+#endif
+	    }
+	    else
+		str_set(str, sent->s_name);
+	}
+	return sp;
+    }
+
+    if (sent) {
+#ifndef lint
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, sent->s_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = sent->s_aliases; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef HAS_NTOHS
+	str_numset(str, (double)ntohs(sent->s_port));
+#else
+	str_numset(str, (double)(sent->s_port));
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, sent->s_proto);
+#else /* lint */
+	elem = Nullch;
+	elem = elem;
+	(void)astore(ary, ++sp, str_mortal(&str_no));
+#endif /* lint */
+    }
+
+    return sp;
+}
+
+#endif /* HAS_SOCKET */
+
+#ifdef HAS_SELECT
+int
+do_select(gimme,arglast)
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register int i;
+    register int j;
+    register char *s;
+    register STR *str;
+    double value;
+    int maxlen = 0;
+    int nfound;
+    struct timeval timebuf;
+    struct timeval *tbuf = &timebuf;
+    int growsize;
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+    int masksize;
+    int offset;
+    char *fd_sets[4];
+    int k;
+
+#if BYTEORDER & 0xf0000
+#define ORDERBYTE (0x88888888 - BYTEORDER)
+#else
+#define ORDERBYTE (0x4444 - BYTEORDER)
+#endif
+
+#endif
+
+    for (i = 1; i <= 3; i++) {
+	j = st[sp+i]->str_cur;
+	if (maxlen < j)
+	    maxlen = j;
+    }
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+    growsize = maxlen;		/* little endians can use vecs directly */
+#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
+
+    for (i = 1; i <= 3; i++) {
+	str = st[sp+i];
+	j = str->str_len;
+	if (j < growsize) {
+	    if (str->str_pok) {
+		Str_Grow(str,growsize);
+		s = str_get(str) + j;
+		while (++j <= growsize) {
+		    *s++ = '\0';
+		}
+	    }
+	    else if (str->str_ptr) {
+		Safefree(str->str_ptr);
+		str->str_ptr = Nullch;
+	    }
+	}
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+	s = str->str_ptr;
+	if (s) {
+	    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];
+	    }
+	}
+#endif
+    }
+    str = st[sp+4];
+    if (str->str_nok || str->str_pok) {
+	value = str_gnum(str);
+	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*);
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+    nfound = select(
+	maxlen * 8,
+	st[sp+1]->str_ptr,
+	st[sp+2]->str_ptr,
+	st[sp+3]->str_ptr,
+	tbuf);
+#else
+    nfound = select(
+	maxlen * 8,
+	fd_sets[1],
+	fd_sets[2],
+	fd_sets[3],
+	tbuf);
+    for (i = 1; i <= 3; i++) {
+	if (fd_sets[i]) {
+	    str = st[sp+i];
+	    s = str->str_ptr;
+	    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
+
+    st[++sp] = str_mortal(&str_no);
+    str_numset(st[sp], (double)nfound);
+    if (gimme == G_ARRAY && tbuf) {
+	value = (double)(timebuf.tv_sec) +
+		(double)(timebuf.tv_usec) / 1000000.0;
+	st[++sp] = str_mortal(&str_no);
+	str_numset(st[sp], value);
+    }
+    return sp;
+}
+#endif /* SELECT */
+
+#ifdef HAS_SOCKET
+int
+do_spair(stab1, stab2, arglast)
+STAB *stab1;
+STAB *stab2;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[2];
+    register STIO *stio1;
+    register STIO *stio2;
+    int domain, type, protocol, fd[2];
+
+    if (!stab1 || !stab2)
+	return FALSE;
+
+    stio1 = stab_io(stab1);
+    stio2 = stab_io(stab2);
+    if (!stio1)
+	stio1 = stab_io(stab1) = stio_new();
+    else if (stio1->ifp)
+	do_close(stab1,FALSE);
+    if (!stio2)
+	stio2 = stab_io(stab2) = stio_new();
+    else if (stio2->ifp)
+	do_close(stab2,FALSE);
+
+    domain = (int)str_gnum(st[++sp]);
+    type = (int)str_gnum(st[++sp]);
+    protocol = (int)str_gnum(st[++sp]);
+#ifdef TAINT
+    taintproper("Insecure dependency in socketpair");
+#endif
+#ifdef HAS_SOCKETPAIR
+    if (socketpair(domain,type,protocol,fd) < 0)
+	return FALSE;
+#else
+    fatal("Socketpair unimplemented");
+#endif
+    stio1->ifp = fdopen(fd[0], "r");
+    stio1->ofp = fdopen(fd[0], "w");
+    stio1->type = 's';
+    stio2->ifp = fdopen(fd[1], "r");
+    stio2->ofp = fdopen(fd[1], "w");
+    stio2->type = 's';
+    if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) {
+	if (stio1->ifp) fclose(stio1->ifp);
+	if (stio1->ofp) fclose(stio1->ofp);
+	if (!stio1->ifp && !stio1->ofp) close(fd[0]);
+	if (stio2->ifp) fclose(stio2->ifp);
+	if (stio2->ofp) fclose(stio2->ofp);
+	if (!stio2->ifp && !stio2->ofp) close(fd[1]);
+	return FALSE;
+    }
+
+    return TRUE;
+}
+
+#endif /* HAS_SOCKET */
+
+int
+do_gpwent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+#ifdef I_PWD
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register STR *str;
+    struct passwd *getpwnam();
+    struct passwd *getpwuid();
+    struct passwd *getpwent();
+    struct passwd *pwent;
+
+    if (which == O_GPWNAM) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	pwent = getpwnam(name);
+    }
+    else if (which == O_GPWUID) {
+	int uid = (int)str_gnum(ary->ary_array[sp+1]);
+
+	pwent = getpwuid(uid);
+    }
+    else
+	pwent = getpwent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (pwent) {
+	    if (which == O_GPWNAM)
+		str_numset(str, (double)pwent->pw_uid);
+	    else
+		str_set(str, pwent->pw_name);
+	}
+	return sp;
+    }
+
+    if (pwent) {
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_passwd);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_uid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_gid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef PWCHANGE
+	str_numset(str, (double)pwent->pw_change);
+#else
+#ifdef PWQUOTA
+	str_numset(str, (double)pwent->pw_quota);
+#else
+#ifdef PWAGE
+	str_set(str, pwent->pw_age);
+#endif
+#endif
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+#ifdef PWCLASS
+	str_set(str,pwent->pw_class);
+#else
+#ifdef PWCOMMENT
+	str_set(str, pwent->pw_comment);
+#endif
+#endif
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_gecos);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_dir);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, pwent->pw_shell);
+#ifdef PWEXPIRE
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)pwent->pw_expire);
+#endif
+    }
+
+    return sp;
+#else
+    fatal("password routines not implemented");
+#endif
+}
+
+int
+do_ggrent(which,gimme,arglast)
+int which;
+int gimme;
+int *arglast;
+{
+#ifdef I_GRP
+    register ARRAY *ary = stack;
+    register int sp = arglast[0];
+    register char **elem;
+    register STR *str;
+    struct group *getgrnam();
+    struct group *getgrgid();
+    struct group *getgrent();
+    struct group *grent;
+
+    if (which == O_GGRNAM) {
+	char *name = str_get(ary->ary_array[sp+1]);
+
+	grent = getgrnam(name);
+    }
+    else if (which == O_GGRGID) {
+	int gid = (int)str_gnum(ary->ary_array[sp+1]);
+
+	grent = getgrgid(gid);
+    }
+    else
+	grent = getgrent();
+
+    if (gimme != G_ARRAY) {
+	astore(ary, ++sp, str = str_mortal(&str_undef));
+	if (grent) {
+	    if (which == O_GGRNAM)
+		str_numset(str, (double)grent->gr_gid);
+	    else
+		str_set(str, grent->gr_name);
+	}
+	return sp;
+    }
+
+    if (grent) {
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, grent->gr_name);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_set(str, grent->gr_passwd);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	str_numset(str, (double)grent->gr_gid);
+	(void)astore(ary, ++sp, str = str_mortal(&str_no));
+	for (elem = grent->gr_mem; *elem; elem++) {
+	    str_cat(str, *elem);
+	    if (elem[1])
+		str_ncat(str," ",1);
+	}
+    }
+
+    return sp;
+#else
+    fatal("group routines not implemented");
+#endif
+}
+
+int
+do_dirop(optype,stab,gimme,arglast)
+int optype;
+STAB *stab;
+int gimme;
+int *arglast;
+{
+#if defined(DIRENT) && defined(HAS_READDIR)
+    register ARRAY *ary = stack;
+    register STR **st = ary->ary_array;
+    register int sp = arglast[1];
+    register STIO *stio;
+    long along;
+#ifndef apollo
+    struct DIRENT *readdir();
+#endif
+    register struct DIRENT *dp;
+
+    if (!stab)
+	goto nope;
+    if (!(stio = stab_io(stab)))
+	stio = stab_io(stab) = stio_new();
+    if (!stio->dirp && optype != O_OPEN_DIR)
+	goto nope;
+    st[sp] = &str_yes;
+    switch (optype) {
+    case O_OPEN_DIR:
+	if (stio->dirp)
+	    closedir(stio->dirp);
+	if (!(stio->dirp = opendir(str_get(st[sp+1]))))
+	    goto nope;
+	break;
+    case O_READDIR:
+	if (gimme == G_ARRAY) {
+	    --sp;
+	    /*SUPPRESS 560*/
+	    while (dp = readdir(stio->dirp)) {
+#ifdef DIRNAMLEN
+		(void)astore(ary,++sp,
+		  str_2mortal(str_make(dp->d_name,dp->d_namlen)));
+#else
+		(void)astore(ary,++sp,
+		  str_2mortal(str_make(dp->d_name,0)));
+#endif
+	    }
+	}
+	else {
+	    if (!(dp = readdir(stio->dirp)))
+		goto nope;
+	    st[sp] = str_mortal(&str_undef);
+#ifdef DIRNAMLEN
+	    str_nset(st[sp], dp->d_name, dp->d_namlen);
+#else
+	    str_set(st[sp], dp->d_name);
+#endif
+	}
+	break;
+#if defined(HAS_TELLDIR) || defined(telldir)
+    case O_TELLDIR: {
+#ifndef telldir
+	    long telldir();
+#endif
+	    st[sp] = str_mortal(&str_undef);
+	    str_numset(st[sp], (double)telldir(stio->dirp));
+	    break;
+	}
+#endif
+#if defined(HAS_SEEKDIR) || defined(seekdir)
+    case O_SEEKDIR:
+	st[sp] = str_mortal(&str_undef);
+	along = (long)str_gnum(st[sp+1]);
+	(void)seekdir(stio->dirp,along);
+	break;
+#endif
+#if defined(HAS_REWINDDIR) || defined(rewinddir)
+    case O_REWINDDIR:
+	st[sp] = str_mortal(&str_undef);
+	(void)rewinddir(stio->dirp);
+	break;
+#endif
+    case O_CLOSEDIR:
+	st[sp] = str_mortal(&str_undef);
+	(void)closedir(stio->dirp);
+	stio->dirp = 0;
+	break;
+    default:
+	goto phooey;
+    }
+    return sp;
+
+nope:
+    st[sp] = &str_undef;
+    if (!errno)
+	errno = EBADF;
+    return sp;
+
+#endif
+phooey:
+    fatal("Unimplemented directory operation");
+}
+
+int
+apply(type,arglast)
+int type;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register int val;
+    register int val2;
+    register int tot = 0;
+    char *s;
+
+#ifdef TAINT
+    for (st += ++sp; items--; st++)
+	tainted |= (*st)->str_tainted;
+    st = stack->ary_array;
+    sp = arglast[1];
+    items = arglast[2] - sp;
+#endif
+    switch (type) {
+    case O_CHMOD:
+#ifdef TAINT
+	taintproper("Insecure dependency in chmod");
+#endif
+	if (--items > 0) {
+	    tot = items;
+	    val = (int)str_gnum(st[++sp]);
+	    while (items--) {
+		if (chmod(str_get(st[++sp]),val))
+		    tot--;
+	    }
+	}
+	break;
+#ifdef HAS_CHOWN
+    case O_CHOWN:
+#ifdef TAINT
+	taintproper("Insecure dependency in chown");
+#endif
+	if (items > 2) {
+	    items -= 2;
+	    tot = items;
+	    val = (int)str_gnum(st[++sp]);
+	    val2 = (int)str_gnum(st[++sp]);
+	    while (items--) {
+		if (chown(str_get(st[++sp]),val,val2))
+		    tot--;
+	    }
+	}
+	break;
+#endif
+#ifdef HAS_KILL
+    case O_KILL:
+#ifdef TAINT
+	taintproper("Insecure dependency in kill");
+#endif
+	if (--items > 0) {
+	    tot = items;
+	    s = str_get(st[++sp]);
+	    if (isUPPER(*s)) {
+		if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
+		    s += 3;
+		if (!(val = whichsig(s)))
+		    fatal("Unrecognized signal name \"%s\"",s);
+	    }
+	    else
+		val = (int)str_gnum(st[sp]);
+	    if (val < 0) {
+		val = -val;
+		while (items--) {
+		    int proc = (int)str_gnum(st[++sp]);
+#ifdef HAS_KILLPG
+		    if (killpg(proc,val))	/* BSD */
+#else
+		    if (kill(-proc,val))	/* SYSV */
+#endif
+			tot--;
+		}
+	    }
+	    else {
+		while (items--) {
+		    if (kill((int)(str_gnum(st[++sp])),val))
+			tot--;
+		}
+	    }
+	}
+	break;
+#endif
+    case O_UNLINK:
+#ifdef TAINT
+	taintproper("Insecure dependency in unlink");
+#endif
+	tot = items;
+	while (items--) {
+	    s = str_get(st[++sp]);
+	    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;
+    case O_UTIME:
+#ifdef TAINT
+	taintproper("Insecure dependency in utime");
+#endif
+	if (items > 2) {
+#ifdef I_UTIME
+	    struct utimbuf utbuf;
+#else
+	    struct {
+		long    actime;
+		long	modtime;
+	    } utbuf;
+#endif
+
+	    Zero(&utbuf, sizeof utbuf, char);
+	    utbuf.actime = (long)str_gnum(st[++sp]);    /* time accessed */
+	    utbuf.modtime = (long)str_gnum(st[++sp]);    /* time modified */
+	    items -= 2;
+#ifndef lint
+	    tot = items;
+	    while (items--) {
+		if (utime(str_get(st[++sp]),&utbuf))
+		    tot--;
+	    }
+#endif
+	}
+	else
+	    items = 0;
+	break;
+    }
+    return tot;
+}
+
+/* Do the permissions allow some operation?  Assumes statcache already set. */
+
+int
+cando(bit, effective, statbufp)
+int bit;
+int 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((int)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 */
+}
+
+int
+ingroup(testgid,effective)
+int testgid;
+int effective;
+{
+    if (testgid == (effective ? egid : gid))
+	return TRUE;
+#ifdef HAS_GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+    {
+	GROUPSTYPE gary[NGROUPS];
+	int 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)
+
+int
+do_ipcget(optype, arglast)
+int optype;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    key_t key;
+    int n, flags;
+
+    key = (key_t)str_gnum(st[++sp]);
+    n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]);
+    flags = (int)str_gnum(st[++sp]);
+    errno = 0;
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGGET:
+	return msgget(key, flags);
+#endif
+#ifdef HAS_SEM
+    case O_SEMGET:
+	return semget(key, n, flags);
+#endif
+#ifdef HAS_SHM
+    case O_SHMGET:
+	return shmget(key, n, flags);
+#endif
+#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
+    default:
+	fatal("%s not implemented", opname[optype]);
+#endif
+    }
+    return -1;			/* should never happen */
+}
+
+int
+do_ipcctl(optype, arglast)
+int optype;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *astr;
+    char *a;
+    int id, n, cmd, infosize, getinfo, ret;
+
+    id = (int)str_gnum(st[++sp]);
+    n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0;
+    cmd = (int)str_gnum(st[++sp]);
+    astr = st[++sp];
+
+    infosize = 0;
+    getinfo = (cmd == IPC_STAT);
+
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct msqid_ds);
+	break;
+#endif
+#ifdef HAS_SHM
+    case O_SHMCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct shmid_ds);
+	break;
+#endif
+#ifdef HAS_SEM
+    case O_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, (union semun)&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:
+	fatal("%s not implemented", opname[optype]);
+#endif
+    }
+
+    if (infosize)
+    {
+	if (getinfo)
+	{
+	    STR_GROW(astr, infosize+1);
+	    a = str_get(astr);
+	}
+	else
+	{
+	    a = str_get(astr);
+	    if (astr->str_cur != infosize)
+	    {
+		errno = EINVAL;
+		return -1;
+	    }
+	}
+    }
+    else
+    {
+	int i = (int)str_gnum(astr);
+	a = (char *)i;		/* ouch */
+    }
+    errno = 0;
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case O_MSGCTL:
+	ret = msgctl(id, cmd, (struct msqid_ds *)a);
+	break;
+#endif
+#ifdef HAS_SEM
+    case O_SEMCTL:
+	ret = semctl(id, n, cmd, (union semun)((int)a));
+	break;
+#endif
+#ifdef HAS_SHM
+    case O_SHMCTL:
+	ret = shmctl(id, cmd, (struct shmid_ds *)a);
+	break;
+#endif
+    }
+    if (getinfo && ret >= 0) {
+	astr->str_cur = infosize;
+	astr->str_ptr[infosize] = '\0';
+    }
+    return ret;
+}
+
+int
+do_msgsnd(arglast)
+int *arglast;
+{
+#ifdef HAS_MSG
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf;
+    int id, msize, flags;
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    flags = (int)str_gnum(st[++sp]);
+    mbuf = str_get(mstr);
+    if ((msize = mstr->str_cur - sizeof(long)) < 0) {
+	errno = EINVAL;
+	return -1;
+    }
+    errno = 0;
+    return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
+#else
+    fatal("msgsnd not implemented");
+#endif
+}
+
+int
+do_msgrcv(arglast)
+int *arglast;
+{
+#ifdef HAS_MSG
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf;
+    long mtype;
+    int id, msize, flags, ret;
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    msize = (int)str_gnum(st[++sp]);
+    mtype = (long)str_gnum(st[++sp]);
+    flags = (int)str_gnum(st[++sp]);
+    mbuf = str_get(mstr);
+    if (mstr->str_cur < sizeof(long)+msize+1) {
+	STR_GROW(mstr, sizeof(long)+msize+1);
+	mbuf = str_get(mstr);
+    }
+    errno = 0;
+    ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
+    if (ret >= 0) {
+	mstr->str_cur = sizeof(long)+ret;
+	mstr->str_ptr[sizeof(long)+ret] = '\0';
+    }
+    return ret;
+#else
+    fatal("msgrcv not implemented");
+#endif
+}
+
+int
+do_semop(arglast)
+int *arglast;
+{
+#ifdef HAS_SEM
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *opstr;
+    char *opbuf;
+    int id, opsize;
+
+    id = (int)str_gnum(st[++sp]);
+    opstr = st[++sp];
+    opbuf = str_get(opstr);
+    opsize = opstr->str_cur;
+    if (opsize < sizeof(struct sembuf)
+	|| (opsize % sizeof(struct sembuf)) != 0) {
+	errno = EINVAL;
+	return -1;
+    }
+    errno = 0;
+    return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
+#else
+    fatal("semop not implemented");
+#endif
+}
+
+int
+do_shmio(optype, arglast)
+int optype;
+int *arglast;
+{
+#ifdef HAS_SHM
+    register STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    STR *mstr;
+    char *mbuf, *shm;
+    int id, mpos, msize;
+    struct shmid_ds shmds;
+#ifndef VOIDSHMAT
+    extern char *shmat();
+#endif
+
+    id = (int)str_gnum(st[++sp]);
+    mstr = st[++sp];
+    mpos = (int)str_gnum(st[++sp]);
+    msize = (int)str_gnum(st[++sp]);
+    errno = 0;
+    if (shmctl(id, IPC_STAT, &shmds) == -1)
+	return -1;
+    if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
+	errno = EFAULT;		/* can't do as caller requested */
+	return -1;
+    }
+    shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
+    if (shm == (char *)-1)	/* I hate System V IPC, I really do */
+	return -1;
+    mbuf = str_get(mstr);
+    if (optype == O_SHMREAD) {
+	if (mstr->str_cur < msize) {
+	    STR_GROW(mstr, msize+1);
+	    mbuf = str_get(mstr);
+	}
+	Copy(shm + mpos, mbuf, msize, char);
+	mstr->str_cur = msize;
+	mstr->str_ptr[msize] = '\0';
+    }
+    else {
+	int n;
+
+	if ((n = mstr->str_cur) > msize)
+	    n = msize;
+	Copy(mbuf, shm + mpos, n, char);
+	if (n < msize)
+	    memzero(shm + mpos + n, msize - n);
+    }
+    return shmdt(shm);
+#else
+    fatal("shm I/O not implemented");
+#endif
+}
+
+#endif /* SYSV IPC */
diff --git a/gnu/usr.bin/perl/perl/toke.c b/gnu/usr.bin/perl/perl/toke.c
new file mode 100644
index 000000000000..34603cedf31b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/toke.c
@@ -0,0 +1,2764 @@
+/* $RCSfile: toke.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:40 $
+ *
+ *    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: toke.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:40  nate
+ * PERL!
+ *
+ * Revision 4.0.1.9  1993/02/05  19:48:43  lwall
+ * patch36: now detects ambiguous use of filetest operators as well as unary
+ * patch36: fixed ambiguity on - within tr///
+ *
+ * Revision 4.0.1.8  92/06/23  12:33:45  lwall
+ * patch35: bad interaction between backslash and hyphen in tr///
+ * 
+ * Revision 4.0.1.7  92/06/11  21:16:30  lwall
+ * patch34: expectterm incorrectly set to indicate start of program or block
+ * 
+ * Revision 4.0.1.6  92/06/08  16:03:49  lwall
+ * patch20: an EXPR may now start with a bareword
+ * patch20: print $fh EXPR can now expect term rather than operator in EXPR
+ * patch20: added ... as variant on ..
+ * patch20: new warning on spurious backslash
+ * patch20: new warning on missing $ for foreach variable
+ * patch20: "foo"x1024 now legal without space after x
+ * patch20: new warning on print accidentally used as function
+ * patch20: tr/stuff// wasn't working right
+ * patch20: 2. now eats the dot
+ * patch20: <@ARGV> now notices @ARGV
+ * patch20: tr/// now lets you say \-
+ * 
+ * Revision 4.0.1.5  91/11/11  16:45:51  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * 
+ * Revision 4.0.1.4  91/11/05  19:02:48  lwall
+ * patch11: \x and \c were subject to double interpretation in regexps
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: nested list operators could miscount parens
+ * patch11: once-thru blocks didn't display right in the debugger
+ * patch11: sort eval "whatever" didn't work
+ * patch11: underscore is now allowed within literal octal and hex numbers
+ * 
+ * Revision 4.0.1.3  91/06/10  01:32:26  lwall
+ * patch10: m'$foo' now treats string as single quoted
+ * patch10: certain pattern optimizations were botched
+ * 
+ * Revision 4.0.1.2  91/06/07  12:05:56  lwall
+ * patch4: new copyright notice
+ * patch4: debugger lost track of lines in eval
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: added global modifier for pattern matches
+ * 
+ * Revision 4.0.1.1  91/04/12  09:18:18  lwall
+ * patch1: perl -de "print" wouldn't stop at the first statement
+ * 
+ * Revision 4.0  91/03/20  01:42:14  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "perly.h"
+
+static void set_csh();
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#ifdef f_next
+#undef f_next
+#endif
+
+/* which backslash sequences to keep in m// or s// */
+
+static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
+
+char *reparse;		/* if non-null, scanident found ${foo[$bar]} */
+
+void checkcomma();
+
+#ifdef CLINE
+#undef CLINE
+#endif
+#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
+
+#ifdef atarist
+#define PERL_META(c) ((c) | 128)
+#else
+#define META(c) ((c) | 128)
+#endif
+
+#define RETURN(retval) return (bufptr = s,(int)retval)
+#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
+#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
+#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
+#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
+#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
+#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
+#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
+#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
+#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
+#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
+#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
+#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
+#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
+#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
+#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
+#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
+#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
+#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
+#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
+#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
+#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
+#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
+
+static char *last_uni;
+
+/* 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, \
+	expectterm = TRUE, \
+	bufptr = s, \
+	last_uni = oldbufptr, \
+	(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+/* This does similarly for list operators, merely by pretending that the
+ * paren came before the listop rather than after.
+ */
+#ifdef atarist
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+	(*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
+	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#else
+#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
+	(*s = (char) META('('), bufptr = oldbufptr, '(') : \
+	(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
+#endif
+/* grandfather return to old style */
+#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
+
+char *
+skipspace(s)
+register char *s;
+{
+    while (s < bufend && isSPACE(*s))
+	s++;
+    return s;
+}
+
+void
+check_uni() {
+    char *s;
+    char ch;
+
+    if (oldoldbufptr != last_uni)
+	return;
+    while (isSPACE(*last_uni))
+	last_uni++;
+    for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
+    ch = *s;
+    *s = '\0';
+    warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
+    *s = ch;
+}
+
+#ifdef CRIPPLED_CC
+
+#undef UNI
+#undef LOP
+#define UNI(f) return uni(f,s)
+#define LOP(f) return lop(f,s)
+
+int
+uni(f,s)
+int f;
+char *s;
+{
+    yylval.ival = f;
+    expectterm = TRUE;
+    bufptr = s;
+    last_uni = oldbufptr;
+    if (*s == '(')
+	return FUNC1;
+    s = skipspace(s);
+    if (*s == '(')
+	return FUNC1;
+    else
+	return UNIOP;
+}
+
+int
+lop(f,s)
+int f;
+char *s;
+{
+    CLINE;
+    if (*s != '(')
+	s = skipspace(s);
+    if (*s == '(') {
+#ifdef atarist
+	*s = PERL_META('(');
+#else
+	*s = META('(');
+#endif
+	bufptr = oldbufptr;
+	return '(';
+    }
+    else {
+	yylval.ival=f;
+	expectterm = TRUE;
+	bufptr = s;
+	return LISTOP;
+    }
+}
+
+#endif /* CRIPPLED_CC */
+
+int
+yylex()
+{
+    register char *s = bufptr;
+    register char *d;
+    register int tmp;
+    static bool in_format = FALSE;
+    static bool firstline = TRUE;
+    extern int yychar;		/* last token */
+
+    oldoldbufptr = oldbufptr;
+    oldbufptr = s;
+
+  retry:
+#ifdef YYDEBUG
+    if (debug & 1)
+	if (index(s,'\n'))
+	    fprintf(stderr,"Tokener at %s",s);
+	else
+	    fprintf(stderr,"Tokener at %s\n",s);
+#endif
+#ifdef BADSWITCH
+    if (*s & 128) {
+	if ((*s & 127) == '(') {
+	    *s++ = '(';
+	    oldbufptr = s;
+	}
+	else if ((*s & 127) == '}') {
+	    *s++ = '}';
+	    RETURN('}');
+	}
+	else
+	    warn("Unrecognized character \\%03o ignored", *s++ & 255);
+	goto retry;
+    }
+#endif
+    switch (*s) {
+    default:
+	if ((*s & 127) == '(') {
+	    *s++ = '(';
+	    oldbufptr = s;
+	}
+	else if ((*s & 127) == '}') {
+	    *s++ = '}';
+	    RETURN('}');
+	}
+	else
+	    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)
+	    RETURN(0);
+	if (s++ < bufend)
+	    goto retry;			/* ignore stray nulls */
+	last_uni = 0;
+	if (firstline) {
+	    firstline = FALSE;
+	    if (minus_n || minus_p || perldb) {
+		str_set(linestr,"");
+		if (perldb) {
+		    char *getenv();
+		    char *pdb = getenv("PERLDB");
+
+		    str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
+		    str_cat(linestr, ";");
+		}
+		if (minus_n || minus_p) {
+		    str_cat(linestr,"line: while (<>) {");
+		    if (minus_l)
+			str_cat(linestr,"chop;");
+		    if (minus_a)
+			str_cat(linestr,"@F=split(' ');");
+		}
+		oldoldbufptr = oldbufptr = s = str_get(linestr);
+		bufend = linestr->str_ptr + linestr->str_cur;
+		goto retry;
+	    }
+	}
+	if (in_format) {
+	    bufptr = bufend;
+	    yylval.formval = load_format();
+	    in_format = FALSE;
+	    oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
+	    bufend = linestr->str_ptr + linestr->str_cur;
+	    OPERATOR(FORMLIST);
+	}
+	curcmd->c_line++;
+#ifdef CRYPTSCRIPT
+	cryptswitch();
+#endif /* CRYPTSCRIPT */
+	do {
+	    if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
+	      fake_eof:
+		if (rsfp) {
+		    if (preprocess)
+			(void)mypclose(rsfp);
+		    else if ((FILE*)rsfp == stdin)
+			clearerr(stdin);
+		    else
+			(void)fclose(rsfp);
+		    rsfp = Nullfp;
+		}
+		if (minus_n || minus_p) {
+		    str_set(linestr,minus_p ? ";}continue{print" : "");
+		    str_cat(linestr,";}");
+		    oldoldbufptr = oldbufptr = s = str_get(linestr);
+		    bufend = linestr->str_ptr + linestr->str_cur;
+		    minus_n = minus_p = 0;
+		    goto retry;
+		}
+		oldoldbufptr = oldbufptr = s = str_get(linestr);
+		str_set(linestr,"");
+		RETURN(';');	/* not infinite loop because rsfp is NULL now */
+	    }
+	    if (doextract && *linestr->str_ptr == '#')
+		doextract = FALSE;
+	} while (doextract);
+	oldoldbufptr = oldbufptr = bufptr = s;
+	if (perldb) {
+	    STR *str = Str_new(85,0);
+
+	    str_sset(str,linestr);
+	    astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
+	}
+#ifdef DEBUG
+	if (firstline) {
+	    char *showinput();
+	    s = showinput();
+	}
+#endif
+	bufend = linestr->str_ptr + linestr->str_cur;
+	if (curcmd->c_line == 1) {
+	    if (*s == '#' && s[1] == '!') {
+		if (!in_eval && !instr(s,"perl") && 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);
+		    fatal("Can't exec %s", cmd);
+		}
+	    }
+	    else {
+		while (s < bufend && isSPACE(*s))
+		    s++;
+		if (*s == ':')	/* for csh's that have to exec sh scripts */
+		    s++;
+	    }
+	}
+	goto retry;
+    case ' ': case '\t': case '\f': case '\r': case 013:
+	s++;
+	goto retry;
+    case '#':
+	if (preprocess && s == str_get(linestr) &&
+	       s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
+	    while (*s && !isDIGIT(*s))
+		s++;
+	    curcmd->c_line = atoi(s)-1;
+	    while (isDIGIT(*s))
+		s++;
+	    d = bufend;
+	    while (s < d && isSPACE(*s)) s++;
+	    s[strlen(s)-1] = '\0';	/* wipe out newline */
+	    if (*s == '"') {
+		s++;
+		s[strlen(s)-1] = '\0';	/* wipe out trailing quote */
+	    }
+	    if (*s)
+		curcmd->c_filestab = fstab(s);
+	    else
+		curcmd->c_filestab = fstab(origfilename);
+	    oldoldbufptr = oldbufptr = s = str_get(linestr);
+	}
+	/* FALL THROUGH */
+    case '\n':
+	if (in_eval && !rsfp) {
+	    d = bufend;
+	    while (s < d && *s != '\n')
+		s++;
+	    if (s < d)
+		s++;
+	    if (in_format) {
+		bufptr = s;
+		yylval.formval = load_format();
+		in_format = FALSE;
+		oldoldbufptr = oldbufptr = s = bufptr + 1;
+		TERM(FORMLIST);
+	    }
+	    curcmd->c_line++;
+	}
+	else {
+	    *s = '\0';
+	    bufend = s;
+	}
+	goto retry;
+    case '-':
+	if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
+	    s++;
+	    last_uni = oldbufptr;
+	    switch (*s++) {
+	    case 'r': FTST(O_FTEREAD);
+	    case 'w': FTST(O_FTEWRITE);
+	    case 'x': FTST(O_FTEEXEC);
+	    case 'o': FTST(O_FTEOWNED);
+	    case 'R': FTST(O_FTRREAD);
+	    case 'W': FTST(O_FTRWRITE);
+	    case 'X': FTST(O_FTREXEC);
+	    case 'O': FTST(O_FTROWNED);
+	    case 'e': FTST(O_FTIS);
+	    case 'z': FTST(O_FTZERO);
+	    case 's': FTST(O_FTSIZE);
+	    case 'f': FTST(O_FTFILE);
+	    case 'd': FTST(O_FTDIR);
+	    case 'l': FTST(O_FTLINK);
+	    case 'p': FTST(O_FTPIPE);
+	    case 'S': FTST(O_FTSOCK);
+	    case 'u': FTST(O_FTSUID);
+	    case 'g': FTST(O_FTSGID);
+	    case 'k': FTST(O_FTSVTX);
+	    case 'b': FTST(O_FTBLK);
+	    case 'c': FTST(O_FTCHR);
+	    case 't': FTST(O_FTTTY);
+	    case 'T': FTST(O_FTTEXT);
+	    case 'B': FTST(O_FTBINARY);
+	    case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
+	    case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
+	    case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
+	    default:
+		s -= 2;
+		break;
+	    }
+	}
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    RETURN(DEC);
+	}
+	if (expectterm) {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('-');
+	}
+	else
+	    AOP(O_SUBTRACT);
+    case '+':
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    RETURN(INC);
+	}
+	if (expectterm) {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('+');
+	}
+	else
+	    AOP(O_ADD);
+
+    case '*':
+	if (expectterm) {
+	    check_uni();
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = stabent(tokenbuf,TRUE);
+	    TERM(STAR);
+	}
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    OPERATOR(POW);
+	}
+	MOP(O_MULTIPLY);
+    case '%':
+	if (expectterm) {
+	    if (!isALPHA(s[1]))
+		check_uni();
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = hadd(stabent(tokenbuf,TRUE));
+	    TERM(HSH);
+	}
+	s++;
+	MOP(O_MODULO);
+
+    case '^':
+    case '~':
+    case '(':
+    case ',':
+    case ':':
+    case '[':
+	tmp = *s++;
+	OPERATOR(tmp);
+    case '{':
+	tmp = *s++;
+	yylval.ival = curcmd->c_line;
+	if (isSPACE(*s) || *s == '#')
+	    cmdline = NOLINE;   /* invalidate current command line number */
+	expectterm = 2;
+	RETURN(tmp);
+    case ';':
+	if (curcmd->c_line < cmdline)
+	    cmdline = curcmd->c_line;
+	tmp = *s++;
+	OPERATOR(tmp);
+    case ')':
+    case ']':
+	tmp = *s++;
+	TERM(tmp);
+    case '}':
+	*s |= 128;
+	RETURN(';');
+    case '&':
+	s++;
+	tmp = *s++;
+	if (tmp == '&')
+	    OPERATOR(ANDAND);
+	s--;
+	if (expectterm) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_' || *s == '\'')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    else
+		check_uni();
+	    OPERATOR(AMPER);
+	}
+	OPERATOR('&');
+    case '|':
+	s++;
+	tmp = *s++;
+	if (tmp == '|')
+	    OPERATOR(OROR);
+	s--;
+	OPERATOR('|');
+    case '=':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    EOP(O_EQ);
+	if (tmp == '~')
+	    OPERATOR(MATCH);
+	s--;
+	OPERATOR('=');
+    case '!':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    EOP(O_NE);
+	if (tmp == '~')
+	    OPERATOR(NMATCH);
+	s--;
+	OPERATOR('!');
+    case '<':
+	if (expectterm) {
+	    if (s[1] != '<' && !index(s,'>'))
+		check_uni();
+	    s = scanstr(s, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	s++;
+	tmp = *s++;
+	if (tmp == '<')
+	    OPERATOR(LS);
+	if (tmp == '=') {
+	    tmp = *s++;
+	    if (tmp == '>')
+		EOP(O_NCMP);
+	    s--;
+	    ROP(O_LE);
+	}
+	s--;
+	ROP(O_LT);
+    case '>':
+	s++;
+	tmp = *s++;
+	if (tmp == '>')
+	    OPERATOR(RS);
+	if (tmp == '=')
+	    ROP(O_GE);
+	s--;
+	ROP(O_GT);
+
+#define SNARFWORD \
+	d = tokenbuf; \
+	while (isALNUM(*s) || *s == '\'') \
+	    *d++ = *s++; \
+	while (d[-1] == '\'') \
+	    d--,s--; \
+	*d = '\0'; \
+	d = tokenbuf;
+
+    case '$':
+	if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
+	    s++;
+	    s = scanident(s,bufend,tokenbuf);
+	    yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+	    TERM(ARYLEN);
+	}
+	d = s;
+	s = scanident(s,bufend,tokenbuf);
+	if (reparse) {		/* turn ${foo[bar]} into ($foo[bar]) */
+	  do_reparse:
+	    s[-1] = ')';
+	    s = d;
+	    s[1] = s[0];
+	    s[0] = '(';
+	    goto retry;
+	}
+	yylval.stabval = stabent(tokenbuf,TRUE);
+	expectterm = FALSE;
+	if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
+	    s++;
+	    while (isSPACE(*oldoldbufptr))
+		oldoldbufptr++;
+	    if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
+		if (index("&*<%", *s) && isALPHA(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh &sub */
+		else if (*s == '.' && isDIGIT(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh .3 */
+		else if (index("/?-+", *s) && !isSPACE(s[1]))
+		    expectterm = TRUE;		/* e.g. print $fh -1 */
+	    }
+	}
+	RETURN(REG);
+
+    case '@':
+	d = s;
+	s = scanident(s,bufend,tokenbuf);
+	if (reparse)
+	    goto do_reparse;
+	yylval.stabval = aadd(stabent(tokenbuf,TRUE));
+	TERM(ARY);
+
+    case '/':			/* may either be division or pattern */
+    case '?':			/* may either be conditional or pattern */
+	if (expectterm) {
+	    check_uni();
+	    s = scanpat(s);
+	    TERM(PATTERN);
+	}
+	tmp = *s++;
+	if (tmp == '/')
+	    MOP(O_DIVIDE);
+	OPERATOR(tmp);
+
+    case '.':
+	if (!expectterm || !isDIGIT(s[1])) {
+	    tmp = *s++;
+	    if (*s == tmp) {
+		s++;
+		if (*s == tmp) {
+		    s++;
+		    yylval.ival = 0;
+		}
+		else
+		    yylval.ival = AF_COMMON;
+		OPERATOR(DOTDOT);
+	    }
+	    if (expectterm)
+		check_uni();
+	    AOP(O_CONCAT);
+	}
+	/* FALL THROUGH */
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+    case '\'': case '"': case '`':
+	s = scanstr(s, SCAN_DEF);
+	TERM(RSTRING);
+
+    case '\\':	/* some magic to force next word to be a WORD */
+	s++;	/* used by do and sub to force a separate namespace */
+	if (!isALPHA(*s) && *s != '_' && *s != '\'') {
+	    warn("Spurious backslash ignored");
+	    goto retry;
+	}
+	/* FALL THROUGH */
+    case '_':
+	SNARFWORD;
+	if (d[1] == '_') {
+	    if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
+		ARG *arg = op_new(1);
+
+		yylval.arg = arg;
+		arg->arg_type = O_ITEM;
+		if (d[2] == 'L')
+		    (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
+		else
+		    strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
+		arg[1].arg_type = A_SINGLE;
+		arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
+		TERM(RSTRING);
+	    }
+	    else if (strEQ(d,"__END__")) {
+		STAB *stab;
+		int fd;
+
+		/*SUPPRESS 560*/
+		if (!in_eval && (stab = stabent("DATA",FALSE))) {
+		    stab->str_pok |= SP_MULTI;
+		    if (!stab_io(stab))
+			stab_io(stab) = stio_new();
+		    stab_io(stab)->ifp = rsfp;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+		    fd = fileno(rsfp);
+		    fcntl(fd,F_SETFD,fd >= 3);
+#endif
+		    if (preprocess)
+			stab_io(stab)->type = '|';
+		    else if ((FILE*)rsfp == stdin)
+			stab_io(stab)->type = '-';
+		    else
+			stab_io(stab)->type = '<';
+		    rsfp = Nullfp;
+		}
+		goto fake_eof;
+	    }
+	}
+	break;
+    case 'a': case 'A':
+	SNARFWORD;
+	if (strEQ(d,"alarm"))
+	    UNI(O_ALARM);
+	if (strEQ(d,"accept"))
+	    FOP22(O_ACCEPT);
+	if (strEQ(d,"atan2"))
+	    FUN2(O_ATAN2);
+	break;
+    case 'b': case 'B':
+	SNARFWORD;
+	if (strEQ(d,"bind"))
+	    FOP2(O_BIND);
+	if (strEQ(d,"binmode"))
+	    FOP(O_BINMODE);
+	break;
+    case 'c': case 'C':
+	SNARFWORD;
+	if (strEQ(d,"chop"))
+	    LFUN(O_CHOP);
+	if (strEQ(d,"continue"))
+	    OPERATOR(CONTINUE);
+	if (strEQ(d,"chdir")) {
+	    (void)stabent("ENV",TRUE);	/* may use HOME */
+	    UNI(O_CHDIR);
+	}
+	if (strEQ(d,"close"))
+	    FOP(O_CLOSE);
+	if (strEQ(d,"closedir"))
+	    FOP(O_CLOSEDIR);
+	if (strEQ(d,"cmp"))
+	    EOP(O_SCMP);
+	if (strEQ(d,"caller"))
+	    UNI(O_CALLER);
+	if (strEQ(d,"crypt")) {
+#ifdef FCRYPT
+	    static int cryptseen = 0;
+
+	    if (!cryptseen++)
+		init_des();
+#endif
+	    FUN2(O_CRYPT);
+	}
+	if (strEQ(d,"chmod"))
+	    LOP(O_CHMOD);
+	if (strEQ(d,"chown"))
+	    LOP(O_CHOWN);
+	if (strEQ(d,"connect"))
+	    FOP2(O_CONNECT);
+	if (strEQ(d,"cos"))
+	    UNI(O_COS);
+	if (strEQ(d,"chroot"))
+	    UNI(O_CHROOT);
+	break;
+    case 'd': case 'D':
+	SNARFWORD;
+	if (strEQ(d,"do")) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    OPERATOR(DO);
+	}
+	if (strEQ(d,"die"))
+	    LOP(O_DIE);
+	if (strEQ(d,"defined"))
+	    LFUN(O_DEFINED);
+	if (strEQ(d,"delete"))
+	    OPERATOR(DELETE);
+	if (strEQ(d,"dbmopen"))
+	    HFUN3(O_DBMOPEN);
+	if (strEQ(d,"dbmclose"))
+	    HFUN(O_DBMCLOSE);
+	if (strEQ(d,"dump"))
+	    LOOPX(O_DUMP);
+	break;
+    case 'e': case 'E':
+	SNARFWORD;
+	if (strEQ(d,"else"))
+	    OPERATOR(ELSE);
+	if (strEQ(d,"elsif")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(ELSIF);
+	}
+	if (strEQ(d,"eq") || strEQ(d,"EQ"))
+	    EOP(O_SEQ);
+	if (strEQ(d,"exit"))
+	    UNI(O_EXIT);
+	if (strEQ(d,"eval")) {
+	    allstabs = TRUE;		/* must initialize everything since */
+	    UNI(O_EVAL);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"eof"))
+	    FOP(O_EOF);
+	if (strEQ(d,"exp"))
+	    UNI(O_EXP);
+	if (strEQ(d,"each"))
+	    HFUN(O_EACH);
+	if (strEQ(d,"exec")) {
+	    set_csh();
+	    LOP(O_EXEC_OP);
+	}
+	if (strEQ(d,"endhostent"))
+	    FUN0(O_EHOSTENT);
+	if (strEQ(d,"endnetent"))
+	    FUN0(O_ENETENT);
+	if (strEQ(d,"endservent"))
+	    FUN0(O_ESERVENT);
+	if (strEQ(d,"endprotoent"))
+	    FUN0(O_EPROTOENT);
+	if (strEQ(d,"endpwent"))
+	    FUN0(O_EPWENT);
+	if (strEQ(d,"endgrent"))
+	    FUN0(O_EGRENT);
+	break;
+    case 'f': case 'F':
+	SNARFWORD;
+	if (strEQ(d,"for") || strEQ(d,"foreach")) {
+	    yylval.ival = curcmd->c_line;
+	    while (s < bufend && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s))
+		fatal("Missing $ on loop variable");
+	    OPERATOR(FOR);
+	}
+	if (strEQ(d,"format")) {
+	    d = bufend;
+	    while (s < d && isSPACE(*s))
+		s++;
+	    if (isALPHA(*s) || *s == '_')
+		*(--s) = '\\';	/* force next ident to WORD */
+	    in_format = TRUE;
+	    allstabs = TRUE;		/* must initialize everything since */
+	    OPERATOR(FORMAT);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"fork"))
+	    FUN0(O_FORK);
+	if (strEQ(d,"fcntl"))
+	    FOP3(O_FCNTL);
+	if (strEQ(d,"fileno"))
+	    FOP(O_FILENO);
+	if (strEQ(d,"flock"))
+	    FOP2(O_FLOCK);
+	break;
+    case 'g': case 'G':
+	SNARFWORD;
+	if (strEQ(d,"gt") || strEQ(d,"GT"))
+	    ROP(O_SGT);
+	if (strEQ(d,"ge") || strEQ(d,"GE"))
+	    ROP(O_SGE);
+	if (strEQ(d,"grep"))
+	    FL2(O_GREP);
+	if (strEQ(d,"goto"))
+	    LOOPX(O_GOTO);
+	if (strEQ(d,"gmtime"))
+	    UNI(O_GMTIME);
+	if (strEQ(d,"getc"))
+	    FOP(O_GETC);
+	if (strnEQ(d,"get",3)) {
+	    d += 3;
+	    if (*d == 'p') {
+		if (strEQ(d,"ppid"))
+		    FUN0(O_GETPPID);
+		if (strEQ(d,"pgrp"))
+		    UNI(O_GETPGRP);
+		if (strEQ(d,"priority"))
+		    FUN2(O_GETPRIORITY);
+		if (strEQ(d,"protobyname"))
+		    UNI(O_GPBYNAME);
+		if (strEQ(d,"protobynumber"))
+		    FUN1(O_GPBYNUMBER);
+		if (strEQ(d,"protoent"))
+		    FUN0(O_GPROTOENT);
+		if (strEQ(d,"pwent"))
+		    FUN0(O_GPWENT);
+		if (strEQ(d,"pwnam"))
+		    FUN1(O_GPWNAM);
+		if (strEQ(d,"pwuid"))
+		    FUN1(O_GPWUID);
+		if (strEQ(d,"peername"))
+		    FOP(O_GETPEERNAME);
+	    }
+	    else if (*d == 'h') {
+		if (strEQ(d,"hostbyname"))
+		    UNI(O_GHBYNAME);
+		if (strEQ(d,"hostbyaddr"))
+		    FUN2(O_GHBYADDR);
+		if (strEQ(d,"hostent"))
+		    FUN0(O_GHOSTENT);
+	    }
+	    else if (*d == 'n') {
+		if (strEQ(d,"netbyname"))
+		    UNI(O_GNBYNAME);
+		if (strEQ(d,"netbyaddr"))
+		    FUN2(O_GNBYADDR);
+		if (strEQ(d,"netent"))
+		    FUN0(O_GNETENT);
+	    }
+	    else if (*d == 's') {
+		if (strEQ(d,"servbyname"))
+		    FUN2(O_GSBYNAME);
+		if (strEQ(d,"servbyport"))
+		    FUN2(O_GSBYPORT);
+		if (strEQ(d,"servent"))
+		    FUN0(O_GSERVENT);
+		if (strEQ(d,"sockname"))
+		    FOP(O_GETSOCKNAME);
+		if (strEQ(d,"sockopt"))
+		    FOP3(O_GSOCKOPT);
+	    }
+	    else if (*d == 'g') {
+		if (strEQ(d,"grent"))
+		    FUN0(O_GGRENT);
+		if (strEQ(d,"grnam"))
+		    FUN1(O_GGRNAM);
+		if (strEQ(d,"grgid"))
+		    FUN1(O_GGRGID);
+	    }
+	    else if (*d == 'l') {
+		if (strEQ(d,"login"))
+		    FUN0(O_GETLOGIN);
+	    }
+	    d -= 3;
+	}
+	break;
+    case 'h': case 'H':
+	SNARFWORD;
+	if (strEQ(d,"hex"))
+	    UNI(O_HEX);
+	break;
+    case 'i': case 'I':
+	SNARFWORD;
+	if (strEQ(d,"if")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(IF);
+	}
+	if (strEQ(d,"index"))
+	    FUN2x(O_INDEX);
+	if (strEQ(d,"int"))
+	    UNI(O_INT);
+	if (strEQ(d,"ioctl"))
+	    FOP3(O_IOCTL);
+	break;
+    case 'j': case 'J':
+	SNARFWORD;
+	if (strEQ(d,"join"))
+	    FL2(O_JOIN);
+	break;
+    case 'k': case 'K':
+	SNARFWORD;
+	if (strEQ(d,"keys"))
+	    HFUN(O_KEYS);
+	if (strEQ(d,"kill"))
+	    LOP(O_KILL);
+	break;
+    case 'l': case 'L':
+	SNARFWORD;
+	if (strEQ(d,"last"))
+	    LOOPX(O_LAST);
+	if (strEQ(d,"local"))
+	    OPERATOR(LOCAL);
+	if (strEQ(d,"length"))
+	    UNI(O_LENGTH);
+	if (strEQ(d,"lt") || strEQ(d,"LT"))
+	    ROP(O_SLT);
+	if (strEQ(d,"le") || strEQ(d,"LE"))
+	    ROP(O_SLE);
+	if (strEQ(d,"localtime"))
+	    UNI(O_LOCALTIME);
+	if (strEQ(d,"log"))
+	    UNI(O_LOG);
+	if (strEQ(d,"link"))
+	    FUN2(O_LINK);
+	if (strEQ(d,"listen"))
+	    FOP2(O_LISTEN);
+	if (strEQ(d,"lstat"))
+	    FOP(O_LSTAT);
+	break;
+    case 'm': case 'M':
+	if (s[1] == '\'') {
+	    d = "m";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"m")) {
+	    s = scanpat(s-1);
+	    if (yylval.arg)
+		TERM(PATTERN);
+	    else
+		RETURN(1);	/* force error */
+	}
+	switch (d[1]) {
+	case 'k':
+	    if (strEQ(d,"mkdir"))
+		FUN2(O_MKDIR);
+	    break;
+	case 's':
+	    if (strEQ(d,"msgctl"))
+		FUN3(O_MSGCTL);
+	    if (strEQ(d,"msgget"))
+		FUN2(O_MSGGET);
+	    if (strEQ(d,"msgrcv"))
+		FUN5(O_MSGRCV);
+	    if (strEQ(d,"msgsnd"))
+		FUN3(O_MSGSND);
+	    break;
+	}
+	break;
+    case 'n': case 'N':
+	SNARFWORD;
+	if (strEQ(d,"next"))
+	    LOOPX(O_NEXT);
+	if (strEQ(d,"ne") || strEQ(d,"NE"))
+	    EOP(O_SNE);
+	break;
+    case 'o': case 'O':
+	SNARFWORD;
+	if (strEQ(d,"open"))
+	    OPERATOR(OPEN);
+	if (strEQ(d,"ord"))
+	    UNI(O_ORD);
+	if (strEQ(d,"oct"))
+	    UNI(O_OCT);
+	if (strEQ(d,"opendir"))
+	    FOP2(O_OPEN_DIR);
+	break;
+    case 'p': case 'P':
+	SNARFWORD;
+	if (strEQ(d,"print")) {
+	    checkcomma(s,d,"filehandle");
+	    LOP(O_PRINT);
+	}
+	if (strEQ(d,"printf")) {
+	    checkcomma(s,d,"filehandle");
+	    LOP(O_PRTF);
+	}
+	if (strEQ(d,"push")) {
+	    yylval.ival = O_PUSH;
+	    OPERATOR(PUSH);
+	}
+	if (strEQ(d,"pop"))
+	    OPERATOR(POP);
+	if (strEQ(d,"pack"))
+	    FL2(O_PACK);
+	if (strEQ(d,"package"))
+	    OPERATOR(PACKAGE);
+	if (strEQ(d,"pipe"))
+	    FOP22(O_PIPE_OP);
+	break;
+    case 'q': case 'Q':
+	SNARFWORD;
+	if (strEQ(d,"q")) {
+	    s = scanstr(s-1, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"qq")) {
+	    s = scanstr(s-2, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"qx")) {
+	    s = scanstr(s-2, SCAN_DEF);
+	    TERM(RSTRING);
+	}
+	break;
+    case 'r': case 'R':
+	SNARFWORD;
+	if (strEQ(d,"return"))
+	    OLDLOP(O_RETURN);
+	if (strEQ(d,"require")) {
+	    allstabs = TRUE;		/* must initialize everything since */
+	    UNI(O_REQUIRE);		/* we don't know what will be used */
+	}
+	if (strEQ(d,"reset"))
+	    UNI(O_RESET);
+	if (strEQ(d,"redo"))
+	    LOOPX(O_REDO);
+	if (strEQ(d,"rename"))
+	    FUN2(O_RENAME);
+	if (strEQ(d,"rand"))
+	    UNI(O_RAND);
+	if (strEQ(d,"rmdir"))
+	    UNI(O_RMDIR);
+	if (strEQ(d,"rindex"))
+	    FUN2x(O_RINDEX);
+	if (strEQ(d,"read"))
+	    FOP3(O_READ);
+	if (strEQ(d,"readdir"))
+	    FOP(O_READDIR);
+	if (strEQ(d,"rewinddir"))
+	    FOP(O_REWINDDIR);
+	if (strEQ(d,"recv"))
+	    FOP4(O_RECV);
+	if (strEQ(d,"reverse"))
+	    LOP(O_REVERSE);
+	if (strEQ(d,"readlink"))
+	    UNI(O_READLINK);
+	break;
+    case 's': case 'S':
+	if (s[1] == '\'') {
+	    d = "s";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"s")) {
+	    s = scansubst(s);
+	    if (yylval.arg)
+		TERM(SUBST);
+	    else
+		RETURN(1);	/* force error */
+	}
+	switch (d[1]) {
+	case 'a':
+	case 'b':
+	    break;
+	case 'c':
+	    if (strEQ(d,"scalar"))
+		UNI(O_SCALAR);
+	    break;
+	case 'd':
+	    break;
+	case 'e':
+	    if (strEQ(d,"select"))
+		OPERATOR(SSELECT);
+	    if (strEQ(d,"seek"))
+		FOP3(O_SEEK);
+	    if (strEQ(d,"semctl"))
+		FUN4(O_SEMCTL);
+	    if (strEQ(d,"semget"))
+		FUN3(O_SEMGET);
+	    if (strEQ(d,"semop"))
+		FUN2(O_SEMOP);
+	    if (strEQ(d,"send"))
+		FOP3(O_SEND);
+	    if (strEQ(d,"setpgrp"))
+		FUN2(O_SETPGRP);
+	    if (strEQ(d,"setpriority"))
+		FUN3(O_SETPRIORITY);
+	    if (strEQ(d,"sethostent"))
+		FUN1(O_SHOSTENT);
+	    if (strEQ(d,"setnetent"))
+		FUN1(O_SNETENT);
+	    if (strEQ(d,"setservent"))
+		FUN1(O_SSERVENT);
+	    if (strEQ(d,"setprotoent"))
+		FUN1(O_SPROTOENT);
+	    if (strEQ(d,"setpwent"))
+		FUN0(O_SPWENT);
+	    if (strEQ(d,"setgrent"))
+		FUN0(O_SGRENT);
+	    if (strEQ(d,"seekdir"))
+		FOP2(O_SEEKDIR);
+	    if (strEQ(d,"setsockopt"))
+		FOP4(O_SSOCKOPT);
+	    break;
+	case 'f':
+	case 'g':
+	    break;
+	case 'h':
+	    if (strEQ(d,"shift"))
+		TERM(SHIFT);
+	    if (strEQ(d,"shmctl"))
+		FUN3(O_SHMCTL);
+	    if (strEQ(d,"shmget"))
+		FUN3(O_SHMGET);
+	    if (strEQ(d,"shmread"))
+		FUN4(O_SHMREAD);
+	    if (strEQ(d,"shmwrite"))
+		FUN4(O_SHMWRITE);
+	    if (strEQ(d,"shutdown"))
+		FOP2(O_SHUTDOWN);
+	    break;
+	case 'i':
+	    if (strEQ(d,"sin"))
+		UNI(O_SIN);
+	    break;
+	case 'j':
+	case 'k':
+	    break;
+	case 'l':
+	    if (strEQ(d,"sleep"))
+		UNI(O_SLEEP);
+	    break;
+	case 'm':
+	case 'n':
+	    break;
+	case 'o':
+	    if (strEQ(d,"socket"))
+		FOP4(O_SOCKET);
+	    if (strEQ(d,"socketpair"))
+		FOP25(O_SOCKPAIR);
+	    if (strEQ(d,"sort")) {
+		checkcomma(s,d,"subroutine name");
+		d = bufend;
+		while (s < d && isSPACE(*s)) s++;
+		if (*s == ';' || *s == ')')		/* probably a close */
+		    fatal("sort is now a reserved word");
+		if (isALPHA(*s) || *s == '_') {
+		    /*SUPPRESS 530*/
+		    for (d = s; isALNUM(*d); d++) ;
+		    strncpy(tokenbuf,s,d-s);
+		    tokenbuf[d-s] = '\0';
+		    if (strNE(tokenbuf,"keys") &&
+			strNE(tokenbuf,"values") &&
+			strNE(tokenbuf,"split") &&
+			strNE(tokenbuf,"grep") &&
+			strNE(tokenbuf,"readdir") &&
+			strNE(tokenbuf,"unpack") &&
+			strNE(tokenbuf,"do") &&
+			strNE(tokenbuf,"eval") &&
+			(d >= bufend || isSPACE(*d)) )
+			*(--s) = '\\';	/* force next ident to WORD */
+		}
+		LOP(O_SORT);
+	    }
+	    break;
+	case 'p':
+	    if (strEQ(d,"split"))
+		TERM(SPLIT);
+	    if (strEQ(d,"sprintf"))
+		FL(O_SPRINTF);
+	    if (strEQ(d,"splice")) {
+		yylval.ival = O_SPLICE;
+		OPERATOR(PUSH);
+	    }
+	    break;
+	case 'q':
+	    if (strEQ(d,"sqrt"))
+		UNI(O_SQRT);
+	    break;
+	case 'r':
+	    if (strEQ(d,"srand"))
+		UNI(O_SRAND);
+	    break;
+	case 's':
+	    break;
+	case 't':
+	    if (strEQ(d,"stat"))
+		FOP(O_STAT);
+	    if (strEQ(d,"study")) {
+		sawstudy++;
+		LFUN(O_STUDY);
+	    }
+	    break;
+	case 'u':
+	    if (strEQ(d,"substr"))
+		FUN2x(O_SUBSTR);
+	    if (strEQ(d,"sub")) {
+		yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
+		savelong(&subline);
+		saveitem(subname);
+
+		subline = curcmd->c_line;
+		d = bufend;
+		while (s < d && isSPACE(*s))
+		    s++;
+		if (isALPHA(*s) || *s == '_' || *s == '\'') {
+		    str_sset(subname,curstname);
+		    str_ncat(subname,"'",1);
+		    for (d = s+1; isALNUM(*d) || *d == '\''; d++)
+			/*SUPPRESS 530*/
+			;
+		    if (d[-1] == '\'')
+			d--;
+		    str_ncat(subname,s,d-s);
+		    *(--s) = '\\';	/* force next ident to WORD */
+		}
+		else
+		    str_set(subname,"?");
+		OPERATOR(SUB);
+	    }
+	    break;
+	case 'v':
+	case 'w':
+	case 'x':
+	    break;
+	case 'y':
+	    if (strEQ(d,"system")) {
+		set_csh();
+		LOP(O_SYSTEM);
+	    }
+	    if (strEQ(d,"symlink"))
+		FUN2(O_SYMLINK);
+	    if (strEQ(d,"syscall"))
+		LOP(O_SYSCALL);
+	    if (strEQ(d,"sysread"))
+		FOP3(O_SYSREAD);
+	    if (strEQ(d,"syswrite"))
+		FOP3(O_SYSWRITE);
+	    break;
+	case 'z':
+	    break;
+	}
+	break;
+    case 't': case 'T':
+	SNARFWORD;
+	if (strEQ(d,"tr")) {
+	    s = scantrans(s);
+	    if (yylval.arg)
+		TERM(TRANS);
+	    else
+		RETURN(1);	/* force error */
+	}
+	if (strEQ(d,"tell"))
+	    FOP(O_TELL);
+	if (strEQ(d,"telldir"))
+	    FOP(O_TELLDIR);
+	if (strEQ(d,"time"))
+	    FUN0(O_TIME);
+	if (strEQ(d,"times"))
+	    FUN0(O_TMS);
+	if (strEQ(d,"truncate"))
+	    FOP2(O_TRUNCATE);
+	break;
+    case 'u': case 'U':
+	SNARFWORD;
+	if (strEQ(d,"using"))
+	    OPERATOR(USING);
+	if (strEQ(d,"until")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(UNTIL);
+	}
+	if (strEQ(d,"unless")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(UNLESS);
+	}
+	if (strEQ(d,"unlink"))
+	    LOP(O_UNLINK);
+	if (strEQ(d,"undef"))
+	    LFUN(O_UNDEF);
+	if (strEQ(d,"unpack"))
+	    FUN2(O_UNPACK);
+	if (strEQ(d,"utime"))
+	    LOP(O_UTIME);
+	if (strEQ(d,"umask"))
+	    UNI(O_UMASK);
+	if (strEQ(d,"unshift")) {
+	    yylval.ival = O_UNSHIFT;
+	    OPERATOR(PUSH);
+	}
+	break;
+    case 'v': case 'V':
+	SNARFWORD;
+	if (strEQ(d,"values"))
+	    HFUN(O_VALUES);
+	if (strEQ(d,"vec")) {
+	    sawvec = TRUE;
+	    FUN3(O_VEC);
+	}
+	break;
+    case 'w': case 'W':
+	SNARFWORD;
+	if (strEQ(d,"while")) {
+	    yylval.ival = curcmd->c_line;
+	    OPERATOR(WHILE);
+	}
+	if (strEQ(d,"warn"))
+	    LOP(O_WARN);
+	if (strEQ(d,"wait"))
+	    FUN0(O_WAIT);
+	if (strEQ(d,"waitpid"))
+	    FUN2(O_WAITPID);
+	if (strEQ(d,"wantarray")) {
+	    yylval.arg = op_new(1);
+	    yylval.arg->arg_type = O_ITEM;
+	    yylval.arg[1].arg_type = A_WANTARRAY;
+	    TERM(RSTRING);
+	}
+	if (strEQ(d,"write"))
+	    FOP(O_WRITE);
+	break;
+    case 'x': case 'X':
+	if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
+	    s++;
+	    MOP(O_REPEAT);
+	}
+	SNARFWORD;
+	if (strEQ(d,"x")) {
+	    if (!expectterm)
+		MOP(O_REPEAT);
+	    check_uni();
+	}
+	break;
+    case 'y': case 'Y':
+	if (s[1] == '\'') {
+	    d = "y";
+	    s++;
+	}
+	else {
+	    SNARFWORD;
+	}
+	if (strEQ(d,"y")) {
+	    s = scantrans(s);
+	    TERM(TRANS);
+	}
+	break;
+    case 'z': case 'Z':
+	SNARFWORD;
+	break;
+    }
+    yylval.cval = savestr(d);
+    if (expectterm == 2) {		/* special case: start of statement */
+	while (isSPACE(*s)) s++;
+	if (*s == ':') {
+	    s++;
+	    CLINE;
+	    OPERATOR(LABEL);
+	}
+	TERM(WORD);
+    }
+    expectterm = FALSE;
+    if (oldoldbufptr && oldoldbufptr < bufptr) {
+	while (isSPACE(*oldoldbufptr))
+	    oldoldbufptr++;
+	if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
+	    expectterm = TRUE;
+	else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
+	    expectterm = TRUE;
+    }
+    return (CLINE, bufptr = s, (int)WORD);
+}
+
+void
+checkcomma(s,name,what)
+register char *s;
+char *name;
+char *what;
+{
+    char *w;
+
+    if (dowarn && *s == ' ' && s[1] == '(') {
+	w = index(s,')');
+	if (w)
+	    for (w++; *w && isSPACE(*w); w++) ;
+	if (!w || !*w || !index(";|}", *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 (isALPHA(*s) || *s == '_') {
+	w = s++;
+	while (isALNUM(*s))
+	    s++;
+	while (s < bufend && isSPACE(*s))
+	    s++;
+	if (*s == ',') {
+	    *s = '\0';
+	    w = instr(
+	      "tell eof times getlogin wait length shift umask getppid \
+	      cos exp int log rand sin sqrt ord wantarray",
+	      w);
+	    *s = ',';
+	    if (w)
+		return;
+	    fatal("No comma allowed after %s", what);
+	}
+    }
+}
+
+char *
+scanident(s,send,dest)
+register char *s;
+register char *send;
+char *dest;
+{
+    register char *d;
+    int brackets = 0;
+
+    reparse = Nullch;
+    s++;
+    d = dest;
+    if (isDIGIT(*s)) {
+	while (isDIGIT(*s))
+	    *d++ = *s++;
+    }
+    else {
+	while (isALNUM(*s) || *s == '\'')
+	    *d++ = *s++;
+    }
+    while (d > dest+1 && d[-1] == '\'')
+	d--,s--;
+    *d = '\0';
+    d = dest;
+    if (!*d) {
+	*d = *s++;
+	if (*d == '{' /* } */ ) {
+	    d = dest;
+	    brackets++;
+	    while (s < send && brackets) {
+		if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
+		    *d++ = *s++;
+		    continue;
+		}
+		else if (!reparse)
+		    reparse = s;
+		switch (*s++) {
+		/* { */
+		case '}':
+		    brackets--;
+		    if (reparse && reparse == s - 1)
+			reparse = Nullch;
+		    break;
+		case '{':   /* } */
+		    brackets++;
+		    break;
+		}
+	    }
+	    *d = '\0';
+	    d = dest;
+	}
+	else
+	    d[1] = '\0';
+    }
+    if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
+#ifdef DEBUGGING
+	if (*s == 'D')
+	    debug |= 32768;
+#endif
+	*d = *s++ ^ 64;
+    }
+    return s;
+}
+
+void
+scanconst(spat,string,len)
+SPAT *spat;
+char *string;
+int len;
+{
+    register STR *tmpstr;
+    register char *t;
+    register char *d;
+    register char *e;
+    char *origstring = string;
+    static char *vert = "|";
+
+    if (ninstr(string, string+len, vert, vert+1))
+	return;
+    if (*string == '^')
+	string++, len--;
+    tmpstr = Str_new(86,len);
+    str_nset(tmpstr,string,len);
+    t = str_get(tmpstr);
+    e = t + len;
+    tmpstr->str_u.str_useful = 100;
+    for (d=t; d < e; ) {
+	switch (*d) {
+	case '{':
+	    if (isDIGIT(d[1]))
+		e = d;
+	    else
+		goto defchar;
+	    break;
+	case '.': case '[': case '$': case '(': case ')': case '|': case '+':
+	case '^':
+	    e = d;
+	    break;
+	case '\\':
+	    if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
+		e = d;
+		break;
+	    }
+	    Move(d+1,d,e-d,char);
+	    e--;
+	    switch(*d) {
+	    case 'n':
+		*d = '\n';
+		break;
+	    case 't':
+		*d = '\t';
+		break;
+	    case 'f':
+		*d = '\f';
+		break;
+	    case 'r':
+		*d = '\r';
+		break;
+	    case 'e':
+		*d = '\033';
+		break;
+	    case 'a':
+		*d = '\007';
+		break;
+	    }
+	    /* FALL THROUGH */
+	default:
+	  defchar:
+	    if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
+		e = d;
+		break;
+	    }
+	    d++;
+	}
+    }
+    if (d == t) {
+	str_free(tmpstr);
+	return;
+    }
+    *d = '\0';
+    tmpstr->str_cur = d - t;
+    if (d == t+len)
+	spat->spat_flags |= SPAT_ALL;
+    if (*origstring != '^')
+	spat->spat_flags |= SPAT_SCANFIRST;
+    spat->spat_short = tmpstr;
+    spat->spat_slen = d - t;
+}
+
+char *
+scanpat(s)
+register char *s;
+{
+    register SPAT *spat;
+    register char *d;
+    register char *e;
+    int len;
+    SPAT savespat;
+    STR *str = Str_new(93,0);
+    char delim;
+
+    Newz(801,spat,1,SPAT);
+    spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
+    curstash->tbl_spatroot = spat;
+
+    switch (*s++) {
+    case 'm':
+	s++;
+	break;
+    case '/':
+	break;
+    case '?':
+	spat->spat_flags |= SPAT_ONCE;
+	break;
+    default:
+	fatal("panic: scanpat");
+    }
+    s = str_append_till(str,s,bufend,s[-1],patleave);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Search pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    delim = *s++;
+    while (*s == 'i' || *s == 'o' || *s == 'g') {
+	if (*s == 'i') {
+	    s++;
+	    sawi = TRUE;
+	    spat->spat_flags |= SPAT_FOLD;
+	}
+	if (*s == 'o') {
+	    s++;
+	    spat->spat_flags |= SPAT_KEEP;
+	}
+	if (*s == 'g') {
+	    s++;
+	    spat->spat_flags |= SPAT_GLOBAL;
+	}
+    }
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    if (delim == '\'')
+	d = e;
+    else
+	d = str->str_ptr;
+    for (; d < e; d++) {
+	if (*d == '\\')
+	    d++;
+	else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
+		 (*d == '@')) {
+	    register ARG *arg;
+
+	    spat->spat_runtime = arg = op_new(1);
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_DOUBLE;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
+	    d = scanident(d,bufend,buf);
+	    (void)stabent(buf,TRUE);		/* make sure it's created */
+	    for (; d < e; d++) {
+		if (*d == '\\')
+		    d++;
+		else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
+		    d = scanident(d,bufend,buf);
+		    (void)stabent(buf,TRUE);
+		}
+		else if (*d == '@') {
+		    d = scanident(d,bufend,buf);
+		    if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+		      strEQ(buf,"SIG") || strEQ(buf,"INC"))
+			(void)stabent(buf,TRUE);
+		}
+	    }
+	    goto got_pat;		/* skip compiling for now */
+	}
+    }
+    if (spat->spat_flags & SPAT_FOLD)
+	StructCopy(spat, &savespat, SPAT);
+    scanconst(spat,str->str_ptr,len);
+    if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
+	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	    spat->spat_flags & SPAT_FOLD);
+		/* Note that this regexp can still be used if someone says
+		 * something like /a/ && s//b/;  so we can't delete it.
+		 */
+    }
+    else {
+	if (spat->spat_flags & SPAT_FOLD)
+	StructCopy(&savespat, spat, SPAT);
+	if (spat->spat_short)
+	    fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	    spat->spat_flags & SPAT_FOLD);
+	hoistmust(spat);
+    }
+  got_pat:
+    str_free(str);
+    yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
+    return s;
+}
+
+char *
+scansubst(start)
+char *start;
+{
+    register char *s = start;
+    register SPAT *spat;
+    register char *d;
+    register char *e;
+    int len;
+    STR *str = Str_new(93,0);
+    char term = *s;
+
+    if (term && (d = index("([{< )]}> )]}>",term)))
+	term = d[5];
+
+    Newz(802,spat,1,SPAT);
+    spat->spat_next = curstash->tbl_spatroot;	/* link into spat list */
+    curstash->tbl_spatroot = spat;
+
+    s = str_append_till(str,s+1,bufend,term,patleave);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Substitution pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    len = str->str_cur;
+    e = str->str_ptr + len;
+    for (d = str->str_ptr; d < e; d++) {
+	if (*d == '\\')
+	    d++;
+	else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
+	    *d == '@' ) {
+	    register ARG *arg;
+
+	    spat->spat_runtime = arg = op_new(1);
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_DOUBLE;
+	    arg[1].arg_ptr.arg_str = str_smake(str);
+	    d = scanident(d,e,buf);
+	    (void)stabent(buf,TRUE);		/* make sure it's created */
+	    for (; *d; d++) {
+		if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
+		    d = scanident(d,e,buf);
+		    (void)stabent(buf,TRUE);
+		}
+		else if (*d == '@' && d[-1] != '\\') {
+		    d = scanident(d,e,buf);
+		    if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
+		      strEQ(buf,"SIG") || strEQ(buf,"INC"))
+			(void)stabent(buf,TRUE);
+		}
+	    }
+	    goto get_repl;		/* skip compiling for now */
+	}
+    }
+    scanconst(spat,str->str_ptr,len);
+get_repl:
+    if (term != *start)
+	s++;
+    s = scanstr(s, SCAN_REPL);
+    if (s >= bufend) {
+	str_free(str);
+	yyerror("Substitution replacement not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    spat->spat_repl = yylval.arg;
+    if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
+	spat->spat_flags |= SPAT_CONST;
+    else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
+	STR *tmpstr;
+	register char *t;
+
+	spat->spat_flags |= SPAT_CONST;
+	tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
+	e = tmpstr->str_ptr + tmpstr->str_cur;
+	for (t = tmpstr->str_ptr; t < e; t++) {
+	    if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
+	      (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
+		spat->spat_flags &= ~SPAT_CONST;
+	}
+    }
+    while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
+	int es = 0;
+
+	if (*s == 'e') {
+	    s++;
+	    es++;
+	    if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
+		spat->spat_repl[1].arg_type = A_SINGLE;
+	    spat->spat_repl = make_op(
+		(!es && spat->spat_repl[1].arg_type == A_SINGLE
+			? O_EVALONCE
+			: O_EVAL),
+		2,
+		spat->spat_repl,
+		Nullarg,
+		Nullarg);
+	    spat->spat_flags &= ~SPAT_CONST;
+	}
+	if (*s == 'g') {
+	    s++;
+	    spat->spat_flags |= SPAT_GLOBAL;
+	}
+	if (*s == 'i') {
+	    s++;
+	    sawi = TRUE;
+	    spat->spat_flags |= SPAT_FOLD;
+	    if (!(spat->spat_flags & SPAT_SCANFIRST)) {
+		str_free(spat->spat_short);	/* anchored opt doesn't do */
+		spat->spat_short = Nullstr;	/* case insensitive match */
+		spat->spat_slen = 0;
+	    }
+	}
+	if (*s == 'o') {
+	    s++;
+	    spat->spat_flags |= SPAT_KEEP;
+	}
+    }
+    if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
+	fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
+    if (!spat->spat_runtime) {
+	spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
+	  spat->spat_flags & SPAT_FOLD);
+	hoistmust(spat);
+    }
+    yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
+    str_free(str);
+    return s;
+}
+
+void
+hoistmust(spat)
+register SPAT *spat;
+{
+    if (!spat->spat_short && spat->spat_regexp->regstart &&
+	(!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
+       ) {
+	if (!(spat->spat_regexp->reganch & ROPT_ANCH))
+	    spat->spat_flags |= SPAT_SCANFIRST;
+	else if (spat->spat_flags & SPAT_FOLD)
+	    return;
+	spat->spat_short = str_smake(spat->spat_regexp->regstart);
+    }
+    else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
+	if (spat->spat_short &&
+	  str_eq(spat->spat_short,spat->spat_regexp->regmust))
+	{
+	    if (spat->spat_flags & SPAT_SCANFIRST) {
+		str_free(spat->spat_short);
+		spat->spat_short = Nullstr;
+	    }
+	    else {
+		str_free(spat->spat_regexp->regmust);
+		spat->spat_regexp->regmust = Nullstr;
+		return;
+	    }
+	}
+	if (!spat->spat_short ||	/* promote the better string */
+	  ((spat->spat_flags & SPAT_SCANFIRST) &&
+	   (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
+	    str_free(spat->spat_short);		/* ok if null */
+	    spat->spat_short = spat->spat_regexp->regmust;
+	    spat->spat_regexp->regmust = Nullstr;
+	    spat->spat_flags |= SPAT_SCANFIRST;
+	}
+    }
+}
+
+char *
+scantrans(start)
+char *start;
+{
+    register char *s = start;
+    ARG *arg =
+	l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
+    STR *tstr;
+    STR *rstr;
+    register char *t;
+    register char *r;
+    register short *tbl;
+    register int i;
+    register int j;
+    int tlen, rlen;
+    int squash;
+    int delete;
+    int complement;
+
+    New(803,tbl,256,short);
+    arg[2].arg_type = A_NULL;
+    arg[2].arg_ptr.arg_cval = (char*) tbl;
+
+    s = scanstr(s, SCAN_TR);
+    if (s >= bufend) {
+	yyerror("Translation pattern not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    tstr = yylval.arg[1].arg_ptr.arg_str; 
+    yylval.arg[1].arg_ptr.arg_str = Nullstr; 
+    arg_free(yylval.arg);
+    t = tstr->str_ptr;
+    tlen = tstr->str_cur;
+
+    if (s[-1] == *start)
+	s--;
+
+    s = scanstr(s, SCAN_TR|SCAN_REPL);
+    if (s >= bufend) {
+	yyerror("Translation replacement not terminated");
+	yylval.arg = Nullarg;
+	return s;
+    }
+    rstr = yylval.arg[1].arg_ptr.arg_str; 
+    yylval.arg[1].arg_ptr.arg_str = Nullstr; 
+    arg_free(yylval.arg);
+    r = rstr->str_ptr;
+    rlen = rstr->str_cur;
+
+    complement = delete = squash = 0;
+    while (*s == 'c' || *s == 'd' || *s == 's') {
+	if (*s == 'c')
+	    complement = 1;
+	else if (*s == 'd')
+	    delete = 2;
+	else
+	    squash = 1;
+	s++;
+    }
+    arg[2].arg_len = delete|squash;
+    yylval.arg = arg;
+    if (complement) {
+	Zero(tbl, 256, short);
+	for (i = 0; i < tlen; i++)
+	    tbl[t[i] & 0377] = -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] & 0377;
+		    else
+			tbl[i] = i;
+		}
+		else
+		    tbl[i] = r[j++] & 0377;
+	    }
+	}
+    }
+    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] & 0377] == -1)
+			tbl[t[i] & 0377] = -2;
+		    continue;
+		}
+		--j;
+	    }
+	    if (tbl[t[i] & 0377] == -1)
+		tbl[t[i] & 0377] = r[j] & 0377;
+	}
+    }
+    str_free(tstr);
+    str_free(rstr);
+    return s;
+}
+
+char *
+scanstr(start, in_what)
+char *start;
+int in_what;
+{
+    register char *s = start;
+    register char term;
+    register char *d;
+    register ARG *arg;
+    register char *send;
+    register bool makesingle = FALSE;
+    register STAB *stab;
+    bool alwaysdollar = FALSE;
+    bool hereis = FALSE;
+    STR *herewas;
+    STR *str;
+    /* which backslash sequences to keep */
+    char *leave = (in_what & SCAN_TR)
+	? "\\$@nrtfbeacx0123456789-"
+	: "\\$@nrtfbeacx0123456789[{]}lLuUE";
+    int len;
+
+    arg = op_new(1);
+    yylval.arg = arg;
+    arg->arg_type = O_ITEM;
+
+    switch (*s) {
+    default:			/* a substitution replacement */
+	arg[1].arg_type = A_DOUBLE;
+	makesingle = TRUE;	/* maybe disable runtime scanning */
+	term = *s;
+	if (term == '\'')
+	    leave = Nullch;
+	goto snarf_it;
+    case '0':
+	{
+	    unsigned long i;
+	    int shift;
+
+	    arg[1].arg_type = A_SINGLE;
+	    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:
+	    str = Str_new(92,0);
+	    str_numset(str,(double)i);
+	    if (str->str_ptr) {
+		Safefree(str->str_ptr);
+		str->str_ptr = Nullch;
+		str->str_len = str->str_cur = 0;
+	    }
+	    arg[1].arg_ptr.arg_str = str;
+	}
+	break;
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9': case '.':
+      decimal:
+	arg[1].arg_type = A_SINGLE;
+	d = tokenbuf;
+	while (isDIGIT(*s) || *s == '_') {
+	    if (*s == '_')
+		s++;
+	    else
+		*d++ = *s++;
+	}
+	if (*s == '.' && s[1] != '.') {
+	    *d++ = *s++;
+	    while (isDIGIT(*s) || *s == '_') {
+		if (*s == '_')
+		    s++;
+		else
+		    *d++ = *s++;
+	    }
+	}
+	if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
+	    *d++ = *s++;
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isDIGIT(*s))
+		*d++ = *s++;
+	}
+	*d = '\0';
+	str = Str_new(92,0);
+	str_numset(str,atof(tokenbuf));
+	if (str->str_ptr) {
+	    Safefree(str->str_ptr);
+	    str->str_ptr = Nullch;
+	    str->str_len = str->str_cur = 0;
+	}
+	arg[1].arg_ptr.arg_str = str;
+	break;
+    case '<':
+	if (in_what & (SCAN_REPL|SCAN_TR))
+	    goto do_double;
+	if (*++s == '<') {
+	    hereis = TRUE;
+	    d = tokenbuf;
+	    if (!rsfp)
+		*d++ = '\n';
+	    if (*++s && index("`'\"",*s)) {
+		term = *s++;
+		s = cpytill(d,s,bufend,term,&len);
+		if (s < bufend)
+		    s++;
+		d += len;
+	    }
+	    else {
+		if (*s == '\\')
+		    s++, term = '\'';
+		else
+		    term = '"';
+		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 = str_make(s,bufend-s);
+	    else
+		s--, herewas = str_make(s,d-s);
+	    s += herewas->str_cur;
+	    if (term == '\'')
+		goto do_single;
+	    if (term == '`')
+		goto do_back;
+	    goto do_double;
+	}
+	d = tokenbuf;
+	s = cpytill(d,s,bufend,'>',&len);
+	if (s < bufend)
+	    s++;
+	else
+	    fatal("Unterminated <> operator");
+
+	if (*d == '$') d++;
+	while (*d && (isALNUM(*d) || *d == '\''))
+	    d++;
+	if (d - tokenbuf != len) {
+	    s = start;
+	    term = *s;
+	    arg[1].arg_type = A_GLOB;
+	    set_csh();
+	    alwaysdollar = TRUE;	/* treat $) and $| as variables */
+	    goto snarf_it;
+	}
+	else {
+	    d = tokenbuf;
+	    if (!len)
+		(void)strcpy(d,"ARGV");
+	    if (*d == '$') {
+		arg[1].arg_type = A_INDREAD;
+		arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
+	    }
+	    else {
+		arg[1].arg_type = A_READ;
+		arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
+		if (!stab_io(arg[1].arg_ptr.arg_stab))
+		    stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
+		if (strEQ(d,"ARGV")) {
+		    (void)aadd(arg[1].arg_ptr.arg_stab);
+		    stab_io(arg[1].arg_ptr.arg_stab)->flags |=
+		      IOF_ARGV|IOF_START;
+		}
+	    }
+	}
+	break;
+
+    case 'q':
+	s++;
+	if (*s == 'q') {
+	    s++;
+	    goto do_double;
+	}
+	if (*s == 'x') {
+	    s++;
+	    goto do_back;
+	}
+	/* FALL THROUGH */
+    case '\'':
+      do_single:
+	term = *s;
+	arg[1].arg_type = A_SINGLE;
+	leave = Nullch;
+	goto snarf_it;
+
+    case '"': 
+      do_double:
+	term = *s;
+	arg[1].arg_type = A_DOUBLE;
+	makesingle = TRUE;	/* maybe disable runtime scanning */
+	alwaysdollar = TRUE;	/* treat $) and $| as variables */
+	goto snarf_it;
+    case '`':
+      do_back:
+	term = *s;
+	arg[1].arg_type = A_BACKTICK;
+	set_csh();
+	alwaysdollar = TRUE;	/* treat $) and $| as variables */
+      snarf_it:
+	{
+	    STR *tmpstr;
+	    STR *tmpstr2 = Nullstr;
+	    char *tmps;
+	    char *start;
+	    bool dorange = FALSE;
+
+	    CLINE;
+	    multi_start = curcmd->c_line;
+	    if (hereis)
+		multi_open = multi_close = '<';
+	    else {
+		multi_open = term;
+		if (term && (tmps = index("([{< )]}> )]}>",term)))
+		    term = tmps[5];
+		multi_close = term;
+	    }
+	    tmpstr = Str_new(87,80);
+	    if (hereis) {
+		term = *tokenbuf;
+		if (!rsfp) {
+		    d = s;
+		    while (s < bufend &&
+		      (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+			if (*s++ == '\n')
+			    curcmd->c_line++;
+		    }
+		    if (s >= bufend) {
+			curcmd->c_line = multi_start;
+			fatal("EOF in string");
+		    }
+		    str_nset(tmpstr,d+1,s-d);
+		    s += len - 1;
+		    str_ncat(herewas,s,bufend-s);
+		    str_replace(linestr,herewas);
+		    oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
+		    bufend = linestr->str_ptr + linestr->str_cur;
+		    hereis = FALSE;
+		}
+		else
+		    str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
+	    }
+	    else
+		s = str_append_till(tmpstr,s+1,bufend,term,leave);
+	    while (s >= bufend) {	/* multiple line string? */
+		if (!rsfp ||
+		 !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
+		    curcmd->c_line = multi_start;
+		    fatal("EOF in string");
+		}
+		curcmd->c_line++;
+		if (perldb) {
+		    STR *str = Str_new(88,0);
+
+		    str_sset(str,linestr);
+		    astore(stab_xarray(curcmd->c_filestab),
+		      (int)curcmd->c_line,str);
+		}
+		bufend = linestr->str_ptr + linestr->str_cur;
+		if (hereis) {
+		    if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+			s = bufend - 1;
+			*s = ' ';
+			str_scat(linestr,herewas);
+			bufend = linestr->str_ptr + linestr->str_cur;
+		    }
+		    else {
+			s = bufend;
+			str_scat(tmpstr,linestr);
+		    }
+		}
+		else
+		    s = str_append_till(tmpstr,s,bufend,term,leave);
+	    }
+	    multi_end = curcmd->c_line;
+	    s++;
+	    if (tmpstr->str_cur + 5 < tmpstr->str_len) {
+		tmpstr->str_len = tmpstr->str_cur + 1;
+		Renew(tmpstr->str_ptr, tmpstr->str_len, char);
+	    }
+	    if (arg[1].arg_type == A_SINGLE) {
+		arg[1].arg_ptr.arg_str = tmpstr;
+		break;
+	    }
+	    tmps = s;
+	    s = tmpstr->str_ptr;
+	    send = s + tmpstr->str_cur;
+	    while (s < send) {		/* see if we can make SINGLE */
+		if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
+		  !alwaysdollar && s[1] != '0')
+		    *s = '$';		/* grandfather \digit in subst */
+		if ((*s == '$' || *s == '@') && s+1 < send &&
+		  (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
+		    makesingle = FALSE;	/* force interpretation */
+		}
+		else if (*s == '\\' && s+1 < send) {
+		    if (index("lLuUE",s[1]))
+			makesingle = FALSE;
+		    s++;
+		}
+		s++;
+	    }
+	    s = d = start = tmpstr->str_ptr;	/* assuming shrinkage only */
+	    while (s < send || dorange) {
+		if (in_what & SCAN_TR) {
+		    if (dorange) {
+			int i;
+			int max;
+			if (!tmpstr2) {	/* oops, have to grow */
+			    tmpstr2 = str_smake(tmpstr);
+			    s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
+			    send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
+			}
+			i = d - tmpstr->str_ptr;
+			STR_GROW(tmpstr, tmpstr->str_len + 256);
+			d = tmpstr->str_ptr + i;
+			d -= 2;
+			max = d[1] & 0377;
+			for (i = (*d & 0377); i <= max; i++)
+			    *d++ = i;
+			start = s;
+			dorange = FALSE;
+			continue;
+		    }
+		    else if (*s == '-' && s+1 < send  && s != start) {
+			dorange = TRUE;
+			s++;
+		    }
+		}
+		else {
+		    if ((*s == '$' && s+1 < send &&
+			(alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
+			(*s == '@' && s+1 < send) ) {
+			if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
+			    *d++ = *s++;
+			len = scanident(s,send,tokenbuf) - s;
+			if (*s == '$' || strEQ(tokenbuf,"ARGV")
+			  || strEQ(tokenbuf,"ENV")
+			  || strEQ(tokenbuf,"SIG")
+			  || strEQ(tokenbuf,"INC") )
+			    (void)stabent(tokenbuf,TRUE); /* add symbol */
+			while (len--)
+			    *d++ = *s++;
+			continue;
+		    }
+		}
+		if (*s == '\\' && s+1 < send) {
+		    s++;
+		    switch (*s) {
+		    case '-':
+			if (in_what & SCAN_TR) {
+			    *d++ = *s++;
+			    continue;
+			}
+			/* FALL THROUGH */
+		    default:
+			if (!makesingle && (!leave || (*s && index(leave,*s))))
+			    *d++ = '\\';
+			*d++ = *s++;
+			continue;
+		    case '0': case '1': case '2': case '3':
+		    case '4': case '5': case '6': case '7':
+			*d++ = scanoct(s, 3, &len);
+			s += len;
+			continue;
+		    case 'x':
+			*d++ = scanhex(++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';
+
+	    if (arg[1].arg_type == A_DOUBLE && makesingle)
+		arg[1].arg_type = A_SINGLE;	/* now we can optimize on it */
+
+	    tmpstr->str_cur = d - tmpstr->str_ptr;
+	    if (arg[1].arg_type == A_GLOB) {
+		arg[1].arg_ptr.arg_stab = stab = genstab();
+		stab_io(stab) = stio_new();
+		str_sset(stab_val(stab), tmpstr);
+	    }
+	    else
+		arg[1].arg_ptr.arg_str = tmpstr;
+	    s = tmps;
+	    if (tmpstr2)
+		str_free(tmpstr2);
+	    break;
+	}
+    }
+    if (hereis)
+	str_free(herewas);
+    return s;
+}
+
+FCMD *
+load_format()
+{
+    FCMD froot;
+    FCMD *flinebeg;
+    char *eol;
+    register FCMD *fprev = &froot;
+    register FCMD *fcmd;
+    register char *s;
+    register char *t;
+    register STR *str;
+    bool noblank;
+    bool repeater;
+
+    Zero(&froot, 1, FCMD);
+    s = bufptr;
+    while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
+	curcmd->c_line++;
+	if (in_eval && !rsfp) {
+	    eol = index(s,'\n');
+	    if (!eol++)
+		eol = bufend;
+	}
+	else
+	    eol = bufend = linestr->str_ptr + linestr->str_cur;
+	if (perldb) {
+	    STR *tmpstr = Str_new(89,0);
+
+	    str_nset(tmpstr, s, eol-s);
+	    astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
+	}
+	if (*s == '.') {
+	    /*SUPPRESS 530*/
+	    for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+	    if (*t == '\n') {
+		bufptr = s;
+		return froot.f_next;
+	    }
+	}
+	if (*s == '#') {
+	    s = eol;
+	    continue;
+	}
+	flinebeg = Nullfcmd;
+	noblank = FALSE;
+	repeater = FALSE;
+	while (s < eol) {
+	    Newz(804,fcmd,1,FCMD);
+	    fprev->f_next = fcmd;
+	    fprev = fcmd;
+	    for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
+		if (*t == '~') {
+		    noblank = TRUE;
+		    *t = ' ';
+		    if (t[1] == '~') {
+			repeater = TRUE;
+			t[1] = ' ';
+		    }
+		}
+	    }
+	    fcmd->f_pre = nsavestr(s, t-s);
+	    fcmd->f_presize = t-s;
+	    s = t;
+	    if (s >= eol) {
+		if (noblank)
+		    fcmd->f_flags |= FC_NOBLANK;
+		if (repeater)
+		    fcmd->f_flags |= FC_REPEAT;
+		break;
+	    }
+	    if (!flinebeg)
+		flinebeg = fcmd;		/* start values here */
+	    if (*s++ == '^')
+		fcmd->f_flags |= FC_CHOP;	/* for doing text filling */
+	    switch (*s) {
+	    case '*':
+		fcmd->f_type = F_LINES;
+		*s = '\0';
+		break;
+	    case '<':
+		fcmd->f_type = F_LEFT;
+		while (*s == '<')
+		    s++;
+		break;
+	    case '>':
+		fcmd->f_type = F_RIGHT;
+		while (*s == '>')
+		    s++;
+		break;
+	    case '|':
+		fcmd->f_type = F_CENTER;
+		while (*s == '|')
+		    s++;
+		break;
+	    case '#':
+	    case '.':
+		/* Catch the special case @... and handle it as a string
+		   field. */
+		if (*s == '.' && s[1] == '.') {
+		    goto default_format;
+		}
+		fcmd->f_type = F_DECIMAL;
+		{
+		    char *p;
+
+		    /* Read a format in the form @####.####, where either group
+		       of ### may be empty, or the final .### may be missing. */
+		    while (*s == '#')
+			s++;
+		    if (*s == '.') {
+			s++;
+			p = s;
+			while (*s == '#')
+			    s++;
+			fcmd->f_decimals = s-p;
+			fcmd->f_flags |= FC_DP;
+		    } else {
+			fcmd->f_decimals = 0;
+		    }
+		}
+		break;
+	    default:
+	    default_format:
+		fcmd->f_type = F_LEFT;
+		break;
+	    }
+	    if (fcmd->f_flags & FC_CHOP && *s == '.') {
+		fcmd->f_flags |= FC_MORE;
+		while (*s == '.')
+		    s++;
+	    }
+	    fcmd->f_size = s-t;
+	}
+	if (flinebeg) {
+	  again:
+	    if (s >= bufend &&
+	      (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
+		goto badform;
+	    curcmd->c_line++;
+	    if (in_eval && !rsfp) {
+		eol = index(s,'\n');
+		if (!eol++)
+		    eol = bufend;
+	    }
+	    else
+		eol = bufend = linestr->str_ptr + linestr->str_cur;
+	    if (perldb) {
+		STR *tmpstr = Str_new(90,0);
+
+		str_nset(tmpstr, s, eol-s);
+		astore(stab_xarray(curcmd->c_filestab),
+		    (int)curcmd->c_line,tmpstr);
+	    }
+	    if (strnEQ(s,".\n",2)) {
+		bufptr = s;
+		yyerror("Missing values line");
+		return froot.f_next;
+	    }
+	    if (*s == '#') {
+		s = eol;
+		goto again;
+	    }
+	    str = flinebeg->f_unparsed = Str_new(91,eol - s);
+	    str->str_u.str_hash = curstash;
+	    str_nset(str,"(",1);
+	    flinebeg->f_line = curcmd->c_line;
+	    eol[-1] = '\0';
+	    if (!flinebeg->f_next->f_type || index(s, ',')) {
+		eol[-1] = '\n';
+		str_ncat(str, s, eol - s - 1);
+		str_ncat(str,",$$);",5);
+		s = eol;
+	    }
+	    else {
+		eol[-1] = '\n';
+		while (s < eol && isSPACE(*s))
+		    s++;
+		t = s;
+		while (s < eol) {
+		    switch (*s) {
+		    case ' ': case '\t': case '\n': case ';':
+			str_ncat(str, t, s - t);
+			str_ncat(str, "," ,1);
+			while (s < eol && (isSPACE(*s) || *s == ';'))
+			    s++;
+			t = s;
+			break;
+		    case '$':
+			str_ncat(str, t, s - t);
+			t = s;
+			s = scanident(s,eol,tokenbuf);
+			str_ncat(str, t, s - t);
+			t = s;
+			if (s < eol && *s && index("$'\"",*s))
+			    str_ncat(str, ",", 1);
+			break;
+		    case '"': case '\'':
+			str_ncat(str, t, s - t);
+			t = s;
+			s++;
+			while (s < eol && (*s != *t || s[-1] == '\\'))
+			    s++;
+			if (s < eol)
+			    s++;
+			str_ncat(str, t, s - t);
+			t = s;
+			if (s < eol && *s && index("$'\"",*s))
+			    str_ncat(str, ",", 1);
+			break;
+		    default:
+			yyerror("Please use commas to separate fields");
+		    }
+		}
+		str_ncat(str,"$$);",4);
+	    }
+	}
+    }
+  badform:
+    bufptr = str_get(linestr);
+    yyerror("Format not terminated");
+    return froot.f_next;
+}
+
+static void
+set_csh()
+{
+#ifdef CSH
+    if (!cshlen)
+	cshlen = strlen(cshname);
+#endif
+}
diff --git a/gnu/usr.bin/perl/perl/usersub.c b/gnu/usr.bin/perl/perl/usersub.c
new file mode 100644
index 000000000000..d0ee9525ef99
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usersub.c
@@ -0,0 +1,148 @@
+/* $RCSfile: usersub.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:40 $
+ *
+ *  This file contains stubs for routines that the user may define to
+ *  set up glue routines for C libraries or to decrypt encrypted scripts
+ *  for execution.
+ *
+ * $Log: usersub.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:29:40  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  16:04:24  lwall
+ * patch20: removed implicit int declarations on functions
+ * 
+ * Revision 4.0.1.1  91/11/11  16:47:17  lwall
+ * patch19: deleted some unused functions from usersub.c
+ * 
+ * Revision 4.0  91/03/20  01:55:56  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+int
+userinit()
+{
+    return 0;
+}
+
+/*
+ * The following is supplied by John Macdonald as a means of decrypting
+ * and executing (presumably proprietary) scripts that have been encrypted
+ * by a (presumably secret) method.  The idea is that you supply your own
+ * routine in place of cryptfilter (which is purposefully a very weak
+ * encryption).  If an encrypted script is detected, a process is forked
+ * off to run the cryptfilter routine as input to perl.
+ */
+
+#ifdef CRYPTSCRIPT
+
+#include <signal.h>
+#ifdef I_VFORK
+#include <vfork.h>
+#endif
+
+#ifdef CRYPTLOCAL
+
+#include "cryptlocal.h"
+
+#else	/* ndef CRYPTLOCAL */
+
+#define	CRYPT_MAGIC_1	0xfb
+#define	CRYPT_MAGIC_2	0xf1
+
+void
+cryptfilter( fil )
+FILE *	fil;
+{
+    int    ch;
+
+    while( (ch = getc( fil )) != EOF ) {
+	putchar( (ch ^ 0x80) );
+    }
+}
+
+#endif	/* CRYPTLOCAL */
+
+#ifndef MSDOS
+static FILE	*lastpipefile;
+static int	pipepid;
+
+#ifdef VOIDSIG
+#  define	VOID	void
+#else
+#  define	VOID	int
+#endif
+
+FILE *
+mypfiopen(fil,func)		/* open a pipe to function call for input */
+FILE	*fil;
+VOID	(*func)();
+{
+    int p[2];
+    STR *str;
+
+    if (pipe(p) < 0) {
+	fclose( fil );
+	fatal("Can't get pipe for decrypt");
+    }
+
+    /* make sure that the child doesn't get anything extra */
+    fflush(stdout);
+    fflush(stderr);
+
+    while ((pipepid = fork()) < 0) {
+	if (errno != EAGAIN) {
+	    close(p[0]);
+	    close(p[1]);
+	    fclose( fil );
+	    fatal("Can't fork for decrypt");
+	}
+	sleep(5);
+    }
+    if (pipepid == 0) {
+	close(p[0]);
+	if (p[1] != 1) {
+	    dup2(p[1], 1);
+	    close(p[1]);
+	}
+	(*func)(fil);
+	fflush(stdout);
+	fflush(stderr);
+	_exit(0);
+    }
+    close(p[1]);
+    close(fileno(fil));
+    fclose(fil);
+    str = afetch(fdpid,p[0],TRUE);
+    str->str_u.str_useful = pipepid;
+    return fdopen(p[0], "r");
+}
+
+void
+cryptswitch()
+{
+    int ch;
+#ifdef STDSTDIO
+    /* cheat on stdio if possible */
+    if (rsfp->_cnt > 0 && (*rsfp->_ptr & 0xff) != CRYPT_MAGIC_1)
+	return;
+#endif
+    ch = getc(rsfp);
+    if (ch == CRYPT_MAGIC_1) {
+	if (getc(rsfp) == CRYPT_MAGIC_2) {
+	    if( perldb ) fatal("can't debug an encrypted script");
+	    rsfp = mypfiopen( rsfp, cryptfilter );
+	    preprocess = 1;	/* force call to pclose when done */
+	}
+	else
+	    fatal( "bad encryption format" );
+    }
+    else
+	ungetc(ch,rsfp);
+}
+#endif /* !MSDOS */
+
+#endif /* CRYPTSCRIPT */
diff --git a/gnu/usr.bin/perl/perl/usub/Makefile b/gnu/usr.bin/perl/perl/usub/Makefile
new file mode 100644
index 000000000000..107702f303a6
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/Makefile
@@ -0,0 +1,16 @@
+SRC = ..
+GLOBINCS = 
+LOCINCS = 
+LIBS = -lcurses -ltermlib `. $(SRC)/config.sh; echo $$libs`
+
+curseperl: $(SRC)/uperl.o usersub.o curses.o
+	cc $(SRC)/uperl.o usersub.o curses.o $(LIBS) -o curseperl
+
+usersub.o: usersub.c
+	cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g usersub.c
+
+curses.o: curses.c
+	cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g curses.c
+
+curses.c: curses.mus
+	mus curses.mus >curses.c
diff --git a/gnu/usr.bin/perl/perl/usub/README b/gnu/usr.bin/perl/perl/usub/README
new file mode 100644
index 000000000000..a80a650d7b95
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/README
@@ -0,0 +1,114 @@
+This directory contains an example of how you might link in C subroutines
+with perl to make your own special copy of perl.  In the perl distribution
+directory, there will be (after make is run) a file called uperl.o, which
+is all of perl except for a single undefined subroutine, named userinit().
+See usersub.c.
+
+The sole purpose of the userinit() routine is to call the initialization
+routines for any modules that you want to link in.  In this example, we just
+call init_curses(), which sets up to link in the System V curses routines.
+You'll find this in the file curses.c, which is the processed output of
+curses.mus.  (To get BSD curses, replace curses.mus with bsdcurses.mus.)
+
+The magicname() routine adds variable names into the symbol table.  Along
+with the name of the variable as Perl knows it, we pass a structure containing
+an index identifying the variable, and the names of two C functions that
+know how to set or evaluate a variable given the index of the variable.
+Our example uses a macro to handle this conveniently.
+
+The init routine calls make_usub() to add user-defined subroutine names
+into the symbol table.  The arguments are
+
+	make_usub(subname, subindex, subfunc, filename);
+	char *subname;
+	int subindex;
+	int subfunc();
+	char *filename;
+
+The subname is the name that will be used in the Perl program.  The subindex
+will be passed to subfunc() when it is called to tell it which C function
+is desired.  subfunc() is a glue routine that translates the arguments
+from Perl internal stack form to the form required by the routine in
+question, calls the desired C function, and then translates any return
+value back into the stack format.  The glue routine used by curses just
+has a large switch statement, each branch of which does the processing
+for a particular C function.  The subindex could, however, be used to look
+up a function in a dynamically linked library.  No example of this is
+provided.
+
+As a help in producing the glue routine, a preprocessor called "mus" lets
+you specify argument and return value types in a tabular format.  An entry
+such as:
+
+    CASE int waddstr
+    I       WINDOW*         win
+    I       char*           str
+    END
+
+indicates that waddstr takes two input arguments, the first of which is a
+pointer to a window, and the second of which is an ordinary C string.  It
+also indicates that an integer is returned.  The mus program turns this into:
+
+    case US_waddstr:
+        if (items != 2)
+            fatal("Usage: &waddstr($win, $str)");
+        else {
+            int retval;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+            char*       str =           (char*)         str_get(st[2]);
+
+            retval = waddstr(win, str);
+            str_numset(st[0], (double) retval);
+        }
+        return sp;
+
+It's also possible to have output parameters, indicated by O, and input/ouput
+parameters indicated by IO.
+
+The mus program isn't perfect.  You'll note that curses.mus has some
+cases which are hand coded.  They'll be passed straight through unmodified.
+You can produce similar cases by analogy to what's in curses.c, as well
+as similar routines in the doarg.c, dolist.c and doio.c routines of Perl.
+The mus program is only intended to get you about 90% there.  It's not clear,
+for instance, how a given structure should be passed to Perl.  But that
+shouldn't bother you--if you've gotten this far, it's already obvious
+that you are totally mad.
+
+Here's an example of how to return an array value:
+
+    case US_appl_errlist:
+	if (!wantarray) {
+	    str_numset(st[0], (double) appl_nerr);
+	    return sp;
+	}
+	astore(stack, sp + appl_nerr, Nullstr);		/* extend stack */
+	st = stack->ary_array + sp;			/* possibly realloced */
+	for (i = 0; i < appl_nerr; i++) {
+	    tmps = appl_errlist[i];
+	    st[i] = str_2mortal(str_make(tmps,strlen(tmps)));
+	}
+	return sp + appl_nerr - 1;
+
+
+In addition, there is a program, man2mus, that will scan a man page for
+function prototypes and attempt to construct a mus CASE entry for you.  It has
+to guess about input/output parameters, so you'll have to tidy up after it.
+But it can save you a lot of time if the man pages for a library are
+reasonably well formed.
+
+If you happen to have curses on your machine, you might try compiling
+a copy of curseperl.  The "pager" program in this directory is a rudimentary
+start on writing a pager--don't believe the help message, which is stolen
+from the less program.
+
+User-defined subroutines may not currently be called as a signal handler,
+though a signal handler may itself call a user-defined subroutine.
+
+There are now glue routines to call back from C into Perl.  In usersub.c
+in this directory, you'll find callback() and callv().  The callback()
+routine presumes that any arguments to pass to the Perl subroutine
+have already been pushed onto the Perl stack.  The callv() routine
+is a wrapper that pushes an argv-style array of strings onto the
+stack for you, and then calls callback().  Be sure to recheck your
+stack pointer after returning from these routine, since the Perl code
+may have reallocated it.
diff --git a/gnu/usr.bin/perl/perl/usub/bsdcurses.mus b/gnu/usr.bin/perl/perl/usub/bsdcurses.mus
new file mode 100644
index 000000000000..1a1f11bcb21f
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/bsdcurses.mus
@@ -0,0 +1,699 @@
+/* $RCSfile: bsdcurses.mus,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:07 $
+ *
+ * $Log: bsdcurses.mus,v $
+# Revision 1.1.1.1  1993/08/23  21:30:07  nate
+# PERL!
+#
+ * Revision 4.0.1.2  92/06/08  16:05:28  lwall
+ * patch20: &getcap eventually dumped core in bsdcurses
+ * 
+ * Revision 4.0.1.1  91/11/05  19:04:53  lwall
+ * initial checkin
+ * 
+ * Revision 4.0  91/03/20  01:56:13  lwall
+ * 4.0 baseline.
+ * 
+ * Revision 3.0.1.1  90/08/09  04:05:21  lwall
+ * patch19: Initial revision
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+char *savestr();
+
+#include <curses.h>
+
+static enum uservars {
+    UV_curscr,
+    UV_stdscr,
+    UV_Def_term,
+    UV_My_term,
+    UV_ttytype,
+    UV_LINES,
+    UV_COLS,
+    UV_ERR,
+    UV_OK,
+};
+
+static enum usersubs {
+    US_addch,
+    US_waddch,
+    US_addstr,
+    US_waddstr,
+    US_box,
+    US_clear,
+    US_wclear,
+    US_clearok,
+    US_clrtobot,
+    US_wclrtobot,
+    US_clrtoeol,
+    US_wclrtoeol,
+    US_delch,
+    US_wdelch,
+    US_deleteln,
+    US_wdeleteln,
+    US_erase,
+    US_werase,
+    US_flushok,
+    US_idlok,
+    US_insch,
+    US_winsch,
+    US_insertln,
+    US_winsertln,
+    US_move,
+    US_wmove,
+    US_overlay,
+    US_overwrite,
+    US_printw,
+    US_wprintw,
+    US_refresh,
+    US_wrefresh,
+    US_standout,
+    US_wstandout,
+    US_standend,
+    US_wstandend,
+    US_cbreak,
+    US_nocbreak,
+    US_echo,
+    US_noecho,
+    US_getch,
+    US_wgetch,
+    US_getstr,
+    US_wgetstr,
+    US_raw,
+    US_noraw,
+    US_scanw,
+    US_wscanw,
+    US_baudrate,
+    US_delwin,
+    US_endwin,
+    US_erasechar,
+    US_getcap,
+    US_getyx,
+    US_inch,
+    US_winch,
+    US_initscr,
+    US_killchar,
+    US_leaveok,
+    US_longname,
+    US_fullname,
+    US_mvwin,
+    US_newwin,
+    US_nl,
+    US_nonl,
+    US_scrollok,
+    US_subwin,
+    US_touchline,
+    US_touchoverlap,
+    US_touchwin,
+    US_unctrl,
+    US_gettmode,
+    US_mvcur,
+    US_scroll,
+    US_savetty,
+    US_resetty,
+    US_setterm,
+    US_tstp,
+    US__putchar,
+    US_testcallback,
+};
+
+static int usersub();
+static int userset();
+static int userval();
+
+int
+init_curses()
+{
+    struct ufuncs uf;
+    char *filename = "curses.c";
+
+    uf.uf_set = userset;
+    uf.uf_val = userval;
+
+#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
+
+    MAGICVAR("curscr",	UV_curscr);
+    MAGICVAR("stdscr",	UV_stdscr);
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",	UV_My_term);
+    MAGICVAR("ttytype",	UV_ttytype);
+    MAGICVAR("LINES",	UV_LINES);
+    MAGICVAR("COLS",	UV_COLS);
+    MAGICVAR("ERR",	UV_ERR);
+    MAGICVAR("OK",	UV_OK);
+
+    make_usub("addch",		US_addch,	usersub, filename);
+    make_usub("waddch",		US_waddch,	usersub, filename);
+    make_usub("addstr",		US_addstr,	usersub, filename);
+    make_usub("waddstr",	US_waddstr,	usersub, filename);
+    make_usub("box",		US_box,		usersub, filename);
+    make_usub("clear",		US_clear,	usersub, filename);
+    make_usub("wclear",		US_wclear,	usersub, filename);
+    make_usub("clearok",	US_clearok,	usersub, filename);
+    make_usub("clrtobot",	US_clrtobot,	usersub, filename);
+    make_usub("wclrtobot",	US_wclrtobot,	usersub, filename);
+    make_usub("clrtoeol",	US_clrtoeol,	usersub, filename);
+    make_usub("wclrtoeol",	US_wclrtoeol,	usersub, filename);
+    make_usub("delch",		US_delch,	usersub, filename);
+    make_usub("wdelch",		US_wdelch,	usersub, filename);
+    make_usub("deleteln",	US_deleteln,	usersub, filename);
+    make_usub("wdeleteln",	US_wdeleteln,	usersub, filename);
+    make_usub("erase",		US_erase,	usersub, filename);
+    make_usub("werase",		US_werase,	usersub, filename);
+    make_usub("flushok",	US_flushok,	usersub, filename);
+    make_usub("idlok",		US_idlok,	usersub, filename);
+    make_usub("insch",		US_insch,	usersub, filename);
+    make_usub("winsch",		US_winsch,	usersub, filename);
+    make_usub("insertln",	US_insertln,	usersub, filename);
+    make_usub("winsertln",	US_winsertln,	usersub, filename);
+    make_usub("move",		US_move,	usersub, filename);
+    make_usub("wmove",		US_wmove,	usersub, filename);
+    make_usub("overlay",	US_overlay,	usersub, filename);
+    make_usub("overwrite",	US_overwrite,	usersub, filename);
+    make_usub("printw",		US_printw,	usersub, filename);
+    make_usub("wprintw",	US_wprintw,	usersub, filename);
+    make_usub("refresh",	US_refresh,	usersub, filename);
+    make_usub("wrefresh",	US_wrefresh,	usersub, filename);
+    make_usub("standout",	US_standout,	usersub, filename);
+    make_usub("wstandout",	US_wstandout,	usersub, filename);
+    make_usub("standend",	US_standend,	usersub, filename);
+    make_usub("wstandend",	US_wstandend,	usersub, filename);
+    make_usub("cbreak",		US_cbreak,	usersub, filename);
+    make_usub("nocbreak",	US_nocbreak,	usersub, filename);
+    make_usub("echo",		US_echo,	usersub, filename);
+    make_usub("noecho",		US_noecho,	usersub, filename);
+    make_usub("getch",		US_getch,	usersub, filename);
+    make_usub("wgetch",		US_wgetch,	usersub, filename);
+    make_usub("getstr",		US_getstr,	usersub, filename);
+    make_usub("wgetstr",	US_wgetstr,	usersub, filename);
+    make_usub("raw",		US_raw,		usersub, filename);
+    make_usub("noraw",		US_noraw,	usersub, filename);
+    make_usub("scanw",		US_scanw,	usersub, filename);
+    make_usub("wscanw",		US_wscanw,	usersub, filename);
+    make_usub("baudrate",	US_baudrate,	usersub, filename);
+    make_usub("delwin",		US_delwin,	usersub, filename);
+    make_usub("endwin",		US_endwin,	usersub, filename);
+    make_usub("erasechar",	US_erasechar,	usersub, filename);
+    make_usub("getcap",		US_getcap,	usersub, filename);
+    make_usub("getyx",		US_getyx,	usersub, filename);
+    make_usub("inch",		US_inch,	usersub, filename);
+    make_usub("winch",		US_winch,	usersub, filename);
+    make_usub("initscr",	US_initscr,	usersub, filename);
+    make_usub("killchar",	US_killchar,	usersub, filename);
+    make_usub("leaveok",	US_leaveok,	usersub, filename);
+    make_usub("longname",	US_longname,	usersub, filename);
+    make_usub("fullname",	US_fullname,	usersub, filename);
+    make_usub("mvwin",		US_mvwin,	usersub, filename);
+    make_usub("newwin",		US_newwin,	usersub, filename);
+    make_usub("nl",		US_nl,		usersub, filename);
+    make_usub("nonl",		US_nonl,	usersub, filename);
+    make_usub("scrollok",	US_scrollok,	usersub, filename);
+    make_usub("subwin",		US_subwin,	usersub, filename);
+    make_usub("touchline",	US_touchline,	usersub, filename);
+    make_usub("touchoverlap",	US_touchoverlap,usersub, filename);
+    make_usub("touchwin",	US_touchwin,	usersub, filename);
+    make_usub("unctrl",		US_unctrl,	usersub, filename);
+    make_usub("gettmode",	US_gettmode,	usersub, filename);
+    make_usub("mvcur",		US_mvcur,	usersub, filename);
+    make_usub("scroll",		US_scroll,	usersub, filename);
+    make_usub("savetty",	US_savetty,	usersub, filename);
+    make_usub("resetty",	US_resetty,	usersub, filename);
+    make_usub("setterm",	US_setterm,	usersub, filename);
+    make_usub("tstp",		US_tstp,	usersub, filename);
+    make_usub("_putchar",	US__putchar,	usersub, filename);
+    make_usub("testcallback",	US_testcallback,usersub, filename);
+};
+
+static int
+usersub(ix, sp, items)
+int ix;
+register int sp;
+register int items;
+{
+    STR **st = stack->ary_array + sp;
+    register int i;
+    register char *tmps;
+    register STR *Str;		/* used in str_get and str_gnum macros */
+
+    switch (ix) {
+CASE int addch
+I	char		ch
+END
+
+CASE int waddch
+I	WINDOW*		win
+I	char		ch
+END
+
+CASE int addstr
+I	char*		str
+END
+
+CASE int waddstr
+I	WINDOW*		win
+I	char*		str
+END
+
+CASE int box
+I	WINDOW*		win
+I	char		vert
+I	char		hor
+END
+
+CASE int clear
+END
+
+CASE int wclear
+I	WINDOW*		win
+END
+
+CASE int clearok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int clrtobot
+END
+
+CASE int wclrtobot
+I	WINDOW*		win
+END
+
+CASE int clrtoeol
+END
+
+CASE int wclrtoeol
+I	WINDOW*		win
+END
+
+CASE int delch
+END
+
+CASE int wdelch
+I	WINDOW*		win
+END
+
+CASE int deleteln
+END
+
+CASE int wdeleteln
+I	WINDOW*		win
+END
+
+CASE int erase
+END
+
+CASE int werase
+I	WINDOW*		win
+END
+
+CASE int flushok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int idlok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int insch
+I	char		c
+END
+
+CASE int winsch
+I	WINDOW*		win
+I	char		c
+END
+
+CASE int insertln
+END
+
+CASE int winsertln
+I	WINDOW*		win
+END
+
+CASE int move
+I	int		y
+I	int		x
+END
+
+CASE int wmove
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE int overlay
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int overwrite
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+    case US_printw:
+	if (items < 1)
+	    fatal("Usage: &printw($fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = addstr(str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+    case US_wprintw:
+	if (items < 2)
+	    fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = waddstr(win, str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+CASE int refresh
+END
+
+CASE int wrefresh
+I	WINDOW*		win
+END
+
+CASE int standout
+END
+
+CASE int wstandout
+I	WINDOW*		win
+END
+
+CASE int standend
+END
+
+CASE int wstandend
+I	WINDOW*		win
+END
+
+CASE int cbreak
+END
+
+CASE int nocbreak
+END
+
+CASE int echo
+END
+
+CASE int noecho
+END
+
+    case US_getch:
+        if (items != 0)
+            fatal("Usage: &getch()");
+        else {
+            int retval;
+	    char retch;
+
+            retval = getch();
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+    case US_wgetch:
+        if (items != 1)
+            fatal("Usage: &wgetch($win)");
+        else {
+            int retval;
+	    char retch;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+            retval = wgetch(win);
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		str_nset(st[0], &retch, 1);
+	    }
+        }
+        return sp;
+
+CASE int getstr
+IO	char*		str
+END
+
+CASE int wgetstr
+I	WINDOW*		win
+IO	char*		str
+END
+
+CASE int raw
+END
+
+CASE int noraw
+END
+
+CASE int baudrate
+END
+
+CASE int delwin
+I	WINDOW*		win
+END
+
+CASE int endwin
+END
+
+CASE int erasechar
+END
+
+    case US_getcap:
+	if (items != 1)
+	    fatal("Usage: &getcap($str)");
+	else {
+	    char* retval;
+	    char*	str =		(char*)		str_get(st[1]);
+	    char output[50], *outputp = output;
+
+	    retval = tgetstr(str, &outputp);
+	    str_set(st[0], (char*) retval);
+	}
+	return sp;
+
+    case US_getyx:
+	if (items != 3)
+	    fatal("Usage: &getyx($win, $y, $x)");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+	    int		y;
+	    int		x;
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = getyx(win, y, x);
+	    str_numset(st[2], (double)y);
+	    str_numset(st[3], (double)x);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+	
+CASE int inch
+END
+
+CASE int winch
+I	WINDOW*		win
+END
+
+CASE WINDOW* initscr
+END
+
+CASE int killchar
+END
+
+CASE int leaveok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE char* longname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int fullname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int mvwin
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE WINDOW* newwin
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int nl
+END
+
+CASE int nonl
+END
+
+CASE int scrollok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE WINDOW* subwin
+I	WINDOW*		win
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int touchline
+I	WINDOW*		win
+I	int		y
+I	int		startx
+I	int		endx
+END
+
+CASE int touchoverlap
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int touchwin
+I	WINDOW*		win
+END
+
+CASE char* unctrl
+I	char		ch
+END
+
+CASE int gettmode
+END
+
+CASE int mvcur
+I	int		lasty
+I	int		lastx
+I	int		newy
+I	int		newx
+END
+
+CASE int scroll
+I	WINDOW*		win
+END
+
+CASE int savetty
+END
+
+CASE void resetty
+END
+
+CASE int setterm
+I	char*		name
+END
+
+CASE int tstp
+END
+
+CASE int _putchar
+I	char		ch
+END
+
+    case US_testcallback:
+	sp = callback("callback", sp + items, curcsv->wantarray, 1, items);
+	break;
+
+    default:
+	fatal("Unimplemented user-defined subroutine");
+    }
+    return sp;
+}
+
+static int
+userval(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	str_numset(str, (double)COLS);
+	break;
+    case UV_Def_term:
+	str_set(str, Def_term);
+	break;
+    case UV_ERR:
+	str_numset(str, (double)ERR);
+	break;
+    case UV_LINES:
+	str_numset(str, (double)LINES);
+	break;
+    case UV_My_term:
+	str_numset(str, (double)My_term);
+	break;
+    case UV_OK:
+	str_numset(str, (double)OK);
+	break;
+    case UV_curscr:
+	str_nset(str, &curscr, sizeof(WINDOW*));
+	break;
+    case UV_stdscr:
+	str_nset(str, &stdscr, sizeof(WINDOW*));
+	break;
+    case UV_ttytype:
+	str_set(str, ttytype);
+	break;
+    }
+    return 0;
+}
+
+static int
+userset(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	COLS = (int)str_gnum(str);
+	break;
+    case UV_Def_term:
+	Def_term = savestr(str_get(str));	/* never freed */
+	break;
+    case UV_LINES:
+	LINES = (int)str_gnum(str);
+	break;
+    case UV_My_term:
+	My_term = (bool)str_gnum(str);
+	break;
+    case UV_ttytype:
+	strcpy(ttytype, str_get(str));		/* hope it fits */
+	break;
+    }
+    return 0;
+}
diff --git a/gnu/usr.bin/perl/perl/usub/curses.mus b/gnu/usr.bin/perl/perl/usub/curses.mus
new file mode 100644
index 000000000000..f305bf5920f3
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/curses.mus
@@ -0,0 +1,890 @@
+/* $RCSfile: curses.mus,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:07 $
+ *
+ * $Log: curses.mus,v $
+# Revision 1.1.1.1  1993/08/23  21:30:07  nate
+# PERL!
+#
+ * Revision 4.0.1.2  92/06/08  16:06:12  lwall
+ * patch20: function key support added to curses.mus
+ * 
+ * Revision 4.0.1.1  91/11/05  19:06:19  lwall
+ * patch11: usub/curses.mus now supports SysV curses
+ * 
+ * Revision 4.0  91/03/20  01:56:13  lwall
+ * 4.0 baseline.
+ * 
+ * Revision 3.0.1.1  90/08/09  04:05:21  lwall
+ * patch19: Initial revision
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+char *savestr();
+
+#undef bool
+#include <curses.h>
+
+#ifndef A_UNDERLINE
+#define NOSETATTR
+#define A_STANDOUT  0x0200
+#define A_UNDERLINE 0x0100
+#define A_REVERSE   0x0200
+#define A_BLINK     0x0400
+#define A_BOLD      0x0800
+#define A_ALTCHARSET 0x1000    
+#define A_NORMAL    0
+#endif
+
+#ifdef USG
+static char *tcbuf = NULL;
+#endif
+
+#ifdef NOSETATTR
+static unsigned curattr = NORMAL;
+#endif
+
+static enum uservars {
+    UV_curscr,
+    UV_stdscr,
+    UV_ttytype,
+    UV_LINES,
+    UV_COLS,
+    UV_ERR,
+    UV_OK,
+#ifdef BSD
+    UV_Def_term,
+    UV_My_term,
+#endif    
+    UV_A_STANDOUT,
+    UV_A_UNDERLINE,
+    UV_A_REVERSE,
+    UV_A_BLINK,
+    UV_A_DIM,
+    UV_A_BOLD,
+    UV_A_NORMAL,
+};
+
+static enum usersubs {
+    US_addch,
+    US_waddch,
+    US_addstr,
+    US_waddstr,
+    US_box,
+    US_clear,
+    US_wclear,
+    US_clearok,
+    US_clrtobot,
+    US_wclrtobot,
+    US_clrtoeol,
+    US_wclrtoeol,
+    US_delch,
+    US_wdelch,
+    US_deleteln,
+    US_wdeleteln,
+    US_erase,
+    US_werase,
+    US_idlok,
+    US_insch,
+    US_winsch,
+    US_insertln,
+    US_winsertln,
+    US_move,
+    US_wmove,
+    US_overlay,
+    US_overwrite,
+    US_refresh,
+    US_wrefresh,
+    US_standout,
+    US_wstandout,
+    US_standend,
+    US_wstandend,
+    US_cbreak,
+    US_nocbreak,
+    US_echo,
+    US_noecho,
+    US_getch,
+    US_wgetch,
+    US_getstr,
+    US_wgetstr,
+    US_raw,
+    US_noraw,
+    US_baudrate,
+    US_delwin,
+    US_endwin,
+    US_erasechar,
+    US_getyx,
+    US_inch,
+    US_winch,
+    US_initscr,
+    US_killchar,
+    US_leaveok,
+    US_longname,
+    US_mvwin,
+    US_newwin,
+    US_nl,
+    US_nonl,
+    US_scrollok,
+    US_subwin,
+    US_touchline,
+    US_touchwin,
+    US_unctrl,
+    US_gettmode,
+    US_mvcur,
+    US_scroll,
+    US_savetty,
+    US_resetty,
+    US_setterm,
+    US_attroff,
+    US_wattroff,
+    US_attron,
+    US_wattron,
+    US_attrset,
+    US_wattrset,
+#ifdef CURSEFMT
+    US_printw, /* remove */
+    US_wprintw, /* remove */
+    US_scanw, 	/* delete */
+    US_wscanw, 	/* delete */
+#endif
+    US_getcap,
+#ifdef BSD
+    US_flushok,
+    US_fullname,
+    US_touchoverlap,
+    US_tstp,
+    US__putchar,
+#endif
+    US_mysub,
+    US_testcallback,
+};
+
+static int usersub();
+static int userset();
+static int userval();
+
+int
+init_curses()
+{
+    struct ufuncs uf;
+    char *filename = "curses.c";
+
+    uf.uf_set = userset;
+    uf.uf_val = userval;
+
+#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
+
+    MAGICVAR("curscr",	UV_curscr);
+    MAGICVAR("stdscr",	UV_stdscr);
+    MAGICVAR("ttytype",	UV_ttytype);
+    MAGICVAR("LINES",	UV_LINES);
+    MAGICVAR("COLS",	UV_COLS);
+    MAGICVAR("ERR",	UV_ERR);
+    MAGICVAR("OK",	UV_OK);
+#ifdef BSD
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",	UV_My_term);
+#endif
+    MAGICVAR("A_STANDOUT", UV_A_STANDOUT);
+    MAGICVAR("A_UNDERLINE", UV_A_UNDERLINE);
+    MAGICVAR("A_REVERSE", UV_A_REVERSE);
+    MAGICVAR("A_BLINK", UV_A_BLINK);
+    MAGICVAR("A_DIM", UV_A_DIM);
+    MAGICVAR("A_BOLD", UV_A_BOLD);
+    MAGICVAR("A_NORMAL", UV_A_NORMAL);
+
+    make_usub("addch",		US_addch,	usersub, filename);
+    make_usub("waddch",		US_waddch,	usersub, filename);
+    make_usub("addstr",		US_addstr,	usersub, filename);
+    make_usub("waddstr",	US_waddstr,	usersub, filename);
+    make_usub("box",		US_box,		usersub, filename);
+    make_usub("clear",		US_clear,	usersub, filename);
+    make_usub("wclear",		US_wclear,	usersub, filename);
+    make_usub("clearok",	US_clearok,	usersub, filename);
+    make_usub("clrtobot",	US_clrtobot,	usersub, filename);
+    make_usub("wclrtobot",	US_wclrtobot,	usersub, filename);
+    make_usub("clrtoeol",	US_clrtoeol,	usersub, filename);
+    make_usub("wclrtoeol",	US_wclrtoeol,	usersub, filename);
+    make_usub("delch",		US_delch,	usersub, filename);
+    make_usub("wdelch",		US_wdelch,	usersub, filename);
+    make_usub("deleteln",	US_deleteln,	usersub, filename);
+    make_usub("wdeleteln",	US_wdeleteln,	usersub, filename);
+    make_usub("erase",		US_erase,	usersub, filename);
+    make_usub("werase",		US_werase,	usersub, filename);
+    make_usub("idlok",		US_idlok,	usersub, filename);
+    make_usub("insch",		US_insch,	usersub, filename);
+    make_usub("winsch",		US_winsch,	usersub, filename);
+    make_usub("insertln",	US_insertln,	usersub, filename);
+    make_usub("winsertln",	US_winsertln,	usersub, filename);
+    make_usub("move",		US_move,	usersub, filename);
+    make_usub("wmove",		US_wmove,	usersub, filename);
+    make_usub("overlay",	US_overlay,	usersub, filename);
+    make_usub("overwrite",	US_overwrite,	usersub, filename);
+    make_usub("refresh",	US_refresh,	usersub, filename);
+    make_usub("wrefresh",	US_wrefresh,	usersub, filename);
+    make_usub("standout",	US_standout,	usersub, filename);
+    make_usub("wstandout",	US_wstandout,	usersub, filename);
+    make_usub("standend",	US_standend,	usersub, filename);
+    make_usub("wstandend",	US_wstandend,	usersub, filename);
+    make_usub("cbreak",		US_cbreak,	usersub, filename);
+    make_usub("nocbreak",	US_nocbreak,	usersub, filename);
+    make_usub("echo",		US_echo,	usersub, filename);
+    make_usub("noecho",		US_noecho,	usersub, filename);
+    make_usub("getch",		US_getch,	usersub, filename);
+    make_usub("wgetch",		US_wgetch,	usersub, filename);
+    make_usub("getstr",		US_getstr,	usersub, filename);
+    make_usub("wgetstr",	US_wgetstr,	usersub, filename);
+    make_usub("raw",		US_raw,		usersub, filename);
+    make_usub("noraw",		US_noraw,	usersub, filename);
+    make_usub("baudrate",	US_baudrate,	usersub, filename);
+    make_usub("delwin",		US_delwin,	usersub, filename);
+    make_usub("endwin",		US_endwin,	usersub, filename);
+    make_usub("erasechar",	US_erasechar,	usersub, filename);
+    make_usub("getyx",		US_getyx,	usersub, filename);
+    make_usub("inch",		US_inch,	usersub, filename);
+    make_usub("winch",		US_winch,	usersub, filename);
+    make_usub("initscr",	US_initscr,	usersub, filename);
+    make_usub("killchar",	US_killchar,	usersub, filename);
+    make_usub("leaveok",	US_leaveok,	usersub, filename);
+    make_usub("longname",	US_longname,	usersub, filename);
+    make_usub("mvwin",		US_mvwin,	usersub, filename);
+    make_usub("newwin",		US_newwin,	usersub, filename);
+    make_usub("nl",		US_nl,		usersub, filename);
+    make_usub("nonl",		US_nonl,	usersub, filename);
+    make_usub("scrollok",	US_scrollok,	usersub, filename);
+    make_usub("subwin",		US_subwin,	usersub, filename);
+    make_usub("touchline",	US_touchline,	usersub, filename);
+    make_usub("touchwin",	US_touchwin,	usersub, filename);
+    make_usub("unctrl",		US_unctrl,	usersub, filename);
+    make_usub("gettmode",	US_gettmode,	usersub, filename);
+    make_usub("mvcur",		US_mvcur,	usersub, filename);
+    make_usub("scroll",		US_scroll,	usersub, filename);
+    make_usub("savetty",	US_savetty,	usersub, filename);
+    make_usub("resetty",	US_resetty,	usersub, filename);
+    make_usub("setterm",	US_setterm,	usersub, filename);
+    make_usub("getcap",		US_getcap,	usersub, filename);
+    make_usub("attroff",        US_attroff,	usersub, filename);
+    make_usub("wattroff",       US_wattroff,	usersub, filename);
+    make_usub("attron",         US_attron,	usersub, filename);
+    make_usub("wattron",        US_wattron,	usersub, filename);
+    make_usub("attrset",        US_attrset,	usersub, filename);
+    make_usub("wattrset",       US_wattrset,	usersub, filename);
+#ifdef CURSEFMT
+    make_usub("printw",		US_printw,	usersub, filename);
+    make_usub("wprintw",	US_wprintw,	usersub, filename);
+    make_usub("scanw",		US_scanw,	usersub, filename);
+    make_usub("wscanw",		US_wscanw,	usersub, filename);
+#endif
+#ifdef BSD
+    make_usub("flushok",	US_flushok,	usersub, filename);
+    make_usub("fullname",	US_fullname,	usersub, filename);
+    make_usub("touchoverlap",	US_touchoverlap,usersub, filename);
+    make_usub("tstp",		US_tstp,	usersub, filename);
+    make_usub("_putchar",	US__putchar,	usersub, filename);
+#endif
+    make_usub("testcallback",	US_testcallback,usersub, filename);
+  };
+  
+#ifdef USG
+static char
+*getcap(cap)
+register char *cap;
+{
+    static char nocaperr[] = "Cannot read termcap entry.";
+
+    extern char *tgetstr();
+
+    if (tcbuf == NULL) {
+	if ((tcbuf = malloc(1024)) == NULL) {
+	    fatal(nocaperr);
+	}
+	if (tgetent(tcbuf, ttytype) == -1) {
+	    fatal(nocaperr);
+	}
+    }
+
+    return (tgetstr(cap, NULL));
+}
+#endif
+
+#ifdef NOSETATTR
+#define attron(attr)    wattron(stdscr, attr)
+#define attroff(attr)   wattroff(stdscr, attr)
+#define attset(attr)    wattset(stdscr, attr)
+
+int
+wattron(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr |= attr;
+    if (curattr & A_STANDOUT) {
+	return(wstandout(win));
+    } else {
+	return(wstandend(win));
+    }
+}
+
+int
+wattroff(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr &= (~attr);
+    if (curattr & A_STANDOUT) {
+	return(wstandout(win));
+    } else {
+	return(wstandend(win));
+    }
+}
+
+int
+wattrset(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr = attr;
+    if (curattr & A_STANDOUT) {
+	return(wstandout(win));
+    } else {
+	return(wstandend(win));
+    }
+}
+
+#endif
+    
+static int
+usersub(ix, sp, items)
+int ix;
+register int sp;
+register int items;
+{
+    STR **st = stack->ary_array + sp;
+    register int i;
+    register char *tmps;
+    register STR *Str;		/* used in str_get and str_gnum macros */
+
+    switch (ix) {
+CASE int addch
+I	char		ch
+END
+
+CASE int waddch
+I	WINDOW*		win
+I	char		ch
+END
+
+CASE int addstr
+I	char*		str
+END
+
+CASE int waddstr
+I	WINDOW*		win
+I	char*		str
+END
+
+CASE int box
+I	WINDOW*		win
+I	char		vert
+I	char		hor
+END
+
+CASE int clear
+END
+
+CASE int wclear
+I	WINDOW*		win
+END
+
+CASE int clearok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int clrtobot
+END
+
+CASE int wclrtobot
+I	WINDOW*		win
+END
+
+CASE int clrtoeol
+END
+
+CASE int wclrtoeol
+I	WINDOW*		win
+END
+
+CASE int delch
+END
+
+CASE int wdelch
+I	WINDOW*		win
+END
+
+CASE int deleteln
+END
+
+CASE int wdeleteln
+I	WINDOW*		win
+END
+
+CASE int erase
+END
+
+CASE int werase
+I	WINDOW*		win
+END
+
+CASE int idlok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int insch
+I	char		c
+END
+
+CASE int winsch
+I	WINDOW*		win
+I	char		c
+END
+
+CASE int insertln
+END
+
+CASE int winsertln
+I	WINDOW*		win
+END
+
+CASE int move
+I	int		y
+I	int		x
+END
+
+CASE int wmove
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE int overlay
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int overwrite
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int refresh
+END
+
+CASE int wrefresh
+I	WINDOW*		win
+END
+
+CASE int standout
+END
+
+CASE int wstandout
+I	WINDOW*		win
+END
+
+CASE int standend
+END
+
+CASE int wstandend
+I	WINDOW*		win
+END
+
+CASE int cbreak
+END
+
+CASE int nocbreak
+END
+
+CASE int echo
+END
+
+CASE int noecho
+END
+
+    case US_getch:
+	if (items != 0)
+	    fatal("Usage: &getch()");
+	else {
+	    int retval;
+	    char retch;
+
+	    retval = getch();
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		if (retval > 0377)
+			str_numset(st[0], (double) retval);
+		else
+			str_nset(st[0], &retch, 1);
+	    }
+	}
+	return sp;
+
+    case US_wgetch:
+	if (items != 1)
+	    fatal("Usage: &wgetch($win)");
+	else {
+	    int retval;
+	    char retch;
+	    WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+	    retval = wgetch(win);
+	    if (retval == EOF)
+		st[0] = &str_undef;
+	    else {
+		retch = retval;
+		if (retval > 0377)
+			str_numset(st[0], (double) retval);
+		else
+			str_nset(st[0], &retch, 1);
+	    }
+	}
+	return sp;
+
+CASE int getstr
+O	char*		str
+END
+
+CASE int wgetstr
+I	WINDOW*		win
+O	char*		str
+END
+
+CASE int raw
+END
+
+CASE int noraw
+END
+
+CASE int baudrate
+END
+
+CASE int delwin
+I	WINDOW*		win
+END
+
+CASE int endwin
+END
+
+CASE int erasechar
+END
+
+    case US_getyx:
+	if (items != 3)
+	    fatal("Usage: &getyx($win, $y, $x)");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+	    int		y;
+	    int		x;
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = getyx(win, y, x);
+	    str_numset(st[2], (double)y);
+	    str_numset(st[3], (double)x);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+	
+CASE int inch
+END
+
+CASE int winch
+I	WINDOW*		win
+END
+
+CASE WINDOW* initscr
+END
+
+CASE int killchar
+END
+
+CASE int leaveok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+#ifdef BSD
+CASE char* longname
+I	char*		termbuf
+IO	char*		name
+END
+#else
+CASE char* longname
+I	char*		termbug
+I	char*		name
+END
+#endif
+
+CASE int mvwin
+I	WINDOW*		win
+I	int		y
+I	int		x
+END
+
+CASE WINDOW* newwin
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int nl
+END
+
+CASE int nonl
+END
+
+CASE int scrollok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE WINDOW* subwin
+I	WINDOW*		win
+I	int		lines
+I	int		cols
+I	int		begin_y
+I	int		begin_x
+END
+
+CASE int touchline
+I	WINDOW*		win
+I	int		y
+I	int		startx
+I	int		endx
+END
+
+CASE int touchwin
+I	WINDOW*		win
+END
+
+CASE char* unctrl
+I	char		ch
+END
+
+CASE int gettmode
+END
+
+CASE int mvcur
+I	int		lasty
+I	int		lastx
+I	int		newy
+I	int		newx
+END
+
+CASE int scroll
+I	WINDOW*		win
+END
+
+CASE int savetty
+END
+
+CASE void resetty
+END
+
+CASE int setterm
+I	char*		name
+END
+
+CASE int attroff
+I       chtype          str
+END
+
+CASE int wattroff
+I       chtype          str
+END
+
+CASE int wattron
+I       chtype          str
+END
+
+CASE int attron
+I       chtype          str
+END
+
+CASE int attrset
+I       chtype          str
+END
+
+CASE int wattrset
+I       chtype          str
+END
+
+#ifdef	CURSEFMT
+    case US_printw:
+	if (items < 1)
+	    fatal("Usage: &printw($fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = addstr(str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+    case US_wprintw:
+	if (items < 2)
+	    fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )");
+	else {
+	    int retval;
+	    STR*	str =		str_new(0);
+	    WINDOW*	win =		*(WINDOW**)	str_get(st[1]);
+
+	    do_sprintf(str, items - 1, st + 1);
+	    retval = waddstr(win, str->str_ptr);
+	    str_numset(st[0], (double) retval);
+	    str_free(str);
+	}
+	return sp;
+
+#endif
+
+CASE char* getcap
+I	char*		str
+END
+
+#ifdef BSD
+CASE int flushok
+I	WINDOW*		win
+I	bool		boolf
+END
+
+CASE int fullname
+I	char*		termbuf
+IO	char*		name
+END
+
+CASE int touchoverlap
+I	WINDOW*		win1
+I	WINDOW*		win2
+END
+
+CASE int tstp
+END
+
+CASE int _putchar
+I	char		ch
+END
+
+    case US_testcallback:
+	sp = callback("callback", sp + items, curcsv->wantarray, 1, items);
+	break;
+
+#endif
+
+    default:
+	fatal("Unimplemented user-defined subroutine");
+    }
+    return sp;
+}
+
+static int
+userval(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	str_numset(str, (double)COLS);
+	break;
+    case UV_ERR:
+	str_numset(str, (double)ERR);
+	break;
+    case UV_LINES:
+	str_numset(str, (double)LINES);
+	break;
+    case UV_OK:
+	str_numset(str, (double)OK);
+	break;
+    case UV_curscr:
+	str_nset(str, &curscr, sizeof(WINDOW*));
+	break;
+    case UV_stdscr:
+	str_nset(str, &stdscr, sizeof(WINDOW*));
+	break;
+    case UV_ttytype:
+	str_set(str, ttytype);
+	break;
+#ifdef BSD
+    case UV_Def_term:
+	str_set(str, Def_term);
+	break;
+    case UV_My_term:
+	str_numset(str, (double)My_term);
+	break;
+#endif
+    case UV_A_STANDOUT:
+	str_numset(str, (double)A_STANDOUT);
+	break;
+    case UV_A_UNDERLINE:
+	str_numset(str, (double)A_UNDERLINE);
+	break;
+    case UV_A_REVERSE:
+	str_numset(str, (double)A_REVERSE);
+	break;
+    case UV_A_BLINK:
+	str_numset(str, (double)A_BLINK);
+	break;
+    case UV_A_DIM:
+	str_numset(str, (double)A_DIM);
+	break;
+    case UV_A_BOLD:
+	str_numset(str, (double)A_BOLD);
+	break;
+    case UV_A_NORMAL:
+	str_numset(str, (double)A_NORMAL);
+	break;
+    }
+    return 0;
+}
+
+static int
+userset(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+	COLS = (int)str_gnum(str);
+	break;
+    case UV_LINES:
+	LINES = (int)str_gnum(str);
+	break;
+    case UV_ttytype:
+	strcpy(ttytype, str_get(str));		/* hope it fits */
+#ifdef USG
+	if (tcbuf != NULL) {
+	    free(tcbuf);
+	    tcbuf = NULL;
+	}
+#endif	
+	break;
+#ifdef BSD
+    case UV_Def_term:
+	Def_term = savestr(str_get(str));	/* never freed */
+	break;
+    case UV_My_term:
+	My_term = (bool)str_gnum(str);
+	break;
+#endif
+    }
+    return 0;
+}
diff --git a/gnu/usr.bin/perl/perl/usub/man2mus b/gnu/usr.bin/perl/perl/usub/man2mus
new file mode 100644
index 000000000000..a3046784f423
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/man2mus
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+while (<>) {
+    if (/^\.SH SYNOPSIS/) {
+	$spec = '';
+	for ($_ = <>; $_ && !/^\.SH/; $_ = <>) {
+	    s/^\.[IRB][IRB]\s*//;
+	    s/^\.[IRB]\s+//;
+	    next if /^\./;
+	    s/\\f\w//g;
+	    s/\\&//g;
+	    s/^\s+//;
+	    next if /^$/;
+	    next if /^#/;
+	    $spec .= $_;
+	}
+	$_ = $spec;
+	0 while s/\(([^),;]*)\s*,\s*([^);]*)\)/($1|$2)/g;
+	s/\(\*([^,;]*)\)\(\)/(*)()$1/g;
+	s/(\w+)\[\]/*$1/g;
+
+	s/\n/ /g;
+	s/\s+/ /g;
+	s/(\w+) \(([^*])/$1($2/g;
+	s/^ //;
+	s/ ?; ?/\n/g;
+	s/\) /)\n/g;
+	s/ \* / \*/g;
+	s/\* / \*/g;
+
+	$* = 1;
+	0 while s/^((struct )?\w+ )([^\n,]*), ?(.*)/$1$3\n$1$4/g;
+	$* = 0;
+	s/\|/,/g;
+
+	@cases = ();
+	for (reverse split(/\n/,$_)) {
+	    if (/\)$/) {
+		($type,$name,$args) = split(/(\w+)\(/);
+		$type =~ s/ $//;
+		if ($type =~ /^(\w+) =/) {
+		    $type = $type{$1} if $type{$1};
+		}
+		$type = 'int' if $type eq '';
+		@args = grep(/./, split(/[,)]/,$args));
+		$case = "CASE $type $name\n";
+		foreach $arg (@args) {
+		    $type = $type{$arg} || "int";
+		    $type =~ s/ //g;
+		    $type .= "\t" if length($type) < 8;
+		    if ($type =~ /\*/) {
+			$case .= "IO	$type	$arg\n";
+		    }
+		    else {
+			$case .= "I	$type	$arg\n";
+		    }
+		}
+		$case .= "END\n\n";
+		unshift(@cases, $case);
+	    }
+	    else {
+		$type{$name} = $type if ($type,$name) = /(.*\W)(\w+)$/;
+	    }
+	}
+	print @cases;
+    }
+}
diff --git a/gnu/usr.bin/perl/perl/usub/mus b/gnu/usr.bin/perl/perl/usub/mus
new file mode 100755
index 000000000000..b1675fdc5879
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/mus
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+
+while (<>) {
+    if (s/^CASE\s+//) {
+	@fields = split;
+	$funcname = pop(@fields);
+	$rettype = "@fields";
+	@modes = ();
+	@types = ();
+	@names = ();
+	@outies = ();
+	@callnames = ();
+	$pre = "\n";
+	$post = '';
+
+	while (<>) {
+	    last unless /^[IO]+\s/;
+	    @fields = split(' ');
+	    push(@modes, shift(@fields));
+	    push(@names, pop(@fields));
+	    push(@types, "@fields");
+	}
+	while (s/^<\s//) {
+	    $pre .= "\t    $_";
+	    $_ = <>;
+	}
+	while (s/^>\s//) {
+	    $post .= "\t    $_";
+	    $_ = <>;
+	}
+	$items = @names;
+	$namelist = '$' . join(', $', @names);
+	$namelist = '' if $namelist eq '$';
+	print <<EOF;
+    case US_$funcname:
+	if (items != $items)
+	    fatal("Usage: &$funcname($namelist)");
+	else {
+EOF
+	if ($rettype eq 'void') {
+	    print <<EOF;
+	    int retval = 1;
+EOF
+	}
+	else {
+	    print <<EOF;
+	    $rettype retval;
+EOF
+	}
+	foreach $i (1..@names) {
+	    $mode = $modes[$i-1];
+	    $type = $types[$i-1];
+	    $name = $names[$i-1];
+	    if ($type =~ /^[A-Z]+\*$/) {
+		$cast = "*($type*)";
+	    }
+	    else {
+		$cast = "($type)";
+	    }
+	    $what = ($type =~ /^(struct\s+\w+|char|[A-Z]+)\s*\*$/ ? "get" : "gnum");
+	    $type .= "\t" if length($type) < 4;
+	    $cast .= "\t" if length($cast) < 8;
+	    $x = "\t" x (length($name) < 6);
+	    if ($mode =~ /O/) {
+		if ($what eq 'gnum') {
+		    push(@outies, "\t    str_numset(st[$i], (double) $name);\n");
+		    push(@callnames, "&$name");
+		}
+		else {
+		    push(@outies, "\t    str_set(st[$i], (char*) $name);\n");
+		    push(@callnames, "$name");
+		}
+	    }
+	    else {
+		push(@callnames, $name);
+	    }
+	    if ($mode =~ /I/) {
+	    print <<EOF;
+	    $type	$name =$x	$cast	str_$what(st[$i]);
+EOF
+	    }
+            elsif ($type =~ /char/) {
+            print <<EOF;
+	    char	${name}[133];
+EOF
+	    }
+	    else {
+		print <<EOF;
+	    $type	$name;
+EOF
+	    }
+	}
+	$callnames = join(', ', @callnames);
+	$outies = join("\n",@outies);
+	if ($rettype eq 'void') {
+	    print <<EOF;
+$pre	    (void)$funcname($callnames);
+EOF
+	}
+	else {
+	    print <<EOF;
+$pre	    retval = $funcname($callnames);
+EOF
+	}
+	if ($rettype =~ /^(struct\s+\w+|char)\s*\*$/) {
+	    print <<EOF;
+	    str_set(st[0], (char*) retval);
+EOF
+	}
+	elsif ($rettype =~ /^[A-Z]+\s*\*$/) {
+	    print <<EOF;
+	    str_nset(st[0], (char*) &retval, sizeof retval);
+EOF
+	}
+	else {
+	    print <<EOF;
+	    str_numset(st[0], (double) retval);
+EOF
+	}
+	print $outies if $outies;
+	print $post if $post;
+	if (/^END/) {
+	    print "\t}\n\treturn sp;\n";
+	}
+	else {
+	    redo;
+	}
+    }
+    elsif (/^END/) {
+	print "\t}\n\treturn sp;\n";
+    }
+    else {
+	print;
+    }
+}
diff --git a/gnu/usr.bin/perl/perl/usub/pager b/gnu/usr.bin/perl/perl/usub/pager
new file mode 100644
index 000000000000..407bc506707b
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/pager
@@ -0,0 +1,190 @@
+#!./curseperl
+
+eval <<'EndOfMain';   $evaloffset = __LINE__;
+
+    $SIG{'INT'} = 'endit';
+    $| = 1;		# command buffering on stdout
+    &initterm;
+    &inithelp;
+    &slurpfile && &pagearray;
+
+EndOfMain
+
+&endit;
+
+################################################################################
+
+sub initterm {
+
+    &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
+    &defbell unless defined &bell;
+
+    $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
+    $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
+
+    $dl = &getcap('dl');
+    $al = &getcap('al');
+    $ho = &getcap('ho');
+    $ce = &getcap('ce');
+}
+
+sub slurpfile {
+    while (<>) {
+	s/^(\t+)/'        ' x length($1)/e;
+	&expand($_) if /\t/;
+	if (length($_) < $cols) {
+	    push(@lines, $_);
+	}
+	else {
+	    while ($_ && $_ ne "\n") {
+		push(@lines, substr($_,0,$cols));
+		substr($_,0,$cols) = '';
+	    }
+	}
+    }
+    1;
+}
+
+sub drawscreen {
+    &move(0,0);
+    for ($line .. $line + $lines2) {
+	&addstr($lines[$_]);
+    }
+    &clrtobot;
+    &percent;
+    &refresh;
+}
+
+sub expand {
+    while (($off = index($_[0],"\t")) >= 0) {
+	substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
+    }
+}
+
+sub pagearray {
+    $line = 0;
+
+    $| = 1;
+
+    for (&drawscreen;;&drawscreen) {
+
+	$ch = &getch;
+	$ch = 'j' if $ch eq "\n";
+
+	if ($ch eq ' ') {
+	    last if $percent >= 100;
+	    &move(0,0);
+	    $line += $lines1;
+	}
+	elsif ($ch eq 'b') {
+	    $line -= $lines1;
+	    &move(0,0);
+	    $line = 0 if $line < 0;
+	}
+	elsif ($ch eq 'j') {
+	    next if $percent >= 100;
+	    $line += 1;
+	    if ($dl && $ho) {
+		print $ho, $dl;
+		&mvcur(0,0,$lines2,0);
+		print $ce,$lines[$line+$lines2],$ce;
+		&wmove($curscr,0,0);
+		&wdeleteln($curscr);
+		&wmove($curscr,$lines2,0);
+		&waddstr($curscr,$lines[$line+$lines2]);
+	    }
+	    &wmove($stdscr,0,0);
+	    &wdeleteln($stdscr);
+	    &wmove($stdscr,$lines2,0);
+	    &waddstr($stdscr,$lines[$line+$lines2]);
+	    &percent;
+	    &refresh;
+	    redo;
+	}
+	elsif ($ch eq 'k') {
+	    next if $line <= 0;
+	    $line -= 1;
+	    if ($al && $ho && $ce) {
+		print $ho, $al, $ce, $lines[$line];
+		&wmove($curscr,0,0);
+		&winsertln($curscr);
+		&waddstr($curscr,$lines[$line]);
+	    }
+	    &wmove($stdscr,0,0);
+	    &winsertln($stdscr);
+	    &waddstr($stdscr,$lines[$line]);
+	    &percent;
+	    &refresh;
+	    redo;
+	}
+	elsif ($ch eq "\f") {
+	    &clear;
+	}
+	elsif ($ch eq 'q') {
+	    last;
+	}
+	elsif ($ch eq 'h') {
+	    &clear;
+	    &help;
+	    &clear;
+	}
+	else {
+	    &bell;
+	}
+    }
+}
+
+sub defbell {
+    eval q#
+	sub bell {
+	    print "\007";
+	}
+    #;
+}
+
+sub help {
+    local(*lines) = *helplines;
+    local($line);
+    &pagearray;
+}
+
+sub inithelp {
+    @helplines = split(/\n/,<<'EOT');
+
+  h              Display this help.
+  q              Exit.
+
+  SPACE          Forward  screen.
+  b              Backward screen.
+  j, CR          Forward  1 line.
+  k              Backward 1 line.
+  FF             Repaint screen.
+EOT
+    for (@helplines) {
+	s/$/\n/;
+    }
+}
+
+sub percent {
+    &standout;
+      $percent = int(($line + $lines1) * 100 / @lines);
+      &move($lines1,0);
+      &addstr("($percent%)");
+    &standend;
+    &clrtoeol;
+}
+
+sub endit {
+    &move($lines1,0);
+    &clrtoeol;
+    &refresh;
+    &endwin;
+
+    if ($@) {
+	print "";				# force flush of stdout
+	$@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
+	die $@;
+    }
+
+    exit;
+}
diff --git a/gnu/usr.bin/perl/perl/usub/usersub.c b/gnu/usr.bin/perl/perl/usub/usersub.c
new file mode 100644
index 000000000000..ca9d2ba49b38
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/usub/usersub.c
@@ -0,0 +1,75 @@
+/* $RCSfile: usersub.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:07 $
+ *
+ * $Log: usersub.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:30:07  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/11/05  19:07:24  lwall
+ * patch11: there are now subroutines for calling back from C into Perl
+ * 
+ * Revision 4.0  91/03/20  01:56:34  lwall
+ * 4.0 baseline.
+ * 
+ * Revision 3.0.1.1  90/08/09  04:06:10  lwall
+ * patch19: Initial revision
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+int
+userinit()
+{
+    init_curses();
+}
+
+/* Be sure to refetch the stack pointer after calling these routines. */
+
+int
+callback(subname, sp, gimme, hasargs, numargs)
+char *subname;
+int sp;			/* stack pointer after args are pushed */
+int gimme;		/* called in array or scalar context */
+int hasargs;		/* whether to create a @_ array for routine */
+int numargs;		/* how many args are pushed on the stack */
+{
+    static ARG myarg[3];	/* fake syntax tree node */
+    int arglast[3];
+    
+    arglast[2] = sp;
+    sp -= numargs;
+    arglast[1] = sp--;
+    arglast[0] = sp;
+
+    if (!myarg[0].arg_ptr.arg_str)
+	myarg[0].arg_ptr.arg_str = str_make("",0);
+
+    myarg[1].arg_type = A_WORD;
+    myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE);
+
+    myarg[2].arg_type = hasargs ? A_EXPR : A_NULL;
+
+    return do_subr(myarg, gimme, arglast);
+}
+
+int
+callv(subname, sp, gimme, argv)
+char *subname;
+register int sp;	/* current stack pointer */
+int gimme;		/* called in array or scalar context */
+register char **argv;	/* null terminated arg list, NULL for no arglist */
+{
+    register int items = 0;
+    int hasargs = (argv != 0);
+
+    astore(stack, ++sp, Nullstr);	/* reserve spot for 1st return arg */
+    if (hasargs) {
+	while (*argv) {
+	    astore(stack, ++sp, str_2mortal(str_make(*argv,0)));
+	    items++;
+	    argv++;
+	}
+    }
+    return callback(subname, sp, gimme, hasargs, items);
+}
diff --git a/gnu/usr.bin/perl/perl/util.c b/gnu/usr.bin/perl/perl/util.c
new file mode 100644
index 000000000000..574898357382
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/util.c
@@ -0,0 +1,1780 @@
+/* $RCSfile: util.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:40 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:40  nate
+ * PERL!
+ *
+ * Revision 4.0.1.6  92/06/11  21:18:47  lwall
+ * patch34: boneheaded typo in my_bcopy()
+ * 
+ * Revision 4.0.1.5  92/06/08  16:08:37  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: bcopy() and memcpy() now tested for overlap safety
+ * patch20: added Atari ST portability
+ * 
+ * Revision 4.0.1.4  91/11/11  16:48:54  lwall
+ * patch19: study was busted by 4.018
+ * patch19: added little-endian pack/unpack options
+ * 
+ * Revision 4.0.1.3  91/11/05  19:18:26  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * patch11: index("little", "longer string") could visit faraway places
+ * patch11: warn '-' x 10000 dumped core
+ * patch11: forked exec on non-existent program now issues a warning
+ * 
+ * Revision 4.0.1.2  91/06/07  12:10:42  lwall
+ * patch4: new copyright notice
+ * patch4: made some allowances for "semi-standard" C
+ * patch4: index() could blow up searching for null string
+ * patch4: taintchecks could improperly modify parent in vfork()
+ * patch4: exec would close files even if you cleared close-on-exec flag
+ * 
+ * Revision 4.0.1.1  91/04/12  09:19:25  lwall
+ * patch1: random cleanup in cpp namespace
+ * 
+ * Revision 4.0  91/03/20  01:56:39  lwall
+ * 4.0 baseline.
+ * 
+ */
+/*SUPPRESS 112*/
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+#ifdef I_VFORK
+#  include <vfork.h>
+#endif
+
+#ifdef I_VARARGS
+#  include <varargs.h>
+#endif
+
+#ifdef I_FCNTL
+#  include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#  include <sys/file.h>
+#endif
+
+#define FLUSH
+
+#ifndef safemalloc
+
+static char nomem[] = "Out of memory!\n";
+
+/* paranoid version of malloc */
+
+#ifdef DEBUGGING
+static int an = 0;
+#endif
+
+/* 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;
+#ifndef STANDARD_C
+    char *malloc();
+#endif /* ! STANDARD_C */
+
+#ifdef MSDOS
+	if (size > 0xffff) {
+		fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
+		exit(1);
+	}
+#endif /* MSDOS */
+#ifdef DEBUGGING
+    if ((long)size < 0)
+	fatal("panic: malloc");
+#endif
+    ptr = malloc(size?size:1);	/* malloc(0) is NASTY on our system */
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+    if (debug & 128)
+	fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size);
+#  else
+    if (debug & 128)
+	fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size);
+#  endif
+#endif
+    if (ptr != Nullch)
+	return ptr;
+    else if (nomemok)
+	return Nullch;
+    else {
+	fputs(nomem,stderr) FLUSH;
+	exit(1);
+    }
+    /*NOTREACHED*/
+#ifdef lint
+    return ptr;
+#endif
+}
+
+/* paranoid version of realloc */
+
+char *
+saferealloc(where,size)
+char *where;
+#ifndef MSDOS
+MEM_SIZE size;
+#else
+unsigned long size;
+#endif /* MSDOS */
+{
+    char *ptr;
+#ifndef STANDARD_C
+    char *realloc();
+#endif /* ! STANDARD_C */
+
+#ifdef MSDOS
+	if (size > 0xffff) {
+		fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
+		exit(1);
+	}
+#endif /* MSDOS */
+    if (!where)
+	fatal("Null realloc");
+#ifdef DEBUGGING
+    if ((long)size < 0)
+	fatal("panic: realloc");
+#endif
+    ptr = realloc(where,size?size:1);	/* realloc(0) is NASTY on our system */
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+    if (debug & 128) {
+	fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
+	fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    }
+#  else
+    if (debug & 128) {
+	fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
+	fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    }
+#  endif
+#endif
+    if (ptr != Nullch)
+	return ptr;
+    else if (nomemok)
+	return Nullch;
+    else {
+	fputs(nomem,stderr) FLUSH;
+	exit(1);
+    }
+    /*NOTREACHED*/
+#ifdef lint
+    return ptr;
+#endif
+}
+
+/* safe version of free */
+
+void
+safefree(where)
+char *where;
+{
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+    if (debug & 128)
+	fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
+#  else
+    if (debug & 128)
+	fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
+#  endif
+#endif
+    if (where) {
+	/*SUPPRESS 701*/
+	free(where);
+    }
+}
+
+#endif /* !safemalloc */
+
+#ifdef LEAKTEST
+
+#define ALIGN sizeof(long)
+
+char *
+safexmalloc(x,size)
+int 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;
+{
+    return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
+}
+
+void
+safexfree(where)
+char *where;
+{
+    int x;
+
+    if (!where)
+	return;
+    where -= ALIGN;
+    x = where[0] + 100 * where[1];
+    xcount[x]--;
+    safefree(where);
+}
+
+static void
+xstat()
+{
+    register int 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;
+int *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 int 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 int 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 int 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;
+}
+
+unsigned char fold[] = {
+	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
+};
+
+static unsigned char freq[] = {
+	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
+};
+
+void
+fbmcompile(str, iflag)
+STR *str;
+int iflag;
+{
+    register unsigned char *s;
+    register unsigned char *table;
+    register unsigned int i;
+    register unsigned int len = str->str_cur;
+    int rarest = 0;
+    unsigned int frequency = 256;
+
+    Str_Grow(str,len+258);
+#ifndef lint
+    table = (unsigned char*)(str->str_ptr + len + 1);
+#else
+    table = Null(unsigned char*);
+#endif
+    s = table - 2;
+    for (i = 0; i < 256; i++) {
+	table[i] = len;
+    }
+    i = 0;
+#ifndef lint
+    while (s >= (unsigned char*)(str->str_ptr))
+#endif
+    {
+	if (table[*s] == len) {
+#ifndef pdp11
+	    if (iflag)
+		table[*s] = table[fold[*s]] = i;
+#else
+	    if (iflag) {
+		int j;
+		j = fold[*s];
+		table[j] = i;
+		table[*s] = i;
+	    }
+#endif /* pdp11 */
+	    else
+		table[*s] = i;
+	}
+	s--,i++;
+    }
+    str->str_pok |= SP_FBM;		/* deep magic */
+
+#ifndef lint
+    s = (unsigned char*)(str->str_ptr);		/* deeper magic */
+#else
+    s = Null(unsigned char*);
+#endif
+    if (iflag) {
+	register unsigned int tmp, foldtmp;
+	str->str_pok |= SP_CASEFOLD;
+	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]];
+	    }
+	}
+    }
+    str->str_rare = s[rarest];
+    str->str_state = rarest;
+#ifdef DEBUGGING
+    if (debug & 512)
+	fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_state);
+#endif
+}
+
+char *
+fbminstr(big, bigend, littlestr)
+unsigned char *big;
+register unsigned char *bigend;
+STR *littlestr;
+{
+    register unsigned char *s;
+    register int tmp;
+    register int littlelen;
+    register unsigned char *little;
+    register unsigned char *table;
+    register unsigned char *olds;
+    register unsigned char *oldlittle;
+
+#ifndef lint
+    if (!(littlestr->str_pok & SP_FBM)) {
+	if (!littlestr->str_ptr)
+	    return (char*)big;
+	return ninstr((char*)big,(char*)bigend,
+		littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
+    }
+#endif
+
+    littlelen = littlestr->str_cur;
+#ifndef lint
+    if (littlestr->str_pok & SP_TAIL && !multiline) {	/* tail anchored? */
+	if (littlelen > bigend - big)
+	    return Nullch;
+	little = (unsigned char*)littlestr->str_ptr;
+	if (littlestr->str_pok & SP_CASEFOLD) {	/* 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(s,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(s,little,littlelen)==0)
+		    return (char*)s;
+	    }
+	    return Nullch;
+	}
+    }
+    table = (unsigned char*)(littlestr->str_ptr + littlelen + 1);
+#else
+    table = Null(unsigned char*);
+#endif
+    if (--littlelen >= bigend - big)
+	return Nullch;
+    s = big + littlelen;
+    oldlittle = little = table - 2;
+    if (littlestr->str_pok & SP_CASEFOLD) {	/* 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;
+		}
+#ifndef lint
+		return (char *)s;
+#endif
+	    }
+	}
+    }
+    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;
+		}
+#ifndef lint
+		return (char *)s;
+#endif
+	    }
+	}
+    }
+    return Nullch;
+}
+
+char *
+screaminstr(bigstr, littlestr)
+STR *bigstr;
+STR *littlestr;
+{
+    register unsigned char *s, *x;
+    register unsigned char *big;
+    register int pos;
+    register int previous;
+    register int first;
+    register unsigned char *little;
+    register unsigned char *bigend;
+    register unsigned char *littleend;
+
+    if ((pos = screamfirst[littlestr->str_rare]) < 0) 
+	return Nullch;
+#ifndef lint
+    little = (unsigned char *)(littlestr->str_ptr);
+#else
+    little = Null(unsigned char *);
+#endif
+    littleend = little + littlestr->str_cur;
+    first = *little++;
+    previous = littlestr->str_state;
+#ifndef lint
+    big = (unsigned char *)(bigstr->str_ptr);
+#else
+    big = Null(unsigned char*);
+#endif
+    bigend = big + bigstr->str_cur;
+    while (pos < previous) {
+#ifndef lint
+	if (!(pos += screamnext[pos]))
+#endif
+	    return Nullch;
+    }
+#ifdef POINTERRIGOR
+    if (littlestr->str_pok & SP_CASEFOLD) {	/* 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)
+#ifndef lint
+		return (char *)(big+pos-previous);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]	/* does this goof up anywhere? */
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+    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)
+#ifndef lint
+		return (char *)(big+pos-previous);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+#else /* !POINTERRIGOR */
+    big -= previous;
+    if (littlestr->str_pok & SP_CASEFOLD) {	/* 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)
+#ifndef lint
+		return (char *)(big+pos);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]	/* does this goof up anywhere? */
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+    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)
+#ifndef lint
+		return (char *)(big+pos);
+#else
+		return Nullch;
+#endif
+	} while (
+#ifndef lint
+		pos += screamnext[pos]
+#else
+		pos += screamnext[0]
+#endif
+	    );
+    }
+#endif /* POINTERRIGOR */
+    return Nullch;
+}
+
+/* copy a string to a safe spot */
+
+char *
+savestr(str)
+char *str;
+{
+    register char *newaddr;
+
+    New(902,newaddr,strlen(str)+1,char);
+    (void)strcpy(newaddr,str);
+    return newaddr;
+}
+
+/* same thing but with a known length */
+
+char *
+nsavestr(str, len)
+char *str;
+register int len;
+{
+    register char *newaddr;
+
+    New(903,newaddr,len+1,char);
+    Copy(str,newaddr,len,char);		/* might not be null terminated */
+    newaddr[len] = '\0';		/* is now */
+    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)
+	    Renew(*strptr,newlen,char);
+	else
+	    New(905,*strptr,newlen,char);
+	*curlen = newlen;
+    }
+}
+
+#ifndef I_VARARGS
+/*VARARGS1*/
+char *
+mess(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    char *s;
+    int usermess = strEQ(pat,"%s");
+    STR *tmpstr;
+
+    s = buf;
+    if (usermess) {
+	tmpstr = str_mortal(&str_undef);
+	str_set(tmpstr, (char*)a1);
+	*s++ = tmpstr->str_ptr[tmpstr->str_cur-1];
+    }
+    else {
+	(void)sprintf(s,pat,a1,a2,a3,a4);
+	s += strlen(s);
+    }
+
+    if (s[-1] != '\n') {
+	if (curcmd->c_line) {
+	    (void)sprintf(s," at %s line %ld",
+	      stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
+	    s += strlen(s);
+	}
+	if (last_in_stab &&
+	    stab_io(last_in_stab) &&
+	    stab_io(last_in_stab)->lines ) {
+	    (void)sprintf(s,", <%s> line %ld",
+	      last_in_stab == argvstab ? "" : stab_ename(last_in_stab),
+	      (long)stab_io(last_in_stab)->lines);
+	    s += strlen(s);
+	}
+	(void)strcpy(s,".\n");
+	if (usermess)
+	    str_cat(tmpstr,buf+1);
+    }
+    if (usermess)
+	return tmpstr->str_ptr;
+    else
+	return buf;
+}
+
+/*VARARGS1*/
+void fatal(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    extern FILE *e_fp;
+    extern char *e_tmpname;
+    char *tmps;
+    char *message;
+
+    message = mess(pat,a1,a2,a3,a4);
+    if (in_eval) {
+	str_set(stab_val(stabent("@",TRUE)),message);
+	tmps = "_EVAL_";
+	while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
+	  strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
+#ifdef DEBUGGING
+	    if (debug & 4) {
+		deb("(Skipping label #%d %s)\n",loop_ptr,
+		    loop_stack[loop_ptr].loop_label);
+	    }
+#endif
+	    loop_ptr--;
+	}
+#ifdef DEBUGGING
+	if (debug & 4) {
+	    deb("(Found label #%d %s)\n",loop_ptr,
+		loop_stack[loop_ptr].loop_label);
+	}
+#endif
+	if (loop_ptr < 0) {
+	    in_eval = 0;
+	    fatal("Bad label: %s", tmps);
+	}
+	longjmp(loop_stack[loop_ptr].loop_env, 1);
+    }
+    fputs(message,stderr);
+    (void)fflush(stderr);
+    if (e_fp)
+	(void)UNLINK(e_tmpname);
+    statusvalue >>= 8;
+    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+}
+
+/*VARARGS1*/
+void warn(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    char *message;
+
+    message = mess(pat,a1,a2,a3,a4);
+    fputs(message,stderr);
+#ifdef LEAKTEST
+#ifdef DEBUGGING
+    if (debug & 4096)
+	xstat();
+#endif
+#endif
+    (void)fflush(stderr);
+}
+#else
+/*VARARGS0*/
+char *
+mess(args)
+va_list args;
+{
+    char *pat;
+    char *s;
+    STR *tmpstr;
+    int usermess;
+#ifndef HAS_VPRINTF
+#ifdef CHARVSPRINTF
+    char *vsprintf();
+#else
+    int vsprintf();
+#endif
+#endif
+
+#ifdef lint
+    pat = Nullch;
+#else
+    pat = va_arg(args, char *);
+#endif
+    s = buf;
+    usermess = strEQ(pat, "%s");
+    if (usermess) {
+	tmpstr = str_mortal(&str_undef);
+	str_set(tmpstr, va_arg(args, char *));
+	*s++ = tmpstr->str_ptr[tmpstr->str_cur-1];
+    }
+    else {
+	(void) vsprintf(s,pat,args);
+	s += strlen(s);
+    }
+
+    if (s[-1] != '\n') {
+	if (curcmd->c_line) {
+	    (void)sprintf(s," at %s line %ld",
+	      stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
+	    s += strlen(s);
+	}
+	if (last_in_stab &&
+	    stab_io(last_in_stab) &&
+	    stab_io(last_in_stab)->lines ) {
+	    (void)sprintf(s,", <%s> line %ld",
+	      last_in_stab == argvstab ? "" : last_in_stab->str_magic->str_ptr,
+	      (long)stab_io(last_in_stab)->lines);
+	    s += strlen(s);
+	}
+	(void)strcpy(s,".\n");
+	if (usermess)
+	    str_cat(tmpstr,buf+1);
+    }
+
+    if (usermess)
+	return tmpstr->str_ptr;
+    else
+	return buf;
+}
+
+/*VARARGS0*/
+void fatal(va_alist)
+va_dcl
+{
+    va_list args;
+    extern FILE *e_fp;
+    extern char *e_tmpname;
+    char *tmps;
+    char *message;
+
+#ifndef lint
+    va_start(args);
+#else
+    args = 0;
+#endif
+    message = mess(args);
+    va_end(args);
+    if (in_eval) {
+	str_set(stab_val(stabent("@",TRUE)),message);
+	tmps = "_EVAL_";
+	while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
+	  strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
+#ifdef DEBUGGING
+	    if (debug & 4) {
+		deb("(Skipping label #%d %s)\n",loop_ptr,
+		    loop_stack[loop_ptr].loop_label);
+	    }
+#endif
+	    loop_ptr--;
+	}
+#ifdef DEBUGGING
+	if (debug & 4) {
+	    deb("(Found label #%d %s)\n",loop_ptr,
+		loop_stack[loop_ptr].loop_label);
+	}
+#endif
+	if (loop_ptr < 0) {
+	    in_eval = 0;
+	    fatal("Bad label: %s", tmps);
+	}
+	longjmp(loop_stack[loop_ptr].loop_env, 1);
+    }
+    fputs(message,stderr);
+    (void)fflush(stderr);
+    if (e_fp)
+	(void)UNLINK(e_tmpname);
+    statusvalue >>= 8;
+    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+}
+
+/*VARARGS0*/
+void warn(va_alist)
+va_dcl
+{
+    va_list args;
+    char *message;
+
+#ifndef lint
+    va_start(args);
+#else
+    args = 0;
+#endif
+    message = mess(args);
+    va_end(args);
+
+    fputs(message,stderr);
+#ifdef LEAKTEST
+#ifdef DEBUGGING
+    if (debug & 4096)
+	xstat();
+#endif
+#endif
+    (void)fflush(stderr);
+}
+#endif
+
+void
+my_setenv(nam,val)
+char *nam, *val;
+{
+    register int i=envix(nam);		/* where does it go? */
+
+    if (environ == origenviron) {	/* need we copy environment? */
+	int j;
+	int 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] = savestr(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 */
+}
+
+int
+envix(nam)
+char *nam;
+{
+    register int 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;
+}
+
+#ifdef EUNICE
+int
+unlnk(f)	/* unlink all versions of a file */
+char *f;
+{
+    int i;
+
+    for (i = 0; unlink(f) >= 0; i++) ;
+    return i ? 0 : -1;
+}
+#endif
+
+#if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
+char *
+my_bcopy(from,to,len)
+register char *from;
+register char *to;
+register int 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 int len;
+{
+    char *retval = loc;
+
+    while (len--)
+	*loc++ = 0;
+    return retval;
+}
+#endif
+
+#ifndef HAS_MEMCMP
+int
+my_memcmp(s1,s2,len)
+register unsigned char *s1;
+register unsigned char *s2;
+register int len;
+{
+    register int tmp;
+
+    while (len--) {
+	if (tmp = *s1++ - *s2++)
+	    return tmp;
+    }
+    return 0;
+}
+#endif /* HAS_MEMCMP */
+
+#ifdef I_VARARGS
+#ifndef HAS_VPRINTF
+
+#ifdef CHARVSPRINTF
+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 CHARVSPRINTF
+    return(dest);
+#else
+    return 0;		/* perl doesn't use return value */
+#endif
+}
+
+#ifdef DEBUGGING
+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
+#endif /* HAS_VPRINTF */
+#endif /* I_VARARGS */
+
+/*
+ * I think my_swap(), htonl() and ntohl() have never been used.
+ * perl.h contains last-chance references to my_swap(), my_htonl()
+ * and my_ntohl().  I presume these are the intended functions;
+ * but htonl() and ntohl() have the wrong names.  There are no
+ * functions my_htonl() and my_ntohl() defined anywhere.
+ * -DWS
+ */
+#ifdef MYSWAP
+#if BYTEORDER != 0x4321
+short
+my_swap(s)
+short s;
+{
+#if (BYTEORDER & 1) == 0
+    short result;
+
+    result = ((s & 255) << 8) + ((s >> 8) & 255);
+    return result;
+#else
+    return s;
+#endif
+}
+
+long
+htonl(l)
+register long l;
+{
+    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)
+    fatal("Unknown BYTEORDER\n");
+#else
+    register int o;
+    register int 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
+ntohl(l)
+register long l;
+{
+    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)
+    fatal("Unknown BYTEORDER\n");
+#else
+    register int o;
+    register int 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 int i;					\
+	    register int 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 int i;					\
+	    register int 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
+
+#ifndef DOSISH
+FILE *
+mypopen(cmd,mode)
+char	*cmd;
+char	*mode;
+{
+    int p[2];
+    register int this, that;
+    register int pid;
+    STR *str;
+    int doexec = strNE(cmd,"-");
+
+    if (pipe(p) < 0)
+	return Nullfp;
+    this = (*mode == 'w');
+    that = !this;
+#ifdef TAINT
+    if (doexec) {
+	taintenv();
+	taintproper("Insecure dependency in exec");
+    }
+#endif
+    while ((pid = (doexec?vfork():fork())) < 0) {
+	if (errno != EAGAIN) {
+	    close(p[this]);
+	    if (!doexec)
+		fatal("Can't fork");
+	    return Nullfp;
+	}
+	sleep(5);
+    }
+    if (pid == 0) {
+#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 */
+	    warn("Can't exec \"%s\": %s", cmd, strerror(errno));
+	    _exit(1);
+	}
+	/*SUPPRESS 560*/
+	if (tmpstab = stabent("$",allstabs))
+	    str_numset(STAB_STR(tmpstab),(double)getpid());
+	forkprocess = 0;
+	hclear(pidstatus, FALSE);	/* 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];
+    }
+    str = afetch(fdpid,p[this],TRUE);
+    str->str_u.str_useful = pid;
+    forkprocess = pid;
+    return fdopen(p[this], mode);
+}
+#else
+#ifdef atarist
+FILE *popen();
+FILE *
+mypopen(cmd,mode)
+char	*cmd;
+char	*mode;
+{
+    return popen(cmd, mode);
+}
+#endif
+
+#endif /* !DOSISH */
+
+#ifdef NOTDEF
+dumpfds(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
+dup2(oldfd,newfd)
+int oldfd;
+int newfd;
+{
+#if defined(HAS_FCNTL) && defined(F_DUPFD)
+    close(newfd);
+    fcntl(oldfd, F_DUPFD, newfd);
+#else
+    int fdtmp[256];
+    int fdx = 0;
+    int fd;
+
+    if (oldfd == newfd)
+	return 0;
+    close(newfd);
+    while ((fd = dup(oldfd)) != newfd)	/* good enough for low fd's */
+	fdtmp[fdx++] = fd;
+    while (fdx > 0)
+	close(fdtmp[--fdx]);
+#endif
+}
+#endif
+
+#ifndef DOSISH
+int
+mypclose(ptr)
+FILE *ptr;
+{
+#ifdef VOIDSIG
+    void (*hstat)(), (*istat)(), (*qstat)();
+#else
+    int (*hstat)(), (*istat)(), (*qstat)();
+#endif
+    int status;
+    STR *str;
+    int pid;
+
+    str = afetch(fdpid,fileno(ptr),TRUE);
+    pid = (int)str->str_u.str_useful;
+    astore(fdpid,fileno(ptr),Nullstr);
+    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);
+    pid = wait4pid(pid, &status, 0);
+    signal(SIGHUP, hstat);
+    signal(SIGINT, istat);
+    signal(SIGQUIT, qstat);
+    return(pid < 0 ? pid : status);
+}
+
+int
+wait4pid(pid,statusp,flags)
+int pid;
+int *statusp;
+int flags;
+{
+#if !defined(HAS_WAIT4) && !defined(HAS_WAITPID)
+    int result;
+    STR *str;
+    char spid[16];
+#endif
+
+    if (!pid)
+	return -1;
+#ifdef HAS_WAIT4
+    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+#else
+#ifdef HAS_WAITPID
+    return waitpid(pid,statusp,flags);
+#else
+    if (pid > 0) {
+	sprintf(spid, "%d", pid);
+	str = hfetch(pidstatus,spid,strlen(spid),FALSE);
+	if (str != &str_undef) {
+	    *statusp = (int)str->str_u.str_useful;
+	    hdelete(pidstatus,spid,strlen(spid));
+	    return pid;
+	}
+    }
+    else {
+	HENT *entry;
+
+	hiterinit(pidstatus);
+	if (entry = hiternext(pidstatus)) {
+	    pid = atoi(hiterkey(entry,statusp));
+	    str = hiterval(pidstatus,entry);
+	    *statusp = (int)str->str_u.str_useful;
+	    sprintf(spid, "%d", pid);
+	    hdelete(pidstatus,spid,strlen(spid));
+	    return pid;
+	}
+    }
+    if (flags)
+	fatal("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;
+{
+#if defined(HAS_WAIT4) || defined(HAS_WAITPID)
+#else
+    register STR *str;
+    char spid[16];
+
+    sprintf(spid, "%d", pid);
+    str = hfetch(pidstatus,spid,strlen(spid),TRUE);
+    str->str_u.str_useful = status;
+#endif
+    return;
+}
+
+#ifdef atarist
+int pclose();
+int
+mypclose(ptr)
+FILE *ptr;
+{
+    return pclose(ptr);
+}
+#endif
+
+void
+repeatcpy(to,from,len,count)
+register char *to;
+register char *from;
+int len;
+register int count;
+{
+    register int 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
+unsigned long
+castulong(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;
+}
+#endif
+
+#ifndef HAS_RENAME
+int
+same_dirent(a,b)
+char *a;
+char *b;
+{
+    char *fa = rindex(a,'/');
+    char *fb = rindex(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
+scanoct(start, len, retlen)
+char *start;
+int len;
+int *retlen;
+{
+    register char *s = start;
+    register unsigned long retval = 0;
+
+    while (len-- && *s >= '0' && *s <= '7') {
+	retval <<= 3;
+	retval |= *s++ - '0';
+    }
+    *retlen = s - start;
+    return retval;
+}
+
+unsigned long
+scanhex(start, len, retlen)
+char *start;
+int len;
+int *retlen;
+{
+    register char *s = start;
+    register unsigned long retval = 0;
+    char *tmp;
+
+    while (len-- && *s && (tmp = index(hexdigit, *s))) {
+	retval <<= 4;
+	retval |= (tmp - hexdigit) & 15;
+	s++;
+    }
+    *retlen = s - start;
+    return retval;
+}
diff --git a/gnu/usr.bin/perl/perl/util.h b/gnu/usr.bin/perl/perl/util.h
new file mode 100644
index 000000000000..ff64f8587806
--- /dev/null
+++ b/gnu/usr.bin/perl/perl/util.h
@@ -0,0 +1,61 @@
+/* $RCSfile: util.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:29:40 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:29:40  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/11  21:19:36  lwall
+ * patch34: pidgone() wasn't declared right
+ * 
+ * Revision 4.0.1.3  92/06/08  16:09:20  lwall
+ * patch20: bcopy() and memcpy() now tested for overlap safety
+ * 
+ * Revision 4.0.1.2  91/11/05  19:18:40  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * 
+ * Revision 4.0.1.1  91/06/07  12:11:00  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:56:48  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+EXT int *screamfirst INIT(Null(int*));
+EXT int *screamnext INIT(Null(int*));
+
+#ifndef safemalloc
+char	*safemalloc();
+char	*saferealloc();
+#endif
+char	*cpytill();
+char	*instr();
+char	*fbminstr();
+char	*screaminstr();
+void	fbmcompile();
+char	*savestr();
+void	my_setenv();
+int	envix();
+void	growstr();
+char	*ninstr();
+char	*rninstr();
+char	*nsavestr();
+FILE	*mypopen();
+int	mypclose();
+#if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
+char	*my_bcopy();
+#endif
+#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
+char	*my_bzero();
+#endif
+#ifndef HAS_MEMCMP
+int	my_memcmp();
+#endif
+unsigned long scanoct();
+unsigned long scanhex();
+void pidgone();
diff --git a/gnu/usr.bin/perl/sperl/Makefile b/gnu/usr.bin/perl/sperl/Makefile
new file mode 100644
index 000000000000..e815d89a46e5
--- /dev/null
+++ b/gnu/usr.bin/perl/sperl/Makefile
@@ -0,0 +1,30 @@
+#
+# 
+
+PROG= suidperl 
+
+SRCS+= array.c cmd.c cons.c consarg.c 
+SRCS+= doarg.c doio.c dolist.c dump.c
+SRCS+= eval.c form.c hash.c malloc.c 
+SRCS+= perl.c perly.c regcomp.c regexec.c
+SRCS+= stab.c str.c toke.c util.c 
+SRCS+= usersub.c
+.PATH: ${.CURDIR}/../perl
+
+
+CFLAGS+= -I${.CURDIR}/../perl -DIAMSUID -DTAINT
+LDADD= -lm 
+DPADD= ${LIBM}
+
+.if exists (/usr/lib/libcrypt.a)
+LDADD+= -lcrypt
+DPADD+= ${LIBCRYPT}
+.else
+SRCS+= crypt.c
+.endif
+
+NOMAN=
+
+
+.include <bsd.prog.mk>
+
diff --git a/gnu/usr.bin/perl/tperl/Makefile b/gnu/usr.bin/perl/tperl/Makefile
new file mode 100644
index 000000000000..bb7063735bfa
--- /dev/null
+++ b/gnu/usr.bin/perl/tperl/Makefile
@@ -0,0 +1,30 @@
+#
+# 
+
+PROG= tperl
+
+SRCS+= array.c cmd.c cons.c consarg.c 
+SRCS+= doarg.c doio.c dolist.c dump.c
+SRCS+= eval.c form.c hash.c malloc.c 
+SRCS+= perl.c perly.c regcomp.c regexec.c
+SRCS+= stab.c str.c toke.c util.c 
+SRCS+= usersub.c
+.PATH: ${.CURDIR}/../perl
+
+
+CFLAGS+= -I${.CURDIR}/../perl -DTAINT
+LDADD+= -lm 
+DPADD= ${LIBM}  
+
+.if exists (/usr/lib/libcrypt.a)
+LDADD+= -lcrypt
+DPADD+= ${LIBCRYPT}
+.else 
+SRCS+= crypt.c
+.endif
+
+NOMAN=
+
+
+.include <bsd.prog.mk>
+
diff --git a/gnu/usr.bin/perl/x2p/EXTERN.h b/gnu/usr.bin/perl/x2p/EXTERN.h
new file mode 100644
index 000000000000..f3048edbc021
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/EXTERN.h
@@ -0,0 +1,26 @@
+/* $RCSfile: EXTERN.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:11 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:11  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:11:15  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:56:53  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#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 000000000000..e1967d2630b0
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/INTERN.h
@@ -0,0 +1,26 @@
+/* $RCSfile: INTERN.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:11 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:11  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:11:20  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:56:58  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#undef EXT
+#define EXT
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT
diff --git a/gnu/usr.bin/perl/x2p/Makefile b/gnu/usr.bin/perl/x2p/Makefile
new file mode 100644
index 000000000000..d7e383d5db53
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/Makefile
@@ -0,0 +1,17 @@
+
+PROG= a2p
+
+SRCS+= a2p.c hash.c str.c walk.c util.c
+CFLAGS+= -I${.CURDIR}/../perl
+
+LDADD= -lm
+DPADD= ${LIBM}
+
+MAN1+= a2p.1 s2p.1 h2ph.1  
+
+beforeinstall:
+	install -c -o ${BINOWN} -g ${BINGRP} -m 555 s2p ${BINDIR}
+	install -c -o ${BINOWN} -g ${BINGRP} -m 555 h2ph ${BINDIR}
+
+.include <bsd.prog.mk>
+
diff --git a/gnu/usr.bin/perl/x2p/a2p.1 b/gnu/usr.bin/perl/x2p/a2p.1
new file mode 100644
index 000000000000..58d8c077fafd
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.1
@@ -0,0 +1,199 @@
+.rn '' }`
+''' $Header: /home/cvs/386BSD/ports/lang/perl/x2p/a2p.man,v 1.1.1.1 1993/08/23 21:30:10 nate Exp $
+''' 
+''' $Log: a2p.man,v $
+.\" Revision 1.1.1.1  1993/08/23  21:30:10  nate
+.\" PERL!
+.\"
+''' Revision 4.0  91/03/20  01:57:11  lwall
+''' 4.0 baseline.
+''' 
+''' Revision 3.0  89/10/18  15:34:22  lwall
+''' 3.0 baseline
+''' 
+''' Revision 2.0.1.1  88/07/11  23:16:25  root
+''' patch2: changes related to 1985 awk
+''' 
+''' Revision 2.0  88/06/05  00:15:36  root
+''' Baseline version 2.0.
+''' 
+''' 
+.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.c b/gnu/usr.bin/perl/x2p/a2p.c
new file mode 100644
index 000000000000..c44163462632
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.c
@@ -0,0 +1,2715 @@
+#ifndef lint
+static char yysccsid[] = "@(#)yaccpar	1.9 (Berkeley) 02/21/93";
+#endif
+#define YYBYACC 1
+#define YYMAJOR 1
+#define YYMINOR 9
+#define yyclearin (yychar=(-1))
+#define yyerrok (yyerrflag=0)
+#define YYRECOVERING (yyerrflag!=0)
+#define YYPREFIX "yy"
+#line 2 "a2p.y"
+/* $RCSfile: a2p.y,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30: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.y,v $
+ * Revision 1.1.1.1  1993/08/23  21:30:09  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  16:13:03  lwall
+ * patch20: in a2p, getline should allow variable to be array element
+ * 
+ * Revision 4.0.1.1  91/06/07  12:12:41  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:21  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "INTERN.h"
+#include "a2p.h"
+
+int root;
+int begins = Nullop;
+int ends = Nullop;
+
+#line 42 "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,   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,    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[] = {                                     92,
+    0,    0,   94,   95,   96,   93,    0,   91,    0,    0,
+   30,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   36,    0,    0,    0,   37,    0,    0,    0,    0,
+    0,   83,    0,   98,    0,   11,    0,   92,    0,    0,
+    0,   17,   18,   19,    0,    0,   98,   98,    0,    0,
+    0,   64,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   23,
+   48,   49,    0,    0,    0,    0,    0,    0,    4,    0,
+   98,   98,   98,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   46,
+   47,    0,    0,   60,    0,    0,    0,    0,    0,   98,
+   98,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   99,  100,    0,   97,   52,   31,
+   27,   20,    0,    0,    0,    0,   29,    0,    0,    0,
+    0,   44,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   61,   62,   90,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   13,   63,   82,    0,
+    0,   98,    0,    0,    0,    0,    0,    0,  119,  118,
+  122,    0,   98,    0,   98,   10,   98,    0,  105,    0,
+  110,    0,    0,   21,    0,   58,   92,    3,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   98,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   98,   98,   98,   98,   98,    8,    0,    0,
+   69,    0,   74,    0,   73,    0,   76,    0,   75,    0,
+   71,   72,    0,   66,    0,   70,  127,  126,  128,    0,
+    0,    0,    0,    0,  111,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   98,    0,    0,    0,   98,   98,   98,    0,    0,    0,
+   98,   68,   67,   78,   77,   80,   79,    0,   65,    0,
+    0,    0,    0,    0,    0,  125,    0,    0,    0,  131,
+  135,    0,    0,    0,    9,   98,   98,    0,  132,    0,
+    0,   98,  130,  134,    0,  133,
+};
+short yydgoto[] = {                                       1,
+    2,    7,   36,   74,  127,   37,   38,   39,  166,   52,
+   75,  188,   42,   43,   44,   45,   46,   54,    8,  128,
+  227,  189,  190,  191,  256,  250,
+};
+short yysindex[] = {                                      0,
+    0,  -45,    0,    0,    0,    0, 4961,    0, -114,  -98,
+    0,  -11,    7, 7279,   10,    6,   17,   25,   45, -195,
+   62,    0,    5,   77,   83,    0, 7332, 7332, 5086, -252,
+ -252,    0, 7332,    0, 5086,    0, -154,    0,    8,  -41,
+ 1605,    0,    0,    0,  118, -234,    0,    0, 6059, 7279,
+ 5487,    0, 5843,   85, 7332, 7332,   75, 6108, 6154, 7332,
+   97, 7279, 7279, 7332, 7332, 5086,  -73, -266,  -73,    0,
+    0,    0,   26, -183,  -39,  102,  106,  116,    0,  -45,
+    0,    0,    0, 5086, 6219, 7332, 7332, 7332,  118, -133,
+ 7332, 7332, 7332, 7332, 7332, 7332, 7332, -116, 5086,    0,
+    0, -183, -183,    0, 6289,  125, 5487,  166,   29,    0,
+    0, 6335, 1522, 7332,  128, 6381,  134, 6423, 6484, 7279,
+  141,   90, 6534, 6580,    0,    0, 5197,    0,    0,    0,
+    0,    0, -183, 5362, 5362, -206,    0, 1522, 1522, 1522,
+ 1522,    0,  -32,  395,  395,  -73,  -73,  -73,  -73, -252,
+ -206, 5242, 5288,    0,    0,    0, 3391, 3391, -108, 1522,
+ 7332, 7332, 7332, 7332, 6626,  145,    0,    0,    0, 7332,
+ 7332,    0, 7279, 7279,  147,  148,  149, 7332,    0,    0,
+    0, 7332,    0, -102,    0,    0,    0, 7332,    0,  -42,
+    0, 5553,  -99,    0, 7332,    0,    0,    0, 7332, 7332,
+   31, 2565, 3715, 3794, 5752,  153, 6688,    0, 6017, 6749,
+ -183,  -38,  -38, 5086, 5086, 2408, 7332, 7332, 4312,  104,
+ -183, -183,    0,    0,    0,    0,    0,    0,  118,  -45,
+    0, 6802,    0, 7332,    0, 7332,    0, 7332,    0, 7332,
+    0,    0,  -86,    0, 7332,    0,    0,    0,    0, 7332,
+ 7332,  -37,  -35, 6856,    0,  137,  -74, 7332, 5598, -183,
+ -183, -183, -183, -183,  156, 6898, 6953, 7014, 7067, 7128,
+    0, 7170, 7332, 7332,    0,    0,    0, 2698,  159, 7218,
+    0,    0,    0,    0,    0,    0,    0, -183,    0, 4312,
+ 4312, 4312, 2408,  -52, 5086,    0, -183, 5643,  -71,    0,
+    0,  160, 2408,  -33,    0,    0,    0,  161,    0, 4312,
+ 4312,    0,    0,    0, 4312,    0,
+};
+short yyrindex[] = {                                      0,
+    0, 2363,    0,    0,    0,    0,  203,    0,    0,    0,
+    0,   56,    0, 3556,    0, 2835,    0,    0,    0,    0,
+    0,    0,    1,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0, 2231,    0, 2279, 1209,
+ 3881,    0,    0,    0, 1818, 1664,    0,    0,    0,  173,
+    0,    0, 3764,  111,    0,    0,  381,    0,    0,    0,
+    0,  173,  129,    0,    0,    0,  564,  834,  889,    0,
+    0,    0,  436, 5689,    0, -200, -180, -156,    0, 2462,
+    0,    0,    0,    0,    0,    0,    0,    0, 2084,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0, 5689, 5689,    0,    0,    0,    0,  -22,    0,    0,
+    0,    0, 2883,    0,    0,    0,    0,    0,    0,  173,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0, 5689,    0,    0, 2181,    0, 3122, 3167, 3212,
+ 3281,    0,    0, 1719, 1770,  943, 1016, 1286, 1340, 2780,
+ 1394,    0,    0,    0,    0,    0,    0,    0,    0, 3489,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   12,   12,    0,    0,    0,  -29,    0,    0,
+    0,   46,    0,    0,    0,    0,    0,   67,    0,    0,
+    0,    0,  491,    0,    0,    0,    0,    0, 3604, 3676,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+ 4374,   71,  103,    0,    0,  162,  126,  241,    0,    0,
+ 5689, 4441,    0,    0,    0,    0,    0,    0, 2132, 2510,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  165,    0,    0,    0,    0,    0, 4486,
+ 4751, 4796, 4841, 4887,    0,    0,    0,    0,    0,    0,
+    0,    0,  296,  357,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0, 5689,    0,    0,
+    0,    0,  184,    0,    0,    0, 5152,    0, 5954,    0,
+    0,    0,  184,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,
+};
+short yygindex[] = {                                      0,
+  -20,    0,    0, 4150,  -75,    0,    0,    0,    0,   19,
+   -7, 4065,  -19,   -3,   -1, 7551, 4353,  -31,    0,    0,
+    0, -170, -161,    0, -270,   16,
+};
+#define YYTABLESIZE 7831
+short yytable[] = {                                      40,
+   81,  129,   84,  275,   96,  276,  303,  309,   47,   94,
+   92,  120,   93,    6,   95,   76,  226,   80,   16,  109,
+   97,   70,  302,  248,   48,  195,  152,  153,   49,  120,
+   91,   77,  308,   78,  100,  101,  271,   81,   98,   23,
+   81,   81,   81,   81,   81,   81,   50,   81,  257,   55,
+   32,   33,   87,   99,  255,   59,   58,  192,   81,   81,
+   81,   97,   81,   81,   59,   56,  100,  101,  106,  156,
+   87,  231,  111,   87,  232,  109,  136,  125,  126,   98,
+  121,  122,   82,   83,   60,  249,  123,   76,   17,   17,
+   61,  151,   59,   81,   81,   63,   59,   59,   59,   59,
+   59,   62,   59,   77,  123,   78,   79,  113,   18,   18,
+   86,  115,   81,   59,   59,   59,   64,   59,   59,  299,
+  300,  301,   65,   81,   81,  113,  193,  194,  111,  115,
+   81,  255,   19,   19,  114,   87,  120,   98,  167,  313,
+  314,  255,  130,  117,  316,  259,  131,   86,   59,   59,
+   86,   86,   86,   86,   96,   86,  132,   86,  142,   94,
+   92,  117,   93,  150,   95,  155,  121,   59,   86,   86,
+   86,  161,   86,   86,  125,  126,  230,  163,   59,   59,
+   91,  168,  169,  201,  121,  208,  214,  215,  216,  220,
+   83,  212,  213,  241,  258,  278,  282,  279,  295,  306,
+  307,  312,    1,   86,   86,   66,  252,  253,   27,  110,
+   28,   97,  298,   87,    3,    4,    5,  223,  224,  225,
+  112,   87,   86,  113,  112,   87,  247,   88,  251,   98,
+  120,  120,  120,   86,   86,    0,   82,   83,    0,    0,
+    0,   90,    0,    0,    0,    0,    0,   82,   83,   82,
+   83,   82,   83,   82,   83,   82,   83,   81,   81,   81,
+   81,   81,   81,   81,   81,   81,   16,   16,   81,   81,
+  294,   87,   87,   87,   81,    0,   87,    0,    0,    0,
+   81,  124,   81,   81,   81,   81,   81,  304,   81,   81,
+   81,   81,   81,   81,   81,   81,   81,   23,   81,  124,
+   81,   81,   81,   81,   81,  123,  123,  123,   32,   33,
+    0,    0,   59,   59,   59,   59,   59,   59,   59,   59,
+   59,    0,    0,   59,   59,    0,  113,  113,  113,   59,
+  115,  115,  115,    0,    0,   59,  114,   59,   59,   59,
+   59,   59,    0,   59,   59,   59,   59,   59,   59,   59,
+   59,   59,    0,   59,  114,   59,   59,   59,   59,   59,
+    0,    0,  117,  117,  117,    0,    0,   86,   86,   86,
+   86,   86,   86,   86,   86,   86,    0,    0,   86,   86,
+   54,    0,    0,    0,   86,  121,  121,  121,    0,    0,
+   86,   90,   86,   86,   86,   86,   86,  116,   86,   86,
+   86,   86,   86,   86,   86,   86,   86,    0,   86,    0,
+   86,   86,   86,   86,   86,  116,    0,   54,    0,    0,
+   54,   54,   54,   54,   54,   54,    0,   54,   12,   13,
+    0,   96,    0,   14,   15,   84,   94,    0,   54,   54,
+    0,   95,   54,   54,    0,   16,    0,   17,   18,   19,
+    0,   21,    0,    0,    0,    0,   22,   23,   24,   25,
+   85,   86,    0,   26,    0,    0,   30,   31,   32,   33,
+    0,    0,   84,   54,   54,   84,   84,   84,   84,   84,
+   84,    0,   84,    0,    0,    0,    0,    0,   97,    0,
+   22,    0,   54,   84,   84,   84,    0,   84,   84,    0,
+  124,  124,  124,   54,   54,    0,   98,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   22,   84,   84,
+   22,   22,   22,   22,   22,   22,    0,   22,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   22,   22,
+   22,    0,   22,   22,    0,  114,  114,  114,   84,   84,
+    0,    0,    0,   51,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   22,   22,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   51,    0,   22,   51,   51,   51,   51,   51,   51,    0,
+   51,    0,    0,   22,   22,    0,  116,  116,  116,    0,
+    0,   51,   51,   51,    0,   51,   51,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   54,   54,   54,
+   54,   54,   54,   54,   54,   54,    0,    0,   54,   54,
+    0,    0,    0,    0,   54,    0,   51,    0,    0,    0,
+   54,    0,   54,   54,   54,   54,   54,    0,   54,   54,
+   54,   54,   54,   54,   54,   54,   54,    0,   54,    0,
+   54,   54,   54,   54,   54,    0,   51,   51,    0,    0,
+    0,    0,   84,   84,   84,   84,   84,   84,   84,   84,
+   84,    0,    0,   84,   84,    0,    0,    0,    0,   84,
+    0,    0,    0,    0,    0,   84,    0,   84,   84,   84,
+   84,   84,    0,   84,   84,   84,   84,   84,   84,   84,
+   84,   84,    0,   84,    0,   84,   84,   84,   84,   84,
+    0,    0,    0,    0,    0,    0,    0,   22,   22,   22,
+   22,   22,   22,   22,   22,   22,    0,    0,   22,   22,
+    0,    0,    0,    0,   22,    0,    0,    0,    0,    0,
+   22,    0,   22,   22,   22,   22,   22,    0,   22,   22,
+    0,   22,   22,   22,   22,   22,   22,    0,   22,    0,
+   22,   22,   22,   22,   22,    0,    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,   51,   51,   51,   51,   51,   51,   51,   51,    0,
+    0,   51,   51,   35,    0,    0,    0,   51,    0,    0,
+    0,    0,    0,   51,    0,   51,   51,   51,   51,   51,
+    0,   51,   51,   51,   51,   51,   51,   51,   51,   51,
+    0,   51,    0,   51,   51,   51,   51,   51,    0,    0,
+   35,    0,    0,   35,   35,   35,   35,   35,   35,    0,
+   35,    0,    0,    0,    0,    0,    0,    0,   50,    0,
+    0,   35,   35,   35,    0,   35,   35,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   50,   35,   35,   50,   50,
+   50,   50,   50,   50,    0,   50,    0,    0,    0,    0,
+    0,    0,   40,    0,    0,   35,   50,   50,   50,    0,
+   50,   50,    0,    0,    0,    0,   35,   35,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   40,
+    0,   50,   40,   40,   40,   40,   40,   40,    0,   40,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   40,   40,   40,    0,   40,   40,    0,    0,    0,    0,
+    0,   50,   50,    0,    0,   41,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   40,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   41,    0,    0,   41,   41,   41,   41,   41,
+   41,    0,   41,    0,    0,   40,   40,    0,    0,    0,
+    0,    0,    0,   41,   41,   41,    0,   41,   41,    0,
+    0,    0,    0,    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,   41,    0,
+    0,    0,    0,   35,    0,   35,   35,   35,   35,   35,
+    0,   35,   35,   35,   35,   35,   35,   35,   35,   35,
+    0,   35,    0,   35,    0,    0,   35,   35,   41,   41,
+    0,    0,    0,    0,    0,   50,   50,   50,   50,   50,
+   50,   50,   50,   50,    0,    0,   50,   50,    0,    0,
+    0,    0,   50,    0,    0,    0,    0,    0,   50,    0,
+   50,   50,   50,   50,   50,    0,   50,   50,   50,   50,
+   50,   50,   50,   50,   50,    0,   50,    0,   50,   50,
+   50,   50,   50,    0,    0,    0,    0,    0,    0,   40,
+   40,   40,   40,   40,   40,   40,   40,   40,   14,    0,
+   40,   40,    0,    0,    0,    0,   40,    0,    0,    0,
+    0,    0,   40,    0,   40,   40,   40,   40,   40,    0,
+   40,   40,   40,   40,   40,   40,   40,   40,   40,    0,
+   40,    0,   40,   40,   40,   40,   40,    0,   14,    0,
+    0,   14,    0,   14,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   14,    0,    0,
+    0,    0,   41,   41,   41,   41,   41,   41,   41,   41,
+   41,    0,    0,   41,   41,   42,    0,    0,    0,   41,
+    0,    0,    0,    0,    0,   41,    0,   41,   41,   41,
+   41,   41,    0,   41,   41,   41,   41,   41,   41,   41,
+   41,   41,    0,   41,    0,   41,   41,   41,   41,   41,
+    0,    0,   42,    0,    0,   42,   42,   42,   42,   42,
+   42,   14,   42,    0,    0,    0,    0,    0,    0,   43,
+    0,    0,    0,   42,   42,   42,    0,   42,   42,    0,
+    0,    0,    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,    0,   42,   43,
+   43,   43,   43,   43,   43,    0,   43,    0,    0,    0,
+    0,    0,    0,   34,    0,    0,    0,   43,   43,   43,
+    0,   43,   43,    0,    0,    0,    0,    0,   42,   42,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   34,    0,   43,   34,   34,   34,   34,   34,   34,    0,
+   34,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   34,   34,   34,    0,   34,   34,    0,    0,    0,
+    0,    0,   43,   43,    0,   14,   14,   14,   14,   14,
+   14,   14,   14,    0,    0,    0,   14,   14,    0,    0,
+    0,    0,    0,    0,    0,    0,   34,   34,   14,    0,
+   14,   14,   14,   14,   14,    0,    0,    0,    0,   14,
+   14,   14,   14,    0,    0,   34,   14,    0,   14,   14,
+   14,   14,   14,    0,    0,    0,   34,   34,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   42,   42,   42,   42,   42,   42,   42,   42,
+   42,    0,    0,   42,   42,    0,    0,    0,    0,   42,
+    0,   66,    0,    0,   27,   42,   28,   42,   42,   42,
+   42,   42,    0,   42,   42,   42,   42,   42,   42,   42,
+   42,   42,    0,   42,    0,   42,   42,   42,   42,   42,
+    0,    0,    0,    0,    0,    0,   43,   43,   43,   43,
+   43,   43,   43,   43,   43,    0,    0,   43,   43,    0,
+    0,    0,    0,   43,    0,    0,    0,    0,    0,   43,
+    0,   43,   43,   43,   43,   43,    0,   43,   43,   43,
+   43,   43,   43,   43,   43,   43,    0,   43,    0,   43,
+   43,   43,   43,   43,   66,    0,    0,   27,    0,   28,
+   34,   34,   34,   34,   34,   34,   34,   34,   34,    0,
+    0,   34,   34,   35,   87,    0,   88,   34,    0,    0,
+    0,    0,    0,   34,    0,   34,   34,   34,   34,   34,
+    0,   34,    0,    0,   34,   34,   34,   34,   34,   34,
+    0,   34,    0,   34,   34,   34,   34,   34,    0,    0,
+   35,    0,    0,   35,   35,   35,   35,   35,   35,    0,
+   35,    0,    0,    0,    0,    0,    0,    0,   38,    0,
+    0,   35,   35,   35,    0,   35,   35,    0,    0,    0,
+    0,    0,    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,   35,   38,   38,
+    0,   38,   38,   38,    0,    0,    0,    0,    0,   39,
+    0,    0,    0,    0,    0,   35,   38,   38,   38,    0,
+   38,   38,    0,    0,   12,   13,   35,   35,    0,   14,
+   15,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   16,    0,   17,   18,   19,    0,   21,    0,   39,
+   39,   38,   39,   39,   39,    0,    0,   32,    0,   26,
+    0,    0,   30,   31,   32,   33,    0,   39,   39,   39,
+    0,   39,   39,    0,    0,    0,    0,    0,    0,    0,
+    0,   38,   38,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   32,   32,    0,
+    0,   32,   39,    0,    0,    0,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,   32,   32,   32,    0,   32,
+    0,    0,    0,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,   39,   39,    0,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,    0,   30,   31,   32,   33,    0,
+   32,    0,    0,    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,
+   32,   32,    0,   35,    0,   35,   35,   35,   35,   35,
+    0,    0,   35,   35,   35,   35,   35,   35,   35,   35,
+    0,   35,    0,   35,    0,    0,   35,   35,    0,    0,
+    0,    0,    0,    0,    0,   38,   38,   38,   38,   38,
+   38,   38,   38,   38,    0,    0,   38,   38,    0,    0,
+    0,    0,   38,    0,    0,    0,    0,    0,   38,    0,
+   38,   38,   38,   38,   38,    0,   38,   38,   38,   38,
+   38,   38,   38,   38,   38,    0,   38,    0,   38,   38,
+   38,   38,   38,    0,    0,    0,   39,   39,   39,   39,
+   39,   39,   39,   39,   39,    0,    0,   39,   39,    0,
+    0,    0,    0,   39,    0,    0,    0,    0,    0,   39,
+    0,   39,   39,   39,   39,   39,    0,   39,   39,   39,
+   39,   39,   39,   39,   39,   39,    0,   39,    0,   39,
+   39,   39,   39,   39,   32,   32,   32,   32,   32,   32,
+   32,   32,   32,   33,    0,   32,   32,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   32,    0,   32,
+   32,   32,   32,   32,    0,   32,   32,   32,   32,   32,
+   32,   32,   32,   32,    0,   32,    0,   32,   32,   32,
+   32,   32,    0,   33,   33,    0,    0,   33,    0,    0,
+    0,   45,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   33,   33,   33,    0,   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,   45,   45,    0,    0,   45,   33,    0,    0,    0,
+   15,    0,    0,    0,    0,    0,    0,    0,    0,   45,
+   45,   45,    0,   45,    0,    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,
+   15,    0,    0,   15,   45,   15,    0,    0,    0,    0,
+   12,    0,    0,    0,    0,    0,    0,    0,    0,   15,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   45,   45,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   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,   15,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    7,    0,
+    0,    7,    0,    7,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    7,    0,    0,
+   33,   33,   33,   33,   33,   33,   33,   33,   33,    0,
+    0,   33,   33,   12,    0,    0,    0,    0,    0,    0,
+    0,    0,    6,   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,   45,   45,
+   45,   45,   45,   45,   45,   45,   45,    0,    0,   45,
+   45,    0,    6,    0,    0,    6,    0,    6,    0,    0,
+    0,   45,    0,   45,   45,   45,   45,   45,    0,   45,
+   45,   45,   45,   45,   45,   45,   45,   45,    0,   45,
+    0,   45,   45,   45,   45,   45,    0,   15,   15,   15,
+   15,   15,   15,   15,   15,    0,    0,   66,   15,   15,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+   15,    5,   15,   15,   15,   15,   15,    0,    0,    0,
+    0,   15,   15,   15,   15,    0,    0,    0,   15,    0,
+   15,   15,   15,   15,   15,    6,    0,   12,   12,   12,
+   12,    0,   12,   12,   12,    0,    0,    0,   12,   12,
+    0,    5,    0,    0,    5,    0,    5,    0,    0,    2,
+   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,    2,
+    0,    0,    2,    0,    2,    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,    5,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   66,  233,    0,   27,  234,   28,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    6,
+    6,    6,    0,    0,    0,    6,    6,    0,    0,    0,
+    6,    6,    2,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    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,    0,    0,    0,
+   12,   13,    0,  173,  174,   14,   15,    0,    0,    0,
+    0,    0,  178,  179,  180,  181,  182,   16,    0,   17,
+   18,   19,    0,   21,  184,    0,    0,    0,   22,   23,
+   24,   25,    0,    0,    0,   26,    0,    0,   30,   31,
+   32,   33,    0,    0,    0,    0,    0,    0,    5,    5,
+    5,    0,    0,    0,    5,    5,    0,    0,    0,    5,
+    5,    0,    0,    0,    0,    0,    0,   35,    0,    0,
+   27,    5,   28,    5,    5,    5,    5,    5,    0,    0,
+    0,    0,    5,    5,    5,    5,  293,    0,    0,    5,
+    0,    5,    5,    5,    5,    5,    2,    2,    2,    0,
+    0,    0,    2,    2,    0,    0,    0,    2,    2,   57,
+    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,   57,    0,    0,   57,
+   57,   57,   57,   57,   57,    0,   57,   12,   13,    0,
+    0,    0,   14,   15,   53,    0,    0,   57,   57,   57,
+    0,   57,   57,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,    0,    0,    0,   22,   23,   24,   25,    0,
+    0,    0,   26,    0,    0,   30,   31,   32,   33,    0,
+    0,   53,   57,   57,   53,   53,   53,   53,   53,   53,
+    0,   53,   55,    0,    0,    0,    0,    0,    0,    0,
+    0,   57,   53,   53,    0,    0,   53,   53,    0,    0,
+    0,    0,   57,   57,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   55,
+    0,    0,    0,   55,   55,    0,   55,   53,   53,   55,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   55,   55,   55,    0,   55,   55,   53,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   11,   53,   53,    0,
+   12,   13,    0,    0,    0,   14,   15,    0,    0,    0,
+    0,    0,    0,    0,    0,   55,   55,   16,    0,   17,
+   18,   19,    0,   21,    0,    0,    0,    0,   22,   23,
+   24,   25,    0,    0,   55,   26,    0,   29,   30,   31,
+   32,   33,    0,    0,    0,   55,   55,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   57,   57,   57,   57,
+   57,   57,   57,   57,   57,    0,    0,   57,   57,    0,
+    0,    0,    0,   57,    0,    0,    0,    0,    0,   57,
+    0,   57,   57,   57,   57,   57,    0,   57,   57,   57,
+   57,    0,   57,   57,   57,   57,    0,   57,    0,   57,
+   57,   57,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   53,   53,   53,   53,   53,   53,   53,   53,   53,
+    0,    0,   53,   53,    0,    0,    0,    0,   53,    0,
+    0,    0,    0,    0,   53,    0,   53,   53,   53,   53,
+   53,   28,   53,   53,   53,   53,    0,   53,   53,   53,
+   53,    0,   53,    0,   53,   53,   53,    0,    0,   55,
+   55,   55,   55,   55,   55,    0,    0,   55,    0,    0,
+    0,    0,    0,    0,    0,    0,   55,    0,   28,    0,
+    0,    0,   28,   28,    0,   28,   24,   55,   28,    0,
+   55,   55,   55,   55,   55,   55,   55,   55,   55,   28,
+   28,   28,   55,   28,   28,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   24,    0,    0,    0,   24,   24,    0,
+   24,   26,    0,   24,   28,   28,    0,    0,    0,    0,
+    0,    0,    0,    0,   24,   24,   24,    0,   24,   24,
+    0,    0,    0,   28,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   28,   28,    0,    0,   26,    0,
+    0,    0,   26,   26,    0,   26,    0,    0,   26,   24,
+   24,    0,    0,    0,    0,    0,    0,    0,    0,   26,
+   26,   26,    0,   26,   26,    0,    0,    0,   24,    0,
+   25,    0,    0,    0,    0,    0,    0,    0,    0,   24,
+   24,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   26,   26,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   25,    0,    0,
+    0,   25,   25,   26,   25,    0,    0,   25,    0,    0,
+    0,    0,    0,    0,   26,   26,    0,    0,   25,   25,
+   25,    0,   25,   25,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   25,   25,    0,    0,    0,   28,   28,
+   28,   28,   28,   28,    0,    0,   28,    0,    0,    0,
+    0,    0,   25,    0,    0,   28,    0,    0,    0,    0,
+    0,    0,    0,   25,   25,    0,   28,    0,    0,   28,
+   28,   28,   28,   28,   28,   28,   28,   28,    0,    0,
+    0,   28,    0,   24,   24,   24,   24,   24,   24,    0,
+   66,   24,    0,   27,    0,   28,    0,    0,    0,    0,
+   24,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   24,    0,    0,   24,   24,   24,   24,   24,   24,
+   24,   24,   24,    0,    0,    0,   24,    0,   26,   26,
+   26,   26,   26,   26,    0,    0,   26,    0,    0,    0,
+    0,    0,    0,    0,    0,   26,    0,    0,   56,    0,
+    0,    0,    0,    0,    0,    0,   26,    0,    0,   26,
+   26,   26,   26,   26,   26,   26,   26,   26,    0,    0,
+    0,   26,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   56,    0,    0,    0,   56,
+   56,    0,   56,    0,    0,   56,    0,   25,   25,   25,
+   25,   25,   25,    0,    0,   25,   56,   56,   56,    0,
+   56,   56,    0,    0,   25,   87,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   25,    0,    0,   25,   25,
+   25,   25,   25,   25,   25,   25,   25,    0,    0,    0,
+   25,   56,   56,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   87,    0,    0,    0,   87,   87,    0,   87,
+   56,    0,   87,   88,    0,    0,    0,    0,    0,    0,
+    0,   56,   56,   87,   87,   87,    0,   87,   87,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   88,    0,    0,    0,   88,   88,    0,   88,   87,   87,
+   88,  125,  126,   12,   13,    0,    0,    0,   14,   15,
+    0,   88,   88,   88,    0,   88,   88,   87,    0,    0,
+   16,    0,   17,   18,   19,   89,   21,    0,   87,   87,
+    0,   22,   23,   24,   25,    0,    0,    0,   26,    0,
+    0,   30,   31,   32,   33,    0,   88,   88,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   89,    0,    0,   88,   89,   89,    0,   89,
+    0,    0,   89,    0,    0,    0,   88,   88,    0,    0,
+    0,    0,    0,   89,   89,   89,    0,   89,   89,    0,
+    0,    0,    0,    0,    0,   56,   56,   56,   56,   56,
+   56,    0,    0,   56,   66,  235,    0,   27,  236,   28,
+    0,    0,   56,   85,    0,    0,    0,    0,   89,   89,
+    0,    0,    0,   56,    0,    0,   56,   56,   56,   56,
+   56,   56,   56,   56,   56,    0,    0,   89,   56,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   89,   89,
+   85,    0,    0,    0,   85,   85,    0,    0,    0,    0,
+   85,    0,   87,   87,   87,   87,   87,   87,    0,    0,
+   87,   85,   85,   85,    0,   85,   85,    0,    0,   87,
+    0,    0,    0,   66,  237,    0,   27,  238,   28,    0,
+   87,    0,    0,   87,   87,   87,    0,    0,    0,    0,
+   87,   87,    0,    0,    0,   87,   85,   85,    0,    0,
+   88,   88,   88,   88,   88,   88,    0,    0,   88,    0,
+    0,    0,    0,    0,    0,   85,    0,   88,    0,    0,
+   16,    0,    0,    0,    0,    0,   85,   85,   88,    0,
+    0,   88,   88,   88,    0,    0,    0,    0,   88,   88,
+    0,    0,    0,   88,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   16,    0,    0,
+    0,   16,   16,    0,   16,    0,    0,   16,    0,    0,
+    0,    0,   89,   89,   89,   89,   89,   89,   16,   16,
+   89,    0,    0,   16,    0,    0,    0,    0,    0,   89,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   89,    0,    0,   89,   89,   89,    0,    0,    0,    0,
+   89,   89,    0,   16,   16,   89,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,    0,    0,    0,    0,    0,
+    0,    0,   16,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,    0,   16,   16,   22,   23,   24,   25,    0,
+    0,    0,   26,    0,    0,   30,   31,   32,   33,    0,
+   85,   85,   85,   85,   85,   85,    0,    0,   85,    0,
+    0,    0,    0,    0,    0,    0,    0,   85,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   85,    0,
+    0,   85,   85,   85,    0,    0,   12,   13,   85,   85,
+    0,   14,   15,   85,    0,    0,    0,    0,    0,    0,
+    0,   41,    0,   16,    0,   17,   18,   19,   53,   21,
+    0,    0,    0,    0,   22,   23,   24,   25,    0,    0,
+    0,   26,    0,   41,   30,   31,   32,   33,    0,   41,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  105,   53,  108,    0,    0,    0,  112,
+  113,    0,  116,  118,  119,    0,   53,   53,  123,  124,
+   41,    0,    0,    0,    0,    0,    0,   16,   16,   16,
+   16,   16,   16,    0,    0,   16,    0,    0,   41,  138,
+  139,  140,  141,    0,   16,    0,    0,    0,    0,    0,
+    0,    0,    0,   41,    0,   16,    0,    0,   16,   16,
+   16,  108,    0,    0,    0,    0,    0,    0,  160,    0,
+   16,    0,    0,    0,   53,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  102,  103,   41,   41,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  199,  200,    0,    0,  202,  203,  204,  205,  207,
+  133,  134,  135,    0,  209,  210,    0,   53,   53,    0,
+    0,    0,  217,    0,    0,    0,  218,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  157,
+  158,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   41,   41,
+  254,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  266,    0,  267,    0,
+  268,    0,  269,    0,  270,    0,    0,    0,    0,  272,
+    0,    0,    0,    0,  273,  274,    0,    0,    0,    0,
+    0,  211,  280,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  219,    0,  221,    0,  222,    0,    0,    0,
+    0,    0,   41,    0,    0,    0,    0,    0,    0,    0,
+    0,   66,    0,    0,   27,    0,   28,  243,    0,   41,
+    0,    0,    0,    0,    0,    0,    0,    0,   57,    0,
+  187,    0,  260,  261,  262,  263,  264,    0,    0,   68,
+   68,    0,   71,   72,    0,   68,    0,    0,    0,    0,
+    0,    0,    0,   68,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   68,    0,    0,    0,    0,
+    0,    0,    0,  109,    0,    0,  109,    0,  109,    0,
+  288,    0,    0,    0,  290,  291,  292,    0,    0,    0,
+  297,    0,  109,    0,  185,    0,    0,    0,    0,    0,
+    0,    0,    0,   68,   68,   68,   68,   68,   68,   68,
+    0,    0,    0,    0,    0,  310,  311,   68,    0,    0,
+   68,  315,    0,    0,   68,   68,    0,    0,   68,    0,
+   68,   68,    0,    0,    0,   68,   68,    0,    0,    0,
+  108,    0,    0,  108,    0,  108,    0,    0,    0,    0,
+   68,   68,   68,   68,    0,    0,  109,    0,  109,  108,
+    0,    0,  196,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   68,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  102,    0,    0,  102,    0,
+  102,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   68,    0,    0,    0,  102,    0,    0,   68,    0,    0,
+    0,   68,   68,    0,   68,   68,   68,   68,    0,   68,
+    0,   68,   68,  108,    0,  108,    0,    0,    0,   68,
+   68,  172,  125,  126,   12,   13,    0,  173,  174,   14,
+   15,  175,    0,  176,  177,    0,  178,  179,  180,  181,
+  182,   16,  183,   17,   18,   19,    0,   21,  184,    0,
+    0,    0,   22,   23,   24,   25,   68,    0,  102,   26,
+  102,    0,   30,   31,   32,   33,    0,    0,   68,   68,
+   68,   68,   68,    0,   68,   68,   68,    0,    0,    0,
+    0,    0,   68,  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,    0,    0,    0,  109,  109,  109,  109,    0,    0,
+    0,  109,    0,    0,  109,  109,  109,  109,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  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,    0,    0,    0,  108,    0,
+    0,  108,  108,  108,  108,  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,    0,  102,  102,  102,  102,
+  103,    0,    0,  103,    0,  103,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  103,
+    0,    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,    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,  103,    0,  103,    0,    0,    0,    0,
+  101,    0,    0,  101,    0,  101,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  101,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  104,    0,
+  104,    0,    0,    0,    0,    0,  107,    0,    0,  107,
+    0,  107,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  107,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  101,    0,  101,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    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,    0,  107,
+  103,  107,    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,
+    0,  103,  103,  103,  103,  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,   34,    0,    0,  104,  104,  104,  104,
+    0,    0,    0,  104,    0,    0,  104,  104,  104,  104,
+  101,    0,    0,  101,  101,    0,  101,  101,  101,  101,
+  101,  101,  101,  101,    0,  101,  101,  101,  101,  101,
+  101,  101,  101,  101,  101,   35,  101,  101,   27,    0,
+   28,  101,  101,  101,  101,    0,    0,    0,  101,    0,
+    0,  101,  101,  101,  101,    0,  107,    0,    0,  107,
+  107,    0,  107,  107,  107,  107,  107,  107,  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,    0,  107,  107,  107,
+  107,  136,    0,    0,  136,    0,  136,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  136,    0,    0,    0,    0,    0,    0,    9,   10,   11,
+    0,    0,    0,   12,   13,    0,    0,    0,   14,   15,
+    0,    0,    0,    0,    0,    0,   66,    0,    0,   27,
+   16,   28,   17,   18,   19,   20,   21,    0,    0,    0,
+    0,   22,   23,   24,   25,  187,    0,    0,   26,    0,
+   29,   30,   31,   32,   33,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  136,    0,  136,    0,    0,    0,
+    0,   66,    0,    0,   27,    0,   28,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  187,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  185,
+    0,  186,    0,    0,    0,    0,    0,   66,    0,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   11,    0,  187,    0,   12,   13,
+    0,    0,    0,   14,   15,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  185,   16,  197,   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,   35,    0,    0,   27,    0,   28,    0,    0,    0,
+  185,  136,  198,    0,  136,  136,    0,  136,  136,  136,
+  136,  136,  136,  136,  136,    0,  136,  136,  136,  136,
+  136,  136,  136,  136,  136,  136,    0,  136,  136,    0,
+    0,    0,  136,  136,  136,  136,    0,    0,    0,  136,
+    0,    0,  136,  136,  136,  136,  172,    0,    0,   12,
+   13,    0,  173,  174,   14,   15,  175,    0,  176,  177,
+    0,  178,  179,  180,  181,  182,   16,  183,   17,   18,
+   19,    0,   21,  184,    0,    0,    0,   22,   23,   24,
+   25,    0,    0,    0,   26,    0,    0,   30,   31,   32,
+   33,  172,    0,    0,   12,   13,    0,  173,  174,   14,
+   15,  175,    0,  176,  177,    0,  178,  179,  180,  181,
+  182,   16,  183,   17,   18,   19,  107,   21,  184,   27,
+    0,   28,   22,   23,   24,   25,    0,    0,    0,   26,
+    0,    0,   30,   31,   32,   33,    0,  172,    0,    0,
+   12,   13,    0,  173,  174,   14,   15,  175,    0,  176,
+  177,    0,  178,  179,  180,  181,  182,   16,  183,   17,
+   18,   19,    0,   21,  184,    0,    0,    0,   22,   23,
+   24,   25,    0,    0,    0,   26,    0,    0,   30,   31,
+   32,   33,   66,    0,    0,   27,    0,   28,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  187,    0,    0,    0,    0,    0,    0,    0,    0,
+   11,    0,  125,  126,   12,   13,    0,    0,    0,   14,
+   15,    0,    0,    0,    0,    0,    0,   66,    0,    0,
+   27,   16,   28,   17,   18,   19,    0,   21,    0,    0,
+    0,    0,   22,   23,   24,   25,  187,    0,    0,   26,
+    0,   29,   30,   31,   32,   33,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  185,    0,  228,    0,    0,
+    0,    0,   66,    0,    0,   27,    0,   28,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  187,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  185,    0,  281,    0,    0,    0,    0,    0,  106,    0,
+    0,  106,    0,  106,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   11,    0,  106,    0,   12,
+   13,    0,    0,    0,   14,   15,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  185,   16,  305,   17,   18,
+   19,    0,   21,    0,    0,    0,    0,   22,   23,   24,
+   25,    0,    0,    0,   26,    0,   29,   30,   31,   32,
+   33,   66,  239,    0,   27,  240,   28,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  106,  172,  106,    0,   12,   13,    0,  173,  174,
+   14,   15,  175,    0,  176,  177,    0,  178,  179,  180,
+  181,  182,   16,  183,   17,   18,   19,    0,   21,  184,
+    0,    0,    0,   22,   23,   24,   25,    0,    0,    0,
+   26,    0,    0,   30,   31,   32,   33,  172,    0,    0,
+   12,   13,    0,  173,  174,   14,   15,  175,    0,  176,
+  177,    0,  178,  179,  180,  181,  182,   16,  183,   17,
+   18,   19,   66,   21,  184,   27,  110,   28,   22,   23,
+   24,   25,    0,    0,    0,   26,    0,    0,   30,   31,
+   32,   33,  172,    0,    0,   12,   13,    0,  173,  174,
+   14,   15,  175,    0,  176,  177,    0,  178,  179,  180,
+  181,  182,   16,  183,   17,   18,   19,    0,   21,  184,
+    0,    0,    0,   22,   23,   24,   25,    0,    0,    0,
+   26,    0,    0,   30,   31,   32,   33,    0,  106,    0,
+    0,  106,  106,    0,  106,  106,  106,  106,  106,    0,
+  106,  106,    0,  106,  106,  106,  106,  106,  106,  106,
+  106,  106,  106,    0,  106,  106,    0,    0,    0,  106,
+  106,  106,  106,    0,    0,    0,  106,    0,    0,  106,
+  106,  106,  106,  129,    0,    0,  129,    0,  129,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  129,    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,    0,   30,   31,   32,   33,   66,  244,    0,   27,
+  245,   28,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  129,    0,  129,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   66,  104,
+    0,   27,    0,   28,    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,    0,   30,   31,   32,   33,   66,    0,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   66,    0,    0,   27,    0,   28,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  129,    0,    0,  129,  129,    0,  129,
+  129,  129,  129,  129,    0,  129,  129,    0,  129,  129,
+  129,  129,  129,  129,  129,  129,  129,  129,    0,  129,
+  129,    0,    0,    0,  129,  129,  129,  129,    0,    0,
+    0,  129,    0,    0,  129,  129,  129,  129,   66,    0,
+    0,   27,    0,   28,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    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,    0,   30,   31,   32,
+   33,   12,   13,    0,    0,    0,   14,   15,   66,  154,
+    0,   27,    0,   28,    0,    0,    0,    0,   16,    0,
+   17,   18,   19,    0,   21,    0,    0,    0,    0,   22,
+   23,   24,   25,    0,    0,    0,   26,    0,    0,   30,
+   31,   32,   33,    0,    0,    0,  115,    0,    0,    0,
+   12,   13,    0,    0,   66,   14,   15,   27,  159,   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,    0,   30,   31,
+   32,   33,  117,    0,    0,    0,   12,   13,    0,    0,
+   66,   14,   15,   27,  162,   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,    0,   30,   31,   32,   33,    0,    0,
+    0,    0,   66,    0,    0,   27,  164,   28,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  137,    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,    0,   30,
+   31,   32,   33,   66,    0,    0,   27,  165,   28,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    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,   66,   21,    0,   27,  170,   28,   22,
+   23,   24,   25,    0,    0,    0,   26,    0,    0,   30,
+   31,   32,   33,    0,    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,   66,
+   21,    0,   27,  171,   28,   22,   23,   24,   25,    0,
+    0,    0,   26,    0,    0,   30,   31,   32,   33,    0,
+    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,   66,   21,    0,   27,    0,
+   28,   22,   23,   24,   25,    0,    0,    0,   26,    0,
+    0,   30,   31,   32,   33,   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,    0,   30,   31,   32,   33,   66,  242,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    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,    0,   30,   31,   32,   33,   66,  246,
+    0,   27,    0,   28,    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,    0,   30,   31,   32,   33,    0,    0,
+    0,   66,   12,   13,   27,    0,   28,   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,    0,
+   30,   31,   32,   33,  206,    0,    0,    0,   12,   13,
+    0,    0,    0,   14,   15,   66,  277,    0,   27,    0,
+   28,    0,    0,    0,    0,   16,    0,   17,   18,   19,
+    0,   21,    0,    0,    0,    0,   22,   23,   24,   25,
+    0,    0,    0,   26,    0,    0,   30,   31,   32,   33,
+    0,    0,    0,    0,    0,    0,    0,   66,  283,    0,
+   27,    0,   28,    0,    0,    0,    0,    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,    0,   30,   31,
+   32,   33,   66,  284,    0,   27,    0,   28,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    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,    0,   30,
+   31,   32,   33,   66,  285,    0,   27,    0,   28,    0,
+  265,    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,    0,   30,   31,   32,   33,   66,  286,    0,   27,
+    0,   28,    0,    0,    0,    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,    0,   30,   31,   32,   33,
+   12,   13,    0,    0,    0,   14,   15,   66,  287,    0,
+   27,    0,   28,    0,    0,    0,    0,   16,    0,   17,
+   18,   19,    0,   21,    0,    0,    0,    0,   22,   23,
+   24,   25,    0,    0,    0,   26,    0,    0,   30,   31,
+   32,   33,    0,    0,    0,    0,    0,    0,    0,   66,
+  289,    0,   27,    0,   28,   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,    0,   30,   31,   32,   33,   66,    0,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    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,
+  296,   26,    0,    0,   30,   31,   32,   33,   51,    0,
+    0,   27,    0,   28,    0,    0,    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,    0,   30,   31,   32,
+   33,   66,    0,    0,   27,    0,   28,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    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,    0,   30,   31,
+   32,   33,   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,    0,
+   30,   31,   32,   33,    0,    0,    0,    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,    0,   30,   31,
+   32,   33,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    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,   67,   69,   30,
+   31,   32,   33,   73,    0,    0,    0,    0,    0,    0,
+    0,   89,    0,    0,   12,   13,    0,    0,    0,   14,
+   15,    0,    0,   89,    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,    0,   30,   31,   32,   33,    0,    0,    0,    0,
+    0,  143,  144,  145,  146,  147,  148,  149,    0,    0,
+    0,    0,    0,    0,    0,   89,    0,    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,    0,    0,    0,    0,   89,   89,
+   89,   89,    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,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   89,    0,
+    0,    0,    0,    0,    0,  229,    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,    0,
+    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,    0,    0,    0,    0,    0,
+   89,
+};
+short yycheck[] = {                                       7,
+    0,   41,   44,   41,   37,   41,   59,   41,  123,   42,
+   43,   41,   45,   59,   47,   35,   59,   38,   41,   51,
+   94,   29,  293,   62,  123,   58,  102,  103,   40,   59,
+   63,   35,  303,   35,  301,  302,  123,   37,  112,  292,
+   40,   41,   42,   43,   44,   45,   40,   47,  219,   40,
+  303,  304,   41,  288,  216,    0,   40,  133,   58,   59,
+   60,   94,   62,   63,   40,   60,  301,  302,   50,   41,
+   59,   41,   44,   62,   44,  107,   84,  261,  262,  112,
+   62,   63,  289,  290,   40,  124,   41,  107,  289,  290,
+  286,   99,   37,   93,   94,   91,   41,   42,   43,   44,
+   45,   40,   47,  107,   59,  107,  261,   41,  289,  290,
+    0,   41,  112,   58,   59,   60,   40,   62,   63,  290,
+  291,  292,   40,  123,  124,   59,  134,  135,   44,   59,
+  123,  293,  289,  290,   60,  124,   40,  112,  120,  310,
+  311,  303,   41,   41,  315,  221,   41,   37,   93,   94,
+   40,   41,   42,   43,   37,   45,   41,   47,  292,   42,
+   43,   59,   45,  280,   47,   41,   41,  112,   58,   59,
+   60,   44,   62,   63,  261,  262,  197,   44,  123,  124,
+   63,   41,   93,  292,   59,   41,   40,   40,   40,  292,
+  290,  173,  174,   41,   91,   59,   41,  272,   40,  271,
+   41,   41,    0,   93,   94,   40,  214,  215,   43,   44,
+   45,   94,  288,   41,  260,  261,  262,  260,  261,  262,
+   59,   93,  112,   59,   41,   60,  265,   62,  213,  112,
+  260,  261,  262,  123,  124,   -1,  289,  290,   -1,   -1,
+   -1,  274,   -1,   -1,   -1,   -1,   -1,  289,  290,  289,
+  290,  289,  290,  289,  290,  289,  290,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,  289,  290,  268,  269,
+  278,  260,  261,  262,  274,   -1,  265,   -1,   -1,   -1,
+  280,   41,  282,  283,  284,  285,  286,  295,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,  292,  298,   59,
+  300,  301,  302,  303,  304,  260,  261,  262,  303,  304,
+   -1,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,   -1,   -1,  268,  269,   -1,  260,  261,  262,  274,
+  260,  261,  262,   -1,   -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,
+   -1,   -1,  260,  261,  262,   -1,   -1,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,   -1,   -1,  268,  269,
+    0,   -1,   -1,   -1,  274,  260,  261,  262,   -1,   -1,
+  280,  274,  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,  263,  264,
+   -1,   37,   -1,  268,  269,    0,   42,   -1,   58,   59,
+   -1,   47,   62,   63,   -1,  280,   -1,  282,  283,  284,
+   -1,  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,
+  295,  296,   -1,  298,   -1,   -1,  301,  302,  303,  304,
+   -1,   -1,   37,   93,   94,   40,   41,   42,   43,   44,
+   45,   -1,   47,   -1,   -1,   -1,   -1,   -1,   94,   -1,
+    0,   -1,  112,   58,   59,   60,   -1,   62,   63,   -1,
+  260,  261,  262,  123,  124,   -1,  112,   -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,   -1,   58,   59,
+   60,   -1,   62,   63,   -1,  260,  261,  262,  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,
+   37,   -1,  112,   40,   41,   42,   43,   44,   45,   -1,
+   47,   -1,   -1,  123,  124,   -1,  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,   -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,  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,   -1,   -1,   -1,   -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,   -1,   -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,   -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,    0,   -1,   -1,  112,   58,   59,   60,   -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,   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,    0,   -1,   -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,   37,   -1,   -1,   40,   41,   42,   43,   44,
+   45,   -1,   47,   -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,   -1,   -1,  303,  304,  123,  124,
+   -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,  257,
+  258,  259,  260,  261,  262,  263,  264,  265,    0,   -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,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -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,  123,   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,  257,  258,  259,  260,  261,
+  262,  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,  280,   -1,
+  282,  283,  284,  285,  286,   -1,   -1,   -1,   -1,  291,
+  292,  293,  294,   -1,   -1,  112,  298,   -1,  300,  301,
+  302,  303,  304,   -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,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,  274,
+   -1,   40,   -1,   -1,   43,  280,   45,  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,   40,   -1,   -1,   43,   -1,   45,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,   -1,
+   -1,  268,  269,    0,   60,   -1,   62,  274,   -1,   -1,
+   -1,   -1,   -1,  280,   -1,  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,
+   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,   -1,   93,   94,   40,   41,
+   -1,   43,   44,   45,   -1,   -1,   -1,   -1,   -1,    0,
+   -1,   -1,   -1,   -1,   -1,  112,   58,   59,   60,   -1,
+   62,   63,   -1,   -1,  263,  264,  123,  124,   -1,  268,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,   40,
+   41,   93,   43,   44,   45,   -1,   -1,    0,   -1,  298,
+   -1,   -1,  301,  302,  303,  304,   -1,   58,   59,   60,
+   -1,   62,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,
+   -1,   44,   93,   -1,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   58,   59,   60,   -1,   62,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,  123,  124,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,   -1,  301,  302,  303,  304,   -1,
+   93,   -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,   -1,
+  123,  124,   -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,   -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,  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,  257,  258,  259,  260,  261,  262,
+  263,  264,  265,    0,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -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,   -1,   44,   -1,   -1,
+   -1,    0,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   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,
+   -1,   40,   41,   -1,   -1,   44,   93,   -1,   -1,   -1,
+    0,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,
+   59,   60,   -1,   62,   -1,   -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,
+   40,   -1,   -1,   43,   93,   45,   -1,   -1,   -1,   -1,
+    0,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   59,
+   -1,   -1,   -1,   -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,
+   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,  123,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -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,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,   -1,
+   -1,  268,  269,  123,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,    0,  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,   -1,   -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,  257,  258,  259,
+  260,  261,  262,  263,  264,   -1,   -1,   40,  268,  269,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  280,    0,  282,  283,  284,  285,  286,   -1,   -1,   -1,
+   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+  300,  301,  302,  303,  304,  123,   -1,  257,  258,  259,
+  260,   -1,  262,  263,  264,   -1,   -1,   -1,  268,  269,
+   -1,   40,   -1,   -1,   43,   -1,   45,   -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,  257,  258,  259,  260,  261,
+  262,  263,  264,   -1,   -1,   -1,  268,  269,   -1,   40,
+   -1,   -1,   43,   -1,   45,   -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,  123,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   40,   41,   -1,   43,   44,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,
+  258,  259,   -1,   -1,   -1,  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,   -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,   -1,  301,  302,
+  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,
+  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,
+   43,  280,   45,  282,  283,  284,  285,  286,   -1,   -1,
+   -1,   -1,  291,  292,  293,  294,   59,   -1,   -1,  298,
+   -1,  300,  301,  302,  303,  304,  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,  263,  264,   -1,
+   -1,   -1,  268,  269,    0,   -1,   -1,   58,   59,   60,
+   -1,   62,   63,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,   -1,  301,  302,  303,  304,   -1,
+   -1,   37,   93,   94,   40,   41,   42,   43,   44,   45,
+   -1,   47,    0,   -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,   37,
+   -1,   -1,   -1,   41,   42,   -1,   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,  259,  123,  124,   -1,
+  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   93,   94,  280,   -1,  282,
+  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,   -1,   -1,  112,  298,   -1,  300,  301,  302,
+  303,  304,   -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,
+   -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,   -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,   -1,   -1,   -1,   -1,  274,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,  285,
+  286,    0,  288,  289,  290,  291,   -1,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,   -1,   -1,  257,
+  258,  259,  260,  261,  262,   -1,   -1,  265,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  274,   -1,   37,   -1,
+   -1,   -1,   41,   42,   -1,   44,    0,  285,   47,   -1,
+  288,  289,  290,  291,  292,  293,  294,  295,  296,   58,
+   59,   60,  300,   62,   63,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   37,   -1,   -1,   -1,   41,   42,   -1,
+   44,    0,   -1,   47,   93,   94,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   60,   -1,   62,   63,
+   -1,   -1,   -1,  112,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,  124,   -1,   -1,   37,   -1,
+   -1,   -1,   41,   42,   -1,   44,   -1,   -1,   47,   93,
+   94,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,
+   59,   60,   -1,   62,   63,   -1,   -1,   -1,  112,   -1,
+    0,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,
+  124,   -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,   37,   -1,   -1,
+   -1,   41,   42,  112,   44,   -1,   -1,   47,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,  124,   -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,  257,  258,
+  259,  260,  261,  262,   -1,   -1,  265,   -1,   -1,   -1,
+   -1,   -1,  112,   -1,   -1,  274,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  123,  124,   -1,  285,   -1,   -1,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,   -1,
+   -1,  300,   -1,  257,  258,  259,  260,  261,  262,   -1,
+   40,  265,   -1,   43,   -1,   45,   -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,  300,   -1,  257,  258,
+  259,  260,  261,  262,   -1,   -1,  265,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  274,   -1,   -1,    0,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  285,   -1,   -1,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,   -1,
+   -1,  300,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   37,   -1,   -1,   -1,   41,
+   42,   -1,   44,   -1,   -1,   47,   -1,  257,  258,  259,
+  260,  261,  262,   -1,   -1,  265,   58,   59,   60,   -1,
+   62,   63,   -1,   -1,  274,    0,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  285,   -1,   -1,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,   -1,   -1,   -1,
+  300,   93,   94,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   37,   -1,   -1,   -1,   41,   42,   -1,   44,
+  112,   -1,   47,    0,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,  124,   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,
+   37,   -1,   -1,   -1,   41,   42,   -1,   44,   93,   94,
+   47,  261,  262,  263,  264,   -1,   -1,   -1,  268,  269,
+   -1,   58,   59,   60,   -1,   62,   63,  112,   -1,   -1,
+  280,   -1,  282,  283,  284,    0,  286,   -1,  123,  124,
+   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+   -1,  301,  302,  303,  304,   -1,   93,   94,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   37,   -1,   -1,  112,   41,   42,   -1,   44,
+   -1,   -1,   47,   -1,   -1,   -1,  123,  124,   -1,   -1,
+   -1,   -1,   -1,   58,   59,   60,   -1,   62,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,
+  262,   -1,   -1,  265,   40,   41,   -1,   43,   44,   45,
+   -1,   -1,  274,    0,   -1,   -1,   -1,   -1,   93,   94,
+   -1,   -1,   -1,  285,   -1,   -1,  288,  289,  290,  291,
+  292,  293,  294,  295,  296,   -1,   -1,  112,  300,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,  124,
+   37,   -1,   -1,   -1,   41,   42,   -1,   -1,   -1,   -1,
+   47,   -1,  257,  258,  259,  260,  261,  262,   -1,   -1,
+  265,   58,   59,   60,   -1,   62,   63,   -1,   -1,  274,
+   -1,   -1,   -1,   40,   41,   -1,   43,   44,   45,   -1,
+  285,   -1,   -1,  288,  289,  290,   -1,   -1,   -1,   -1,
+  295,  296,   -1,   -1,   -1,  300,   93,   94,   -1,   -1,
+  257,  258,  259,  260,  261,  262,   -1,   -1,  265,   -1,
+   -1,   -1,   -1,   -1,   -1,  112,   -1,  274,   -1,   -1,
+    0,   -1,   -1,   -1,   -1,   -1,  123,  124,  285,   -1,
+   -1,  288,  289,  290,   -1,   -1,   -1,   -1,  295,  296,
+   -1,   -1,   -1,  300,   -1,   -1,   -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,  257,  258,  259,  260,  261,  262,   58,   59,
+  265,   -1,   -1,   63,   -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,
+  295,  296,   -1,   93,   94,  300,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  112,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,   -1,  123,  124,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,   -1,  301,  302,  303,  304,   -1,
+  257,  258,  259,  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,  263,  264,  295,  296,
+   -1,  268,  269,  300,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,    7,   -1,  280,   -1,  282,  283,  284,   14,  286,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,
+   -1,  298,   -1,   29,  301,  302,  303,  304,   -1,   35,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   49,   50,   51,   -1,   -1,   -1,   55,
+   56,   -1,   58,   59,   60,   -1,   62,   63,   64,   65,
+   66,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,  259,
+  260,  261,  262,   -1,   -1,  265,   -1,   -1,   84,   85,
+   86,   87,   88,   -1,  274,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   99,   -1,  285,   -1,   -1,  288,  289,
+  290,  107,   -1,   -1,   -1,   -1,   -1,   -1,  114,   -1,
+  300,   -1,   -1,   -1,  120,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   47,   48,  134,  135,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  157,  158,   -1,   -1,  161,  162,  163,  164,  165,
+   81,   82,   83,   -1,  170,  171,   -1,  173,  174,   -1,
+   -1,   -1,  178,   -1,   -1,   -1,  182,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  110,
+  111,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  214,  215,
+  216,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  232,   -1,  234,   -1,
+  236,   -1,  238,   -1,  240,   -1,   -1,   -1,   -1,  245,
+   -1,   -1,   -1,   -1,  250,  251,   -1,   -1,   -1,   -1,
+   -1,  172,  258,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  183,   -1,  185,   -1,  187,   -1,   -1,   -1,
+   -1,   -1,  278,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   40,   -1,   -1,   43,   -1,   45,  208,   -1,  295,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   16,   -1,
+   59,   -1,  223,  224,  225,  226,  227,   -1,   -1,   27,
+   28,   -1,   30,   31,   -1,   33,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   41,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   53,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,   45,   -1,
+  271,   -1,   -1,   -1,  275,  276,  277,   -1,   -1,   -1,
+  281,   -1,   59,   -1,  123,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   91,   92,   93,   94,   95,   96,   97,
+   -1,   -1,   -1,   -1,   -1,  306,  307,  105,   -1,   -1,
+  108,  312,   -1,   -1,  112,  113,   -1,   -1,  116,   -1,
+  118,  119,   -1,   -1,   -1,  123,  124,   -1,   -1,   -1,
+   40,   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,
+  138,  139,  140,  141,   -1,   -1,  123,   -1,  125,   59,
+   -1,   -1,  150,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  160,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,
+   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  188,   -1,   -1,   -1,   59,   -1,   -1,  195,   -1,   -1,
+   -1,  199,  200,   -1,  202,  203,  204,  205,   -1,  207,
+   -1,  209,  210,  123,   -1,  125,   -1,   -1,   -1,  217,
+  218,  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,   -1,
+   -1,   -1,  291,  292,  293,  294,  254,   -1,  123,  298,
+  125,   -1,  301,  302,  303,  304,   -1,   -1,  266,  267,
+  268,  269,  270,   -1,  272,  273,  274,   -1,   -1,   -1,
+   -1,   -1,  280,  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,   -1,  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,
+  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,
+   -1,  301,  302,  303,  304,  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,   -1,  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,   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,  123,   -1,  125,   -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,  123,   -1,
+  125,   -1,   -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,  123,   -1,  125,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,  123,
+  260,  125,   -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,
+   -1,  301,  302,  303,  304,  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,   -1,  291,  292,  293,  294,
+   -1,   -1,   -1,  298,   -1,   -1,  301,  302,  303,  304,
+  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,   40,  286,  287,   43,   -1,
+   45,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+   -1,  301,  302,  303,  304,   -1,  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,   -1,  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,  257,  258,  259,
+   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,
+   -1,   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,
+  280,   45,  282,  283,  284,  285,  286,   -1,   -1,   -1,
+   -1,  291,  292,  293,  294,   59,   -1,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,   -1,  125,   -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,  123,
+   -1,  125,   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  259,   -1,   59,   -1,  263,  264,
+   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,  280,  125,  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,   40,   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,
+  123,  260,  125,   -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,   -1,  301,  302,  303,  304,  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,   -1,  301,  302,  303,
+  304,  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,   40,  286,  287,   43,
+   -1,   45,  291,  292,  293,  294,   -1,   -1,   -1,  298,
+   -1,   -1,  301,  302,  303,  304,   -1,  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,   -1,  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,
+  259,   -1,  261,  262,  263,  264,   -1,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,
+   43,  280,   45,  282,  283,  284,   -1,  286,   -1,   -1,
+   -1,   -1,  291,  292,  293,  294,   59,   -1,   -1,  298,
+   -1,  300,  301,  302,  303,  304,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  123,   -1,  125,   -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,
+  123,   -1,  125,   -1,   -1,   -1,   -1,   -1,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  259,   -1,   59,   -1,  263,
+  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  123,  280,  125,  282,  283,
+  284,   -1,  286,   -1,   -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,  123,  260,  125,   -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,   -1,  301,  302,  303,  304,  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,   40,  286,  287,   43,   44,   45,  291,  292,
+  293,  294,   -1,   -1,   -1,  298,   -1,   -1,  301,  302,
+  303,  304,  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,   -1,  301,  302,  303,  304,   -1,  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,   -1,  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,  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,   -1,  301,  302,  303,  304,   40,   41,   -1,   43,
+   44,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,  125,   -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,  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,   -1,  301,  302,  303,  304,   40,   -1,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  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,   -1,  301,  302,  303,  304,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,  301,  302,  303,
+  304,  263,  264,   -1,   -1,   -1,  268,  269,   40,   41,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,
+  292,  293,  294,   -1,   -1,   -1,  298,   -1,   -1,  301,
+  302,  303,  304,   -1,   -1,   -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,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,   -1,   -1,   -1,  298,   -1,   -1,  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,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,
+   -1,  298,   -1,   -1,  301,  302,  303,  304,   -1,   -1,
+   -1,   -1,   40,   -1,   -1,   43,   44,   45,   -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,   -1,   -1,   -1,  298,   -1,   -1,  301,
+  302,  303,  304,   40,   -1,   -1,   43,   44,   45,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,   -1,   -1,  298,   -1,   -1,  301,
+  302,  303,  304,   -1,   -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,   -1,
+   -1,   -1,  298,   -1,   -1,  301,  302,  303,  304,   -1,
+   -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,   -1,   -1,   -1,  298,   -1,
+   -1,  301,  302,  303,  304,  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,   -1,  301,  302,  303,  304,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -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,   -1,  301,  302,  303,  304,   40,   41,
+   -1,   43,   -1,   45,   -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,   -1,  301,  302,  303,  304,   -1,   -1,
+   -1,   40,  263,  264,   43,   -1,   45,  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,   -1,
+  301,  302,  303,  304,  259,   -1,   -1,   -1,  263,  264,
+   -1,   -1,   -1,  268,  269,   40,   41,   -1,   43,   -1,
+   45,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+   -1,  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,
+   -1,   -1,   -1,  298,   -1,   -1,  301,  302,  303,  304,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -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,   -1,  301,  302,
+  303,  304,   40,   41,   -1,   43,   -1,   45,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,  301,
+  302,  303,  304,   40,   41,   -1,   43,   -1,   45,   -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,   -1,  301,  302,  303,  304,   40,   41,   -1,   43,
+   -1,   45,   -1,   -1,   -1,   -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,   -1,  301,  302,  303,  304,
+  263,  264,   -1,   -1,   -1,  268,  269,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,   -1,   -1,   -1,  298,   -1,   -1,  301,  302,
+  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,
+   41,   -1,   43,   -1,   45,  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,   -1,  301,  302,  303,  304,   40,   -1,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -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,
+   93,  298,   -1,   -1,  301,  302,  303,  304,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -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,   -1,  301,  302,  303,
+  304,   40,   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -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,   -1,  301,  302,
+  303,  304,  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,   -1,
+  301,  302,  303,  304,   -1,   -1,   -1,   -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,   -1,  301,  302,
+  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -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,   27,   28,  301,
+  302,  303,  304,   33,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   41,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,
+  269,   -1,   -1,   53,   -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,   -1,  301,  302,  303,  304,   -1,   -1,   -1,   -1,
+   -1,   91,   92,   93,   94,   95,   96,   97,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  105,   -1,   -1,  108,   -1,
+   -1,   -1,  112,  113,   -1,   -1,  116,   -1,  118,  119,
+   -1,   -1,   -1,  123,  124,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  138,  139,
+  140,  141,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  160,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  188,   -1,
+   -1,   -1,   -1,   -1,   -1,  195,   -1,   -1,   -1,  199,
+  200,   -1,  202,  203,  204,  205,   -1,  207,   -1,  209,
+  210,   -1,   -1,   -1,   -1,   -1,   -1,  217,  218,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  254,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  266,  267,  268,  269,
+  270,   -1,  272,  273,  274,   -1,   -1,   -1,   -1,   -1,
+  280,
+};
+#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",
+"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 : term '?' term ':' term",
+"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 ']'",
+"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
+#ifdef YYSTACKSIZE
+#undef YYMAXDEPTH
+#define YYMAXDEPTH YYSTACKSIZE
+#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 406 "a2p.y"
+#include "a2py.c"
+#line 1997 "y.tab.c"
+#define YYABORT goto yyabort
+#define YYREJECT 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("%sdebug: state %d, reading %d (%s)\n",
+                    YYPREFIX, yystate, yychar, yys);
+        }
+#endif
+    }
+    if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("%sdebug: state %d, shifting to state %d\n",
+                    YYPREFIX, 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("%sdebug: state %d, error recovery shifting\
+ to state %d\n", YYPREFIX, *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("%sdebug: error recovery discarding state %d\n",
+                            YYPREFIX, *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("%sdebug: state %d, error recovery discards token %d (%s)\n",
+                    YYPREFIX, yystate, yychar, yys);
+        }
+#endif
+        yychar = (-1);
+        goto yyloop;
+    }
+yyreduce:
+#if YYDEBUG
+    if (yydebug)
+        printf("%sdebug: state %d, reducing by rule %d (%s)\n",
+                YYPREFIX, yystate, yyn, yyrule[yyn]);
+#endif
+    yym = yylen[yyn];
+    yyval = yyvsp[1-yym];
+    switch (yyn)
+    {
+case 1:
+#line 63 "a2p.y"
+{ root = oper4(OPROG,yyvsp[-1],begins,yyvsp[0],ends); }
+break;
+case 2:
+#line 67 "a2p.y"
+{ begins = oper4(OJUNK,begins,yyvsp[-3],yyvsp[-2],yyvsp[0]); in_begin = FALSE;
+		    yyval = Nullop; }
+break;
+case 3:
+#line 72 "a2p.y"
+{ ends = oper3(OJUNK,ends,yyvsp[-2],yyvsp[-1]); yyval = Nullop; }
+break;
+case 4:
+#line 74 "a2p.y"
+{ yyval = yyvsp[-1]; }
+break;
+case 5:
+#line 78 "a2p.y"
+{ yyval = oper3(OHUNKS,yyvsp[-2],yyvsp[-1],yyvsp[0]); }
+break;
+case 6:
+#line 80 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 7:
+#line 84 "a2p.y"
+{ yyval = oper1(OHUNK,yyvsp[0]); need_entire = TRUE; }
+break;
+case 8:
+#line 86 "a2p.y"
+{ yyval = oper2(OHUNK,yyvsp[-4],oper2(OJUNK,yyvsp[-2],yyvsp[-1])); }
+break;
+case 9:
+#line 88 "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 90 "a2p.y"
+{ yyval = oper2(OHUNK,Nullop,oper2(OJUNK,yyvsp[-2],yyvsp[-1])); }
+break;
+case 13:
+#line 96 "a2p.y"
+{ yyval = rememberargs(yyval); }
+break;
+case 14:
+#line 100 "a2p.y"
+{ yyval = oper1(OPAT,yyvsp[0]); }
+break;
+case 15:
+#line 102 "a2p.y"
+{ yyval = oper2(ORANGE,yyvsp[-2],yyvsp[0]); }
+break;
+case 20:
+#line 113 "a2p.y"
+{ yyval = oper1(OCPAREN,yyvsp[-1]); }
+break;
+case 21:
+#line 115 "a2p.y"
+{ yyval = oper3(OCANDAND,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 22:
+#line 117 "a2p.y"
+{ yyval = oper3(OCOROR,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 23:
+#line 119 "a2p.y"
+{ yyval = oper1(OCNOT,yyvsp[0]); }
+break;
+case 24:
+#line 123 "a2p.y"
+{ yyval = oper3(ORELOP,yyvsp[-1],yyvsp[-2],yyvsp[0]); }
+break;
+case 25:
+#line 125 "a2p.y"
+{ yyval = oper3(ORELOP,string(">",1),yyvsp[-2],yyvsp[0]); }
+break;
+case 26:
+#line 127 "a2p.y"
+{ yyval = oper3(ORELOP,string("<",1),yyvsp[-2],yyvsp[0]); }
+break;
+case 27:
+#line 129 "a2p.y"
+{ yyval = oper1(ORPAREN,yyvsp[-1]); }
+break;
+case 28:
+#line 133 "a2p.y"
+{ yyval = oper3(OMATCHOP,yyvsp[-1],yyvsp[-2],yyvsp[0]); }
+break;
+case 29:
+#line 135 "a2p.y"
+{ yyval = oper3(OMATCHOP,yyvsp[-1],yyvsp[-2],oper1(OREGEX,yyvsp[0])); }
+break;
+case 30:
+#line 137 "a2p.y"
+{ yyval = oper1(OREGEX,yyvsp[0]); }
+break;
+case 31:
+#line 139 "a2p.y"
+{ yyval = oper1(OMPAREN,yyvsp[-1]); }
+break;
+case 32:
+#line 143 "a2p.y"
+{ yyval = yyvsp[0]; }
+break;
+case 33:
+#line 145 "a2p.y"
+{ yyval = oper2(OCONCAT,yyvsp[-1],yyvsp[0]); }
+break;
+case 34:
+#line 147 "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 35:
+#line 156 "a2p.y"
+{ yyval = yyvsp[0]; }
+break;
+case 36:
+#line 158 "a2p.y"
+{ yyval = oper1(ONUM,yyvsp[0]); }
+break;
+case 37:
+#line 160 "a2p.y"
+{ yyval = oper1(OSTR,yyvsp[0]); }
+break;
+case 38:
+#line 162 "a2p.y"
+{ yyval = oper2(OADD,yyvsp[-2],yyvsp[0]); }
+break;
+case 39:
+#line 164 "a2p.y"
+{ yyval = oper2(OSUBTRACT,yyvsp[-2],yyvsp[0]); }
+break;
+case 40:
+#line 166 "a2p.y"
+{ yyval = oper2(OMULT,yyvsp[-2],yyvsp[0]); }
+break;
+case 41:
+#line 168 "a2p.y"
+{ yyval = oper2(ODIV,yyvsp[-2],yyvsp[0]); }
+break;
+case 42:
+#line 170 "a2p.y"
+{ yyval = oper2(OMOD,yyvsp[-2],yyvsp[0]); }
+break;
+case 43:
+#line 172 "a2p.y"
+{ yyval = oper2(OPOW,yyvsp[-2],yyvsp[0]); }
+break;
+case 44:
+#line 174 "a2p.y"
+{ yyval = oper2(ODEFINED,aryrefarg(yyvsp[0]),yyvsp[-2]); }
+break;
+case 45:
+#line 176 "a2p.y"
+{ yyval = oper3(OCOND,yyvsp[-4],yyvsp[-2],yyvsp[0]); }
+break;
+case 46:
+#line 178 "a2p.y"
+{ yyval = oper1(OPOSTINCR,yyvsp[-1]); }
+break;
+case 47:
+#line 180 "a2p.y"
+{ yyval = oper1(OPOSTDECR,yyvsp[-1]); }
+break;
+case 48:
+#line 182 "a2p.y"
+{ yyval = oper1(OPREINCR,yyvsp[0]); }
+break;
+case 49:
+#line 184 "a2p.y"
+{ yyval = oper1(OPREDECR,yyvsp[0]); }
+break;
+case 50:
+#line 186 "a2p.y"
+{ yyval = oper1(OUMINUS,yyvsp[0]); }
+break;
+case 51:
+#line 188 "a2p.y"
+{ yyval = oper1(OUPLUS,yyvsp[0]); }
+break;
+case 52:
+#line 190 "a2p.y"
+{ yyval = oper1(OPAREN,yyvsp[-1]); }
+break;
+case 53:
+#line 192 "a2p.y"
+{ yyval = oper0(OGETLINE); }
+break;
+case 54:
+#line 194 "a2p.y"
+{ yyval = oper1(OGETLINE,yyvsp[0]); }
+break;
+case 55:
+#line 196 "a2p.y"
+{ yyval = oper3(OGETLINE,Nullop,string("<",1),yyvsp[0]);
+		    if (ops[yyvsp[0]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 56:
+#line 199 "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 57:
+#line 202 "a2p.y"
+{ yyval = oper3(OGETLINE,Nullop,string("|",1),yyvsp[-2]);
+		    if (ops[yyvsp[-2]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 58:
+#line 205 "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 59:
+#line 208 "a2p.y"
+{ yyval = oper0(yyvsp[0]); need_entire = do_chop = TRUE; }
+break;
+case 60:
+#line 210 "a2p.y"
+{ yyval = oper1(yyvsp[-2],Nullop); need_entire = do_chop = TRUE; }
+break;
+case 61:
+#line 212 "a2p.y"
+{ yyval = oper1(yyvsp[-3],yyvsp[-1]); }
+break;
+case 62:
+#line 214 "a2p.y"
+{ yyval = oper1(yyvsp[-3],yyvsp[-1]); }
+break;
+case 63:
+#line 216 "a2p.y"
+{ yyval = oper2(OUSERFUN,yyvsp[-3],yyvsp[-1]); }
+break;
+case 64:
+#line 218 "a2p.y"
+{ yyval = oper1(OSPRINTF,yyvsp[0]); }
+break;
+case 65:
+#line 220 "a2p.y"
+{ yyval = oper3(OSUBSTR,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 66:
+#line 222 "a2p.y"
+{ yyval = oper2(OSUBSTR,yyvsp[-3],yyvsp[-1]); }
+break;
+case 67:
+#line 224 "a2p.y"
+{ yyval = oper3(OSPLIT,yyvsp[-5],aryrefarg(numary(yyvsp[-3])),yyvsp[-1]); }
+break;
+case 68:
+#line 226 "a2p.y"
+{ yyval = oper3(OSPLIT,yyvsp[-5],aryrefarg(numary(yyvsp[-3])),oper1(OREGEX,yyvsp[-1]));}
+break;
+case 69:
+#line 228 "a2p.y"
+{ yyval = oper2(OSPLIT,yyvsp[-3],aryrefarg(numary(yyvsp[-1]))); }
+break;
+case 70:
+#line 230 "a2p.y"
+{ yyval = oper2(OINDEX,yyvsp[-3],yyvsp[-1]); }
+break;
+case 71:
+#line 232 "a2p.y"
+{ yyval = oper2(OMATCH,yyvsp[-3],oper1(OREGEX,yyvsp[-1])); }
+break;
+case 72:
+#line 234 "a2p.y"
+{ yyval = oper2(OMATCH,yyvsp[-3],yyvsp[-1]); }
+break;
+case 73:
+#line 236 "a2p.y"
+{ yyval = oper2(OSUB,yyvsp[-3],yyvsp[-1]); }
+break;
+case 74:
+#line 238 "a2p.y"
+{ yyval = oper2(OSUB,oper1(OREGEX,yyvsp[-3]),yyvsp[-1]); }
+break;
+case 75:
+#line 240 "a2p.y"
+{ yyval = oper2(OGSUB,yyvsp[-3],yyvsp[-1]); }
+break;
+case 76:
+#line 242 "a2p.y"
+{ yyval = oper2(OGSUB,oper1(OREGEX,yyvsp[-3]),yyvsp[-1]); }
+break;
+case 77:
+#line 244 "a2p.y"
+{ yyval = oper3(OSUB,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 78:
+#line 246 "a2p.y"
+{ yyval = oper3(OSUB,oper1(OREGEX,yyvsp[-5]),yyvsp[-3],yyvsp[-1]); }
+break;
+case 79:
+#line 248 "a2p.y"
+{ yyval = oper3(OGSUB,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 80:
+#line 250 "a2p.y"
+{ yyval = oper3(OGSUB,oper1(OREGEX,yyvsp[-5]),yyvsp[-3],yyvsp[-1]); }
+break;
+case 81:
+#line 254 "a2p.y"
+{ yyval = oper1(OVAR,yyvsp[0]); }
+break;
+case 82:
+#line 256 "a2p.y"
+{ yyval = oper2(OVAR,aryrefarg(yyvsp[-3]),yyvsp[-1]); }
+break;
+case 83:
+#line 258 "a2p.y"
+{ yyval = oper1(OFLD,yyvsp[0]); }
+break;
+case 84:
+#line 260 "a2p.y"
+{ yyval = oper1(OVFLD,yyvsp[0]); }
+break;
+case 87:
+#line 267 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 88:
+#line 271 "a2p.y"
+{ yyval = oper3(OCOMMA,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 89:
+#line 273 "a2p.y"
+{ yyval = oper3(OCOMMA,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 90:
+#line 275 "a2p.y"
+{ yyval = yyvsp[-1]; }
+break;
+case 91:
+#line 279 "a2p.y"
+{ yyval = oper2(OJUNK,yyvsp[-1],yyvsp[0]); }
+break;
+case 92:
+#line 281 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 93:
+#line 285 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+break;
+case 94:
+#line 287 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+break;
+case 95:
+#line 289 "a2p.y"
+{ yyval = oper0(ONEWLINE); }
+break;
+case 96:
+#line 291 "a2p.y"
+{ yyval = oper1(OCOMMENT,yyvsp[0]); }
+break;
+case 97:
+#line 295 "a2p.y"
+{ yyval = oper2(OJUNK,yyvsp[-1],yyvsp[0]); }
+break;
+case 98:
+#line 297 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 99:
+#line 301 "a2p.y"
+{ yyval = oper0(ONEWLINE); }
+break;
+case 100:
+#line 303 "a2p.y"
+{ yyval = oper1(OCOMMENT,yyvsp[0]); }
+break;
+case 101:
+#line 308 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),yyvsp[0]); }
+break;
+case 102:
+#line 310 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0]); }
+break;
+case 103:
+#line 312 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0]); }
+break;
+case 104:
+#line 314 "a2p.y"
+{ yyval = oper2(OJUNK,oper1(OSCOMMENT,yyvsp[-1]),yyvsp[0]); }
+break;
+case 105:
+#line 318 "a2p.y"
+{ yyval = oper2(OSTATES,yyvsp[-1],yyvsp[0]); }
+break;
+case 106:
+#line 320 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 107:
+#line 325 "a2p.y"
+{ yyval = oper2(OJUNK,oper2(OSTATE,yyvsp[-2],yyvsp[-1]),yyvsp[0]); }
+break;
+case 108:
+#line 327 "a2p.y"
+{ yyval = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),yyvsp[0])); }
+break;
+case 109:
+#line 329 "a2p.y"
+{ yyval = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0])); }
+break;
+case 112:
+#line 335 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 114:
+#line 341 "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 115:
+#line 347 "a2p.y"
+{ yyval = oper1(OPRINT,yyvsp[0]);
+		    if (!yyvsp[0]) need_entire = TRUE;
+		    saw_ORS = saw_OFS = TRUE;
+		}
+break;
+case 116:
+#line 352 "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 117:
+#line 357 "a2p.y"
+{ yyval = oper1(OPRINTF,yyvsp[0]);
+		    if (!yyvsp[0]) need_entire = TRUE;
+		}
+break;
+case 118:
+#line 361 "a2p.y"
+{ yyval = oper0(OBREAK); }
+break;
+case 119:
+#line 363 "a2p.y"
+{ yyval = oper0(ONEXT); }
+break;
+case 120:
+#line 365 "a2p.y"
+{ yyval = oper0(OEXIT); }
+break;
+case 121:
+#line 367 "a2p.y"
+{ yyval = oper1(OEXIT,yyvsp[0]); }
+break;
+case 122:
+#line 369 "a2p.y"
+{ yyval = oper0(OCONTINUE); }
+break;
+case 123:
+#line 371 "a2p.y"
+{ yyval = oper0(ORETURN); }
+break;
+case 124:
+#line 373 "a2p.y"
+{ yyval = oper1(ORETURN,yyvsp[0]); }
+break;
+case 125:
+#line 375 "a2p.y"
+{ yyval = oper2(ODELETE,aryrefarg(yyvsp[-3]),yyvsp[-1]); }
+break;
+case 126:
+#line 379 "a2p.y"
+{ yyval = oper1(OREDIR,string(">",1)); }
+break;
+case 127:
+#line 381 "a2p.y"
+{ yyval = oper1(OREDIR,string(">>",2)); }
+break;
+case 128:
+#line 383 "a2p.y"
+{ yyval = oper1(OREDIR,string("|",1)); }
+break;
+case 129:
+#line 388 "a2p.y"
+{ yyval = oper2(OIF,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 130:
+#line 390 "a2p.y"
+{ yyval = oper3(OIF,yyvsp[-6],bl(yyvsp[-3],yyvsp[-4]),bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 131:
+#line 392 "a2p.y"
+{ yyval = oper2(OWHILE,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 132:
+#line 394 "a2p.y"
+{ yyval = oper2(ODO,bl(yyvsp[-4],yyvsp[-5]),yyvsp[-1]); }
+break;
+case 133:
+#line 396 "a2p.y"
+{ yyval = oper4(OFOR,yyvsp[-7],yyvsp[-5],yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 134:
+#line 398 "a2p.y"
+{ yyval = oper4(OFOR,yyvsp[-6],string("",0),yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 135:
+#line 400 "a2p.y"
+{ yyval = oper2(OFORIN,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 136:
+#line 402 "a2p.y"
+{ yyval = oper3(OBLOCK,oper2(OJUNK,yyvsp[-3],yyvsp[-2]),Nullop,yyvsp[0]); }
+break;
+#line 2660 "y.tab.c"
+    }
+    yyssp -= yym;
+    yystate = *yyssp;
+    yyvsp -= yym;
+    yym = yylhs[yyn];
+    if (yystate == 0 && yym == 0)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("%sdebug: after reduction, shifting from state 0 to\
+ state %d\n", YYPREFIX, 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("%sdebug: state %d, reading %d (%s)\n",
+                        YYPREFIX, 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("%sdebug: after reduction, shifting from state %d \
+to state %d\n", YYPREFIX, *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 000000000000..7c6a66dde29c
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.h
@@ -0,0 +1,341 @@
+/* $RCSfile: a2p.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30: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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:09  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  16:12:23  lwall
+ * patch20: hash tables now split only if the memory is available to do so
+ * 
+ * Revision 4.0.1.1  91/06/07  12:12:27  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:07  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define VOIDUSED 1
+#include "config.h"
+
+#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
+
+#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 */
+union u_ops ops[OPSMAX];
+
+#include <stdio.h>
+#include <ctype.h>
+
+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)
+
+STR *str_new();
+
+char *scanpat();
+char *scannum();
+
+void str_free();
+
+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);
+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
diff --git a/gnu/usr.bin/perl/x2p/a2p.y b/gnu/usr.bin/perl/x2p/a2p.y
new file mode 100644
index 000000000000..bc86632dd417
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.y
@@ -0,0 +1,406 @@
+%{
+/* $RCSfile: a2p.y,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30: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.y,v $
+ * Revision 1.1.1.1  1993/08/23  21:30:09  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  16:13:03  lwall
+ * patch20: in a2p, getline should allow variable to be array element
+ * 
+ * Revision 4.0.1.1  91/06/07  12:12:41  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:21  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#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
+	;
+
+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); }
+	| term '?' term ':' term
+		{ $$ = 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 ']'
+		{ $$ = 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 000000000000..1558f9954f2e
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2py.c
@@ -0,0 +1,1301 @@
+/* $RCSfile: a2py.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  92/06/08  16:15:16  lwall
+ * patch20: in a2p, now warns about spurious backslashes
+ * patch20: in a2p, now allows [ to be backslashed in pattern
+ * patch20: in a2p, now allows numbers of the form 2.
+ * 
+ * Revision 4.0.1.1  91/06/07  12:12:59  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:26  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#ifdef OS2
+#include "../patchlevel.h"
+#endif
+#include "util.h"
+char *index();
+
+char *filename;
+char *myname;
+
+int checkers = 0;
+STR *walk();
+
+#ifdef OS2
+usage()
+{
+    printf("\nThis is the AWK to PERL translator, version 4.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;
+    register char *s;
+    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("#!");
+    str_cat(str, BIN);
+    str_cat(str, "/perl\neval \"exec ");
+    str_cat(str, BIN);
+    str_cat(str, "/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_]+=)(.*)/ && 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;
+
+yylex()
+{
+    register char *s = bufptr;
+    register char *d;
+    register int tmp;
+
+  retry:
+#ifdef YYDEBUG
+    if (yydebug)
+	if (index(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;
+}
+
+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 (index("eE",*s) && index("+-0123456789",s[1])) {
+	    *d++ = *s++;
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isdigit(*s))
+		*d++ = *s++;
+	}
+	*d = '\0';
+	yylval = string(tokenbuf,0);
+	break;
+    }
+    return s;
+}
+
+string(ptr,len)
+char *ptr;
+{
+    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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+
+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");
+    }
+}
+
+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;
+}
+
+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++;
+	}
+    }
+}
+
+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;
+	}
+    }
+}
+
+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);
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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/find2perl b/gnu/usr.bin/perl/x2p/find2perl
new file mode 100755
index 000000000000..6d7f0adbb28c
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/find2perl
@@ -0,0 +1,568 @@
+#!/usr/gnu/bin/perl
+
+eval 'exec /usr/gnu/bin/perl -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+$bin = "/usr/gnu/bin";
+
+
+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)),1)';
+    }
+    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";
+#!$bin/perl
+
+eval 'exec $bin/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 = '19' . $year;
+    }
+    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'";
+}
diff --git a/gnu/usr.bin/perl/x2p/h2ph b/gnu/usr.bin/perl/x2p/h2ph
new file mode 100755
index 000000000000..f093626d43cc
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/h2ph
@@ -0,0 +1,253 @@
+#!/usr/gnu/bin/perl
+'di';
+'ig00';
+
+$perlincl = '/usr/gnu/lib/perl';
+
+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;
+
+@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 = '';
+		do expr();
+		print OUT $t,"if ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^elif\s+//) {
+		$new = '';
+		do expr();
+		$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+)//		&& 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 .= $id;
+		}
+	    }
+	    else {
+		$new .= ' &' . $id;
+	    }
+	    next;
+	};
+	s/^(.)//			&& do {$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
diff --git a/gnu/usr.bin/perl/x2p/h2ph.1 b/gnu/usr.bin/perl/x2p/h2ph.1
new file mode 100755
index 000000000000..f093626d43cc
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/h2ph.1
@@ -0,0 +1,253 @@
+#!/usr/gnu/bin/perl
+'di';
+'ig00';
+
+$perlincl = '/usr/gnu/lib/perl';
+
+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;
+
+@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 = '';
+		do expr();
+		print OUT $t,"if ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^elif\s+//) {
+		$new = '';
+		do expr();
+		$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+)//		&& 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 .= $id;
+		}
+	    }
+	    else {
+		$new .= ' &' . $id;
+	    }
+	    next;
+	};
+	s/^(.)//			&& do {$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
diff --git a/gnu/usr.bin/perl/x2p/handy.h b/gnu/usr.bin/perl/x2p/handy.h
new file mode 100644
index 000000000000..85a777c2e7fb
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/handy.h
@@ -0,0 +1,46 @@
+/* $RCSfile: handy.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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: handy.h,v $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  91/06/07  12:15:43  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0.1.1  91/04/12  09:29:08  lwall
+ * patch1: random cleanup in cpp namespace
+ * 
+ * Revision 4.0  91/03/20  01:57:45  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#define Null(type) ((type)0)
+#define Nullch Null(char*)
+#define Nullfp Null(FILE*)
+
+#define bool char
+#ifdef TRUE
+#undef TRUE
+#endif
+#ifdef FALSE
+#undef FALSE
+#endif
+#define TRUE (1)
+#define FALSE (0)
+
+#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))
diff --git a/gnu/usr.bin/perl/x2p/hash.c b/gnu/usr.bin/perl/x2p/hash.c
new file mode 100644
index 000000000000..d525882f9acb
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/hash.c
@@ -0,0 +1,250 @@
+/* $RCSfile: hash.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:15:55  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:49  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include <stdio.h>
+#include "EXTERN.h"
+#include "handy.h"
+#include "util.h"
+#include "a2p.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((char*)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
+
+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
+
+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 000000000000..ae4ffaff0617
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/hash.h
@@ -0,0 +1,60 @@
+/* $RCSfile: hash.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:16:04  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:57:53  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#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 */
+};
+
+STR *hfetch();
+bool hstore();
+bool hdelete();
+HASH *hnew();
+int hiterinit();
+HENT *hiternext();
+char *hiterkey();
+STR *hiterval();
diff --git a/gnu/usr.bin/perl/x2p/malloc.c b/gnu/usr.bin/perl/x2p/malloc.c
new file mode 100644
index 000000000000..dd43390d6dca
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/malloc.c
@@ -0,0 +1,513 @@
+/* $RCSfile: malloc.c,v $$Revision: 1.2 $$Date: 1993/08/24 17:57:39 $
+ *
+ * $Log: malloc.c,v $
+ * Revision 1.2  1993/08/24  17:57:39  nate
+ * Fix for ALIGN macros in PERL that conflict with 4.4 macros
+ *
+ * Revision 1.1.1.1  1993/08/23  21:30:11  nate
+ * PERL!
+ *
+ * Revision 4.0.1.4  92/06/08  14:28:38  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: hash tables now split only if the memory is available to do so
+ * patch20: realloc(0, size) now does malloc in case library routines call it
+ * 
+ * Revision 4.0.1.3  91/11/05  17:57:40  lwall
+ * patch11: safe malloc code now integrated into Perl's malloc when possible
+ * 
+ * Revision 4.0.1.2  91/06/07  11:20:45  lwall
+ * patch4: many, many itty-bitty portability fixes
+ * 
+ * Revision 4.0.1.1  91/04/11  17:48:31  lwall
+ * patch1: Configure now figures out malloc ptr type
+ * 
+ * Revision 4.0  91/03/20  01:28:52  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#ifndef lint
+/*SUPPRESS 592*/
+static char sccsid[] = "@(#)malloc.c	4.3 (Berkeley) 9/16/83";
+
+#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"
+
+static findbucket(), morecore();
+
+/* 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 ALIGN_BYTES > 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
+};
+
+#define	MAGIC		0xff		/* magic # on accounting info */
+#define OLDMAGIC	0x7f		/* same after a free() */
+#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 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
+
+#ifdef safemalloc
+static int an = 0;
+#endif
+
+MALLOCPTRTYPE *
+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);
+		exit(1);
+	}
+#endif /* MSDOS */
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+	    fatal("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);
+		    exit(1);
+		}
+#else
+  		return (NULL);
+#endif
+	}
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+    if (debug & 128)
+        fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
+#  else
+    if (debug & 128)
+        fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
+#  endif
+#endif
+#endif /* safemalloc */
+
+	/* remove from linked list */
+#ifdef RCHECK
+	if (*((int*)p) & (sizeof(union overhead) - 1))
+#if !(defined(I286) || defined(atarist))
+	    fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
+#else
+	    fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
+#endif
+#endif
+  	nextf[bucket] = p->ov_next;
+	p->ov_magic = MAGIC;
+	p->ov_index= bucket;
+#ifdef 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 ((MALLOCPTRTYPE *)(p + 1));
+}
+
+/*
+ * Allocate more memory to the indicated bucket.
+ */
+static
+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);
+  	}
+}
+
+void
+free(mp)
+	MALLOCPTRTYPE *mp;
+{   
+  	register MEM_SIZE size;
+	register union overhead *op;
+	char *cp = (char*)mp;
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+#  if !(defined(I286) || defined(atarist))
+	if (debug & 128)
+		fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
+#  else
+	if (debug & 128)
+		fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++);
+#  endif
+#endif
+#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) {
+		warn("%s free() ignored",
+		    op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad");
+		return;				/* sanity */
+	}
+	op->ov_magic = OLDMAGIC;
+#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);
+#endif
+  	ASSERT(op->ov_index < NBUCKETS);
+  	size = op->ov_index;
+	op->ov_next = nextf[size];
+  	nextf[size] = op;
+#ifdef 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 */
+
+MALLOCPTRTYPE *
+realloc(mp, nbytes)
+	MALLOCPTRTYPE *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);
+		exit(1);
+	}
+#endif /* MSDOS */
+	if (!cp)
+		return malloc(nbytes);
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+		fatal("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 !(defined(I286) || defined(atarist))
+	if (debug & 128) {
+	    fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
+	    fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
+	}
+#  else
+	if (debug & 128) {
+	    fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
+	    fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
+	}
+#  endif
+#endif
+#endif /* safemalloc */
+  	return ((MALLOCPTRTYPE*)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 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
+mstats(s)
+	char *s;
+{
+  	register int i, j;
+  	register union overhead *p;
+  	int totfree = 0,
+  	totused = 0;
+
+  	fprintf(stderr, "Memory allocation statistics %s\nfree:\t", s);
+  	for (i = 0; i < NBUCKETS; i++) {
+  		for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+  			;
+  		fprintf(stderr, " %d", j);
+  		totfree += j * (1 << (i + 3));
+  	}
+  	fprintf(stderr, "\nused:\t");
+  	for (i = 0; i < NBUCKETS; i++) {
+  		fprintf(stderr, " %d", nmalloc[i]);
+  		totused += nmalloc[i] * (1 << (i + 3));
+  	}
+  	fprintf(stderr, "\n\tTotal in use: %d, total free: %d\n",
+	    totused, totfree);
+}
+#endif
+#endif /* lint */
diff --git a/gnu/usr.bin/perl/x2p/s2p b/gnu/usr.bin/perl/x2p/s2p
new file mode 100755
index 000000000000..8a8a74c58bfc
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/s2p
@@ -0,0 +1,766 @@
+#!/usr/gnu/bin/perl
+
+eval 'exec /usr/gnu/bin/perl -S $0 ${1+"$@"}'
+	if $running_under_some_shell;
+
+$bin = '/usr/gnu/bin';
+
+# $RCSfile: s2p,v $$Revision: 1.2 $$Date: 1994/03/05 01:28:48 $
+#
+# $Log: s2p,v $
+# Revision 1.2  1994/03/05  01:28:48  ache
+# 1) Perl uses scrambler crypt() version from libc instead of proper one
+# from -lcrypt (if exist)
+# 2) We have now all sem/shm/msg stuff, add it to perl too
+#
+# Revision 1.1.1.1  1993/08/23  21:30:10  nate
+# PERL!
+#
+# Revision 4.0.1.2  92/06/08  17:26:31  lwall
+# patch20: s2p didn't output portable startup code
+# patch20: added ... as variant on ..
+# patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
+# 
+# Revision 4.0.1.1  91/06/07  12:19:18  lwall
+# patch4: s2p now handles embedded newlines better and optimizes common idioms
+# 
+# Revision 4.0  91/03/20  01:57:59  lwall
+# 4.0 baseline.
+# 
+#
+
+$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");
+:	#!$bin/perl
+:	eval 'exec $bin/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;
+}
+
diff --git a/gnu/usr.bin/perl/x2p/s2p.1 b/gnu/usr.bin/perl/x2p/s2p.1
new file mode 100644
index 000000000000..ab74717833fc
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/s2p.1
@@ -0,0 +1,108 @@
+.rn '' }`
+''' $RCSfile: s2p.man,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+''' 
+''' $Log: s2p.man,v $
+.\" Revision 1.1.1.1  1993/08/23  21:30:10  nate
+.\" PERL!
+.\"
+''' Revision 4.0.1.1  91/06/07  12:19:57  lwall
+''' patch4: s2p now handles embedded newlines better and optimizes common idioms
+''' 
+''' Revision 4.0  91/03/20  01:58:07  lwall
+''' 4.0 baseline.
+''' 
+''' Revision 3.0  89/10/18  15:35:09  lwall
+''' 3.0 baseline
+''' 
+''' Revision 2.0  88/06/05  00:15:59  root
+''' Baseline version 2.0.
+''' 
+''' 
+.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 000000000000..04611946e250
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/str.c
@@ -0,0 +1,467 @@
+/* $RCSfile: str.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30: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: str.c,v $
+ * Revision 1.1.1.1  1993/08/23  21:30:09  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:20:08  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:58:15  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "util.h"
+#include "a2p.h"
+
+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;
+}
+
+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);
+}
+
+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 */
+}
+
+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 */
+}
+
+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 */
+}
+
+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 */
+}
+
+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);
+}
+
+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 (index(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;
+}
+
+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;
+{
+#ifdef STDSTDIO		/* 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 = fp->_cnt;			/* 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 = fp->_ptr;
+    for (;;) {
+	while (--cnt >= 0) {
+	    if ((*bp++ = *ptr++) == newline)
+		if (bp <= str->str_ptr || bp[-2] != '\\')
+		    goto thats_all_folks;
+		else {
+		    line++;
+		    bp -= 2;
+		}
+	}
+	
+	fp->_cnt = cnt;			/* deregisterize cnt and ptr */
+	fp->_ptr = ptr;
+	i = _filbuf(fp);		/* get more characters */
+	cnt = fp->_cnt;
+	ptr = fp->_ptr;			/* 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:
+    fp->_cnt = cnt;			/* put these back or we're in trouble */
+    fp->_ptr = ptr;
+    *bp = '\0';
+    str->str_cur = bp - str->str_ptr;	/* set length */
+
+#else /* !STDSTDIO */	/* 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 /* STDSTDIO */
+
+    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 000000000000..765d9ea2113d
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/str.h
@@ -0,0 +1,46 @@
+/* $RCSfile: str.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:20:22  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:58:21  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+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);
+
+char *str_2ptr();
+double str_2num();
+STR *str_mortal();
+STR *str_make();
+STR *str_nmake();
+char *str_gets();
diff --git a/gnu/usr.bin/perl/x2p/util.c b/gnu/usr.bin/perl/x2p/util.c
new file mode 100644
index 000000000000..4c5b078e4f9e
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/util.c
@@ -0,0 +1,268 @@
+/* $RCSfile: util.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.1  91/06/07  12:20:35  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:58:25  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include <stdio.h>
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "a2p.h"
+#include "INTERN.h"
+#include "util.h"
+
+#define FLUSH
+#define MEM_SIZE unsigned int
+
+static char nomem[] = "Out of memory!\n";
+
+/* paranoid version of malloc */
+
+static int an = 0;
+
+char *
+safemalloc(size)
+MEM_SIZE size;
+{
+    char *ptr;
+    char *malloc();
+
+    ptr = 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 */
+
+char *
+saferealloc(where,size)
+char *where;
+MEM_SIZE size;
+{
+    char *ptr;
+    char *realloc();
+
+    ptr = 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 */
+
+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*/
+fatal(pat,a1,a2,a3,a4)
+char *pat;
+{
+    fprintf(stderr,pat,a1,a2,a3,a4);
+    exit(1);
+}
+
+/*VARARGS1*/
+warn(pat,a1,a2,a3,a4)
+char *pat;
+{
+    fprintf(stderr,pat,a1,a2,a3,a4);
+}
+
+static bool firstsetenv = TRUE;
+extern char **environ;
+
+void
+setenv(nam,val)
+char *nam, *val;
+{
+    register int i=envix(nam);		/* where does it go? */
+
+    if (!environ[i]) {			/* does not exist yet */
+	if (firstsetenv) {		/* need we copy environment? */
+	    int j;
+#ifndef lint
+	    char **tmpenv = (char**)	/* point our wand at memory */
+		safemalloc((i+2) * sizeof(char*));
+#else
+	    char **tmpenv = Null(char **);
+#endif /* lint */
+    
+	    firstsetenv = FALSE;
+	    for (j=0; j<i; j++)		/* copy environment */
+		tmpenv[j] = environ[j];
+	    environ = tmpenv;		/* tell exec where it is now */
+	}
+#ifndef lint
+	else
+	    environ = (char**) saferealloc((char*) environ,
+		(i+2) * sizeof(char*));
+					/* just expand it a bit */
+#endif /* lint */
+	environ[i+1] = Nullch;	/* make sure it's null terminated */
+    }
+    environ[i] = safemalloc(strlen(nam) + strlen(val) + 2);
+					/* this may or may not be in */
+					/* the old environ structure */
+    sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
+}
+
+int
+envix(nam)
+char *nam;
+{
+    register int 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;
+}
diff --git a/gnu/usr.bin/perl/x2p/util.h b/gnu/usr.bin/perl/x2p/util.h
new file mode 100644
index 000000000000..15bf78e53f33
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/util.h
@@ -0,0 +1,53 @@
+/* $RCSfile: util.h,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:10 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:10  nate
+ * PERL!
+ *
+ * Revision 4.0.1.2  91/11/05  19:21:20  lwall
+ * patch11: various portability fixes
+ * 
+ * Revision 4.0.1.1  91/06/07  12:20:43  lwall
+ * patch4: new copyright notice
+ * 
+ * Revision 4.0  91/03/20  01:58:29  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+/* is the string for makedir a directory name or a filename? */
+
+#define fatal Myfatal
+
+#define MD_DIR 0
+#define MD_FILE 1
+
+void	util_init();
+int	doshell();
+char	*safemalloc();
+char	*saferealloc();
+char	*safecpy();
+char	*safecat();
+char	*cpytill();
+char	*cpy2();
+char	*instr();
+#ifdef SETUIDGID
+    int		eaccess();
+#endif
+char	*getwd();
+void	cat();
+void	prexit();
+char	*get_a_line();
+char	*savestr();
+int	makedir();
+void	setenv();
+int	envix();
+void	notincl();
+char	*getval();
+void	growstr();
+void	setdef();
diff --git a/gnu/usr.bin/perl/x2p/walk.c b/gnu/usr.bin/perl/x2p/walk.c
new file mode 100644
index 000000000000..4cc4a79eb07b
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/walk.c
@@ -0,0 +1,2086 @@
+/* $RCSfile: walk.c,v $$Revision: 1.1.1.1 $$Date: 1993/08/23 21:30:11 $
+ *
+ *    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 $
+ * Revision 1.1.1.1  1993/08/23  21:30:11  nate
+ * PERL!
+ *
+ * Revision 4.0.1.3  92/06/08  17:33:46  lwall
+ * patch20: in a2p, simplified the filehandle model
+ * patch20: in a2p, made RS="" translate to $/ = "\n\n"
+ * patch20: in a2p, do {...} while ... was missing some reconstruction code
+ * patch20: in a2p, getline should allow variable to be array element
+ * 
+ * Revision 4.0.1.2  91/11/05  19:25:09  lwall
+ * patch11: in a2p, split on whitespace produced extra null field
+ * 
+ * Revision 4.0.1.1  91/06/07  12:22:04  lwall
+ * patch4: new copyright notice
+ * patch4: a2p didn't correctly implement -n switch
+ * 
+ * Revision 4.0  91/03/20  01:58:36  lwall
+ * 4.0 baseline.
+ * 
+ */
+
+#include "handy.h"
+#include "EXTERN.h"
+#include "util.h"
+#include "a2p.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;
+
+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 */
+    char *index();
+
+    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 (index("*+?.[]()|^$\\",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 (!index(tmpstr->str_ptr,'\'') && !index(tmpstr->str_ptr,'"') &&
+	      !index(tmp2str->str_ptr,'\'') && !index(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 (!index(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 (index("*+?.[]()|^$\\",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 (!index(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 (!index(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 = index(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 = index(tmpstr->str_ptr,'$');
+	if (!d)
+	    fatal("Illegal for loop: %s",tmpstr->str_ptr);
+	s = index(d,'{');
+	if (!s)
+	    s = index(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;
+}
+
+tab(str,lvl)
+register STR *str;
+register int lvl;
+{
+    while (lvl > 1) {
+	str_cat(str,"\t");
+	lvl -= 2;
+    }
+    if (lvl)
+	str_cat(str,"    ");
+}
+
+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);
+}
+
+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,";");
+}
+
+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);
+}
+
+prewalk(numit,level,node,numericptr)
+int numit;
+int level;
+register int node;
+int *numericptr;
+{
+    register int len;
+    register int type;
+    register int i;
+    char *t;
+    char *d, *s;
+    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) > 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;
+}
+
+numericize(node)
+register int node;
+{
+    register int len;
+    register int type;
+    register int i;
+    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);
+    }
+}