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

svn path=/vendor/perl5/dist/; revision=38980
svn path=/vendor/perl5/5.005.02/; revision=38982; tag=vendor/perl5/5.005.02

contrib/perl5/Artistic

@@ -0,0 +1,131 @@
+
+
+
+
+			 The "Artistic License"
+
+				Preamble
+
+The intent of this document is to state the conditions under which a
+Package may be copied, such that the Copyright Holder maintains some
+semblance of artistic control over the development of the package,
+while giving the users of the package the right to use and distribute
+the Package in a more-or-less customary fashion, plus the right to make
+reasonable modifications.
+
+Definitions:
+
+	"Package" refers to the collection of files distributed by the
+	Copyright Holder, and derivatives of that collection of files
+	created through textual modification.
+
+	"Standard Version" refers to such a Package if it has not been
+	modified, or has been modified in accordance with the wishes
+	of the Copyright Holder as specified below.
+
+	"Copyright Holder" is whoever is named in the copyright or
+	copyrights for the package.
+
+	"You" is you, if you're thinking about copying or distributing
+	this Package.
+
+	"Reasonable copying fee" is whatever you can justify on the
+	basis of media cost, duplication charges, time of people involved,
+	and so on.  (You will not be required to justify it to the
+	Copyright Holder, but only to the computing community at large
+	as a market that must bear the fee.)
+
+	"Freely Available" means that no fee is charged for the item
+	itself, though there may be fees involved in handling the item.
+	It also means that recipients of the item may redistribute it
+	under the same conditions they received it.
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications
+derived from the Public Domain or from the Copyright Holder.  A Package
+modified in such a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided
+that you insert a prominent notice in each changed file stating how and
+when you changed that file, and provided that you do at least ONE of the
+following:
+
+    a) place your modifications in the Public Domain or otherwise make them
+    Freely Available, such as by posting said modifications to Usenet or
+    an equivalent medium, or placing the modifications on a major archive
+    site such as uunet.uu.net, or by allowing the Copyright Holder to include
+    your modifications in the Standard Version of the Package.
+
+    b) use the modified Package only within your corporation or organization.
+
+    c) rename any non-standard executables so the names do not conflict
+    with standard executables, which must also be provided, and provide
+    a separate manual page for each non-standard executable that clearly
+    documents how it differs from the Standard Version.
+
+    d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or
+executable form, provided that you do at least ONE of the following:
+
+    a) distribute a Standard Version of the executables and library files,
+    together with instructions (in the manual page or equivalent) on where
+    to get the Standard Version.
+
+    b) accompany the distribution with the machine-readable source of
+    the Package with your modifications.
+
+    c) give non-standard executables non-standard names, and clearly
+    document the differences in manual pages (or equivalent), together
+    with instructions on where to get the Standard Version.
+
+    d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package.  You may charge any fee you choose for support of this
+Package.  You may not charge a fee for this Package itself.  However,
+you may distribute this Package in aggregate with other (possibly
+commercial) programs as part of a larger (possibly commercial) software
+distribution provided that you do not advertise this Package as a
+product of your own.  You may embed this Package's interpreter within
+an executable of yours (by linking); this shall be construed as a mere
+form of aggregation, provided that the complete Standard Version of the
+interpreter is so embedded.
+
+6. The scripts and library files supplied as input to or produced as
+output from the programs of this Package do not automatically fall
+under the copyright of this Package, but belong to whoever generated
+them, and may be sold commercially, and may be aggregated with this
+Package.  If such scripts or library files are aggregated with this
+Package via the so-called "undump" or "unexec" methods of producing a
+binary executable image, then distribution of such an image shall
+neither be construed as a distribution of this Package nor shall it
+fall under the restrictions of Paragraphs 3 and 4, provided that you do
+not represent such an executable image as a Standard Version of this
+Package.
+
+7. C subroutines (or comparably compiled subroutines in other
+languages) supplied by you and linked into this Package in order to
+emulate subroutines and variables of the language defined by this
+Package shall not be considered part of this Package, but are the
+equivalent of input as in Paragraph 6, provided these subroutines do
+not change the language in any way that would cause it to fail the
+regression tests for the language.
+
+8. Aggregation of this Package with a commercial distribution is always
+permitted provided that the use of this Package is embedded; that is,
+when no overt attempt is made to make this Package's interfaces visible
+to the end user of the commercial distribution.  Such use shall not be
+construed as a distribution of this Package.
+
+9. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+				The End

contrib/perl5/Changes5.000

@@ -0,0 +1,185 @@
+-------------
+Version 5.000
+-------------
+
+New things
+----------
+    The -w switch is much more informative.
+
+    References.  See t/op/ref.t for examples.  All entities in Perl 5 are
+    reference counted so that it knows when each item should be destroyed.
+
+    Objects.  See t/op/ref.t for examples.
+
+    => is now a synonym for comma.  This is useful as documentation for
+    arguments that come in pairs, such as initializers for associative arrays,
+    or named arguments to a subroutine.
+
+    All functions have been turned into list operators or unary operators,
+    meaning the parens are optional.  Even subroutines may be called as
+    list operators if they've already been declared.
+
+    More embeddible.  See main.c and embed_h.sh.  Multiple interpreters
+    in the same process are supported (though not with interleaved
+    execution yet).
+
+    The interpreter is now flattened out.  Compare Perl 4's eval.c with
+    the perl 5's pp.c.  Compare Perl 4's 900 line interpreter loop in cmd.c
+    with Perl 5's 1 line interpreter loop in run.c.  Eventually we'll make
+    everything non-blocking so we can interface nicely with a scheduler.
+
+    eval is now treated more like a subroutine call.  Among other things,
+    this means you can return from it.
+
+    Format value lists may be spread over multiple lines by enclosing in
+    a do {} block.
+
+    You may now define BEGIN and END subroutines for each package.  The BEGIN
+    subroutine executes the moment it's parsed.  The END subroutine executes
+    just before exiting.
+
+    Flags on the #! line are interpreted even if the script wasn't
+    executed directly.  (And even if the script was located by "perl -x"!)
+
+    The ?: operator is now legal as an lvalue.
+
+    List context now propagates to the right side of && and ||, as well
+    as the 2nd and 3rd arguments to ?:.
+
+    The "defined" function can now take a general expression.
+
+    Lexical scoping available via "my".  eval can see the current lexical
+    variables.
+
+    The preferred package delimiter is now :: rather than '.
+
+    tie/untie are now preferred to dbmopen/dbmclose.  Multiple DBM
+    implementations are allowed in the same executable, so you can
+    write scripts to interchange data among different formats.
+
+    New "and" and "or" operators work just like && and || but with
+    a precedence lower than comma, so they work better with list operators.
+
+    New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst(),
+    chomp(), glob()
+
+    require with a number checks to see that the version of Perl that is
+    currently running is at least that number.
+
+    Dynamic loading of external modules is now supported.
+
+    There is a new quote form qw//, which is equivalent to split(' ', q//).
+
+    Assignment of a reference to a glob value now just replaces the
+    single element of the glob corresponding to the reference type:
+	*foo = \$bar, *foo = \&bletch;
+
+    Filehandle methods are now supported:
+	output_autoflush STDOUT 1;
+
+    There is now an "English" module that provides human readable translations
+    for cryptic variable names.
+
+    Autoload stubs can now call the replacement subroutine with goto &realsub.
+
+    Subroutines can be defined lazily in any package by declaring an AUTOLOAD
+    routine, which will be called if a non-existent subroutine is called in
+    that package.
+
+    Several previously added features have been subsumed under the new
+    keywords "use" and "no".  Saying "use Module LIST" is short for
+	BEGIN { require Module; import Module LIST; }
+    The "no" keyword is identical except that it calls "unimport" instead.
+    The earlier pragma mechanism now uses this mechanism, and two new
+    modules have been added to the library to implement "use integer"
+    and variations of "use strict vars, refs, subs".
+
+    Variables may now be interpolated literally into a pattern by prefixing
+    them with \Q, which works just like \U, but backwhacks non-alphanumerics
+    instead.  There is also a corresponding quotemeta function.
+
+    Any quantifier in a regular expression may now be followed by a ? to
+    indicate that the pattern is supposed to match as little as possible.
+
+    Pattern matches may now be followed by an m or s modifier to explicitly
+    request multiline or singleline semantics.  An s modifier makes . match
+    newline.
+
+    Patterns may now contain \A to match only at the beginning of the string,
+    and \Z to match only at the end.  These differ from ^ and $ in that
+    they ignore multiline semantics.  In addition, \G matches where the
+    last interation of m//g or s///g left off.
+
+    Non-backreference-producing parens of various sorts may now be
+    indicated by placing a ? directly after the opening parenthesis,
+    followed by a character that indicates the purpose of the parens.
+    An :, for instance, indicates simple grouping.  (?:a|b|c) will
+    match any of a, b or c without producing a backreference.  It does
+    "eat" the input.  There are also assertions which do not eat the
+    input but do lookahead for you.  (?=stuff) indicates that the next
+    thing must be "stuff".  (?!nonsense) indicates that the next thing
+    must not be "nonsense".
+
+    The negation operator now treats non-numeric strings specially.
+    A -"text" is turned into "-text", so that -bareword is the same
+    as "-bareword".  If the string already begins with a + or -, it
+    is flipped to the other sign.
+
+Incompatibilities
+-----------------
+    @ now always interpolates an array in double-quotish strings.  Some programs
+    may now need to use backslash to protect any @ that shouldn't interpolate.
+
+    Ordinary variables starting with underscore are no longer forced into
+    package main.
+
+    s'$lhs'$rhs' now does no interpolation on either side.  It used to
+    interplolate $lhs but not $rhs.
+
+    The second and third arguments of splice are now evaluated in scalar
+    context (like the book says) rather than list context.
+
+    Saying "shift @foo + 20" is now a semantic error because of precedence.
+
+    "open FOO || die" is now incorrect.  You need parens around the filehandle.
+
+    The elements of argument lists for formats are now evaluated in list
+    context.  This means you can interpolate list values now.
+
+    You can't do a goto into a block that is optimized away.  Darn.
+
+    It is no longer syntactically legal to use whitespace as the name
+    of a variable, or as a delimiter for any kind of quote construct.
+
+    Some error messages will be different.
+
+    The caller function now returns a false value in a scalar context if there
+    is no caller.  This lets library files determine if they're being required.
+
+    m//g now attaches its state to the searched string rather than the
+    regular expression.
+
+    "reverse" is no longer allowed as the name of a sort subroutine.
+
+    taintperl is no longer a separate executable.  There is now a -T
+    switch to turn on tainting when it isn't turned on automatically.
+
+    Symbols starting with _ are no longer forced into package main, except
+    for $_ itself (and @_, etc.).
+
+    Double-quoted strings may no longer end with an unescaped $ or @.
+
+    Negative array subscripts now count from the end of the array.
+
+    The comma operator in a scalar context is now guaranteed to give a
+    scalar context to its arguments.
+
+    The ** operator now binds more tightly than unary minus.
+
+    Setting $#array lower now discards array elements so that destructors
+    work reasonably.
+
+    delete is not guaranteed to return the old value for tied arrays,
+    since this capability may be onerous for some modules to implement.
+
+    Attempts to set $1 through $9 now result in a run-time error.

contrib/perl5/Changes5.003

@@ -0,0 +1,100 @@
+-------------
+Version 5.003
+-------------
+
+		  ***>  IMPORTANT NOTICE:  <***
+The main reason for this release was to fix a security bug affecting
+suidperl on some systems.  If you build suidperl on your system, it
+is strongly recommended that you replace any existing copies with
+version 5.003 or later immediately.
+
+The changes in 5.003 have been held to a minimum, in the hope that this
+will simplify installation and testing at sites which may be affected
+by the security hole in suidperl.  In brief, 5.003 does the following:
+
+- Plugs security hole in suidperl mechanism on affected systems
+
+- MakeMaker was also updated to version 5.34, and extension Makefile.PLs
+  were modified to match it.
+
+- The following hints files were updated: bsdos.sh, hpux.sh, linux.sh,
+  machten.sh, solaris_2.sh
+
+- A fix was added to installperl to insure that file permissions were
+  set correctly for the installed C header files.
+
+- t/op/stat.t was modified to work around MachTen's belief that /dev/null
+  is a terminal device.
+
+- Incorporation of Perl version information into the VMS' version of
+  config.h was changed to make it compatible with the older VAXC.
+
+- Minor fixes were made to VMS-specific C code, and the routine
+  VMS::Filespec::rmsexpand was added.
+
+----------------
+Version 5.002_01
+----------------
+
+- The EMBED namespace changes are now used by default, in order to better
+  segregate Perl's C global symbols from those belonging to embedding
+  applications or to libraries.  This makes it necessary to rebuild dynamic
+  extensions built under previous versions of Perl without the EMBED option.
+  The default use of EMBED can be overridden by placing -DNO_EMBED on the
+  cc command line.
+
+  The EMBED change is the beginning of a general cleanup of C global
+  symbols used by Perl, so binary compatibility with previously
+  compiled dynamic extensions may be broken again in the next few
+  releases.
+
+- Several bugs in the core were fixed, including the following:
+   - made sure FILE * for -e temp file was closed only once
+   - improved form of single-statement macro definitions to keep
+     as many ccs as possible happy
+   - fixed file tests to insure that signed values were used when
+     computing differences between times.
+   - fixed toke.c so implicit loop isn't doubled when perl is
+     invoked with both the -p and -n switches
+
+- The new SUBVERSION number has been included in the default value for
+  architecture-specific library directories, so development and
+  production architecture-dependent libraries can coexist.
+
+- Two new magic variables, $^E and $^O, have been added.  $^E contains the
+  OS-specific equivalent of $!.  $^O contains the name of the operating
+  system, in order to make it easily available to Perl code whose behavior
+  differs according to its environment.  The standard library files have
+  been converted to use $^O in preference to $Config{'osname'}.
+
+- A mechanism was added to allow listing of locally applied patches
+  in the output of perl -v.
+
+- Miscellaneous minor corrections and updates were made to the documentation.
+
+- Extensive updates were made to the OS/2 and VMS ports
+
+- The following hints file were updated: bsdos.sh, dynixptx.sh,
+  irix_6_2.sh, linux.sh, os2.sh
+
+- Several changes were made to standard library files:
+   - reduced use of English.pm and $`, $', and $& in library modules,
+     since these degrade module loading and evaluation of regular expressions,
+     respectively.
+   - File/Basename.pm: Added path separator to dirname('.')
+   - File/Copy.pm: Added support for VMS and OS/2 system-level copy
+   - MakeMaker updated to v5.26
+   - Symbol.pm now accepts old (') and new (::) package delimiters
+   - Sys/Syslog.pm uses Sys::Hostname only when necessary
+   - chat2.pl picks up necessary constants from socket.ph
+   - syslog.pl: Corrected thinko 'Socket' --> 'Syslog'
+   - xsubpp updated to v1.935
+
+
+- The perlbug utility is now more cautious about sending mail, in order
+  to reduce the chance of accidentally send a bug report by giving the
+  wrong response to a prompt.
+
+- The -m switch has been added to perldoc, causing it to display the 
+  Perl code in target file as well as any documentation.
+

contrib/perl5/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!

contrib/perl5/EXTERN.h

@@ -0,0 +1,53 @@
+/*    EXTERN.h
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * EXT  designates a global var which is defined in perl.h
+ * dEXT designates a global var which is defined in another
+ *      file, so we can't count on finding it in perl.h
+ *      (this practice should be avoided).
+ */
+#undef EXT
+#undef dEXT
+#undef EXTCONST
+#undef dEXTCONST
+#if defined(VMS) && !defined(__GNUC__)
+    /* Suppress portability warnings from DECC for VMS-specific extensions */
+#  ifdef __DECC
+#    pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+#  endif
+#  define EXT globalref
+#  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#  define EXTCONST globalref
+#  define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
+#else
+#  if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) && !defined(PERL_OBJECT)
+#    ifdef PERLDLL
+#      define EXT extern __declspec(dllexport)
+#      define dEXT 
+#      define EXTCONST extern __declspec(dllexport) const
+#      define dEXTCONST const
+#    else
+#      define EXT extern __declspec(dllimport)
+#      define dEXT 
+#      define EXTCONST extern __declspec(dllimport) const
+#      define dEXTCONST const
+#    endif
+#  else
+#    define EXT extern
+#    define dEXT
+#    define EXTCONST extern const
+#    define dEXTCONST const
+#  endif
+#endif
+
+#undef INIT
+#define INIT(x)
+
+#undef DOINIT

contrib/perl5/INTERN.h

@@ -0,0 +1,46 @@
+/*    INTERN.h
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * EXT  designates a global var which is defined in perl.h
+ * dEXT designates a global var which is defined in another
+ *      file, so we can't count on finding it in perl.h
+ *      (this practice should be avoided).
+ */
+#undef EXT
+#undef dEXT
+#undef EXTCONST
+#undef dEXTCONST
+#if defined(VMS) && !defined(__GNUC__)
+    /* Suppress portability warnings from DECC for VMS-specific extensions */
+#  ifdef __DECC
+#    pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT)
+#  endif
+#  define EXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#  define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
+#  define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
+#else
+#  ifdef __cplusplus
+#   define EXT
+#   define dEXT
+#   define EXTCONST extern const
+#   define dEXTCONST const
+#else
+#  define EXT
+#  define dEXT
+#  define EXTCONST const
+#  define dEXTCONST const
+#endif
+#endif
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT

contrib/perl5/Makefile.SH

@@ -0,0 +1,646 @@
+#! /bin/sh
+case $CONFIG in
+'')
+	if test -f config.sh; then TOP=.;
+	elif test -f ../config.sh; then TOP=..;
+	elif test -f ../../config.sh; then TOP=../..;
+	elif test -f ../../../config.sh; then TOP=../../..;
+	elif test -f ../../../../config.sh; then TOP=../../../..;
+	else
+		echo "Can't find config.sh."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+
+case "$d_dosuid" in
+*define*) suidperl='suidperl' ;;
+*) suidperl='';;
+esac
+
+linklibperl='$(LIBPERL)'
+shrpldflags='$(LDDLFLAGS)'
+ldlibpth=''
+case "$useshrplib" in
+true)
+	# Prefix all runs of 'miniperl' and 'perl' with 
+	# $ldlibpth so that ./perl finds *this* libperl.so.
+	ldlibpth="LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH"
+
+	pldlflags="$cccdlflags"
+	# NeXT-4 specific stuff.  Can't we do this in the hint file?
+	case "${osname}${osvers}" in
+	next4*)
+		ld=libtool
+		lddlflags="-dynamic -undefined warning -framework System \
+		-compatibility_version 1 -current_version $patchlevel \
+		-prebind -seg1addr 0x27000000 -install_name \$(shrpdir)/\$@"
+		# NeXT uses a different name.
+		ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH"
+		;;
+	os2*)	# OS/2 doesn't need anything special for LD_LIBRARY_PATH.
+		ldlibpth=''
+		;;
+	sunos*|freebsd[23]*|netbsd*)
+		linklibperl="-lperl"
+		;;
+	aix*)
+		shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
+		case "$osvers" in
+		3*)
+			shrpldflags="$shrpldflags -e _nostart $ldflags $libs $cryptlib"
+			;;
+		*)
+			shrpldflags="$shrpldflags -b noentry $ldflags $libs $cryptlib"
+			;;
+		esac
+		aixinstdir=`pwd | sed 's/\/UU$//'`
+		linklibperl="-L $archlibexp/CORE -L $aixinstdir -lperl"
+		;;
+	hpux10*)
+		linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+b$archlibexp/CORE -lperl"
+		;;
+	esac
+	;;
+*)	pldlflags=''
+	;;
+esac
+
+: Prepare dependency lists for Makefile.
+dynamic_list=' '
+for f in $dynamic_ext; do
+    : the dependency named here will never exist
+      base=`echo "$f" | sed 's/.*\///'`
+    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
+done
+
+static_list=' '
+for f in $static_ext; do
+	base=`echo "$f" | sed 's/.*\///'`
+	static_list="$static_list lib/auto/$f/$base\$(LIB_EXT)"
+done
+
+nonxs_list=' '
+for f in $nonxs_ext; do
+    base=`echo "$f" | sed 's/.*\///'`
+    nonxs_list="$nonxs_list ext/$f/pm_to_blib"
+done
+
+echo "Extracting Makefile (with variable substitutions)"
+$spitshell >Makefile <<!GROK!THIS!
+# Makefile.SH
+# This file is derived from Makefile.SH.  Any changes made here will
+# be lost the next time you run Configure.
+#  Makefile is used to generate $firstmakefile.  The only difference
+#  is that $firstmakefile has the dependencies filled in at the end.
+#
+#
+# I now supply perly.c with the kits, so don't remake perly.c without byacc
+BYACC = $byacc
+CC = $cc
+LD = $ld
+
+LDFLAGS = $ldflags
+CLDFLAGS = $ldflags
+
+SMALL = $small
+LARGE = $large $split
+mallocsrc = $mallocsrc
+mallocobj = $mallocobj
+LNS = $lns
+RMS = rm -f
+ranlib = $ranlib
+
+# The following are mentioned only to make metaconfig include the
+# appropriate questions in Configure.  If you want to change these,
+# edit config.sh instead, or specify --man1dir=/wherever on
+# installman commandline.
+bin = $installbin
+scriptdir = $scriptdir
+shrpdir = $archlibexp/CORE
+privlib = $installprivlib
+man1dir = $man1dir
+man1ext = $man1ext
+man3dir = $man3dir
+man3ext = $man3ext
+
+# The following are used to build and install shared libraries for
+# dynamic loading.
+LDDLFLAGS = $lddlflags
+SHRPLDFLAGS = $shrpldflags
+CCDLFLAGS = $ccdlflags
+DLSUFFIX = .$dlext
+PLDLFLAGS = $pldlflags
+LIBPERL = $libperl
+LLIBPERL= $linklibperl
+SHRPENV = $shrpenv
+
+# The following is used to include the current directory in
+# LD_LIBRARY_PATH if you are building a shared libperl.so.
+LDLIBPTH = $ldlibpth
+
+dynamic_ext = $dynamic_list
+static_ext = $static_list
+nonxs_ext = $nonxs_list
+ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext)
+DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT)
+
+libs = $libs $cryptlib
+
+public = perl $suidperl utilities translators
+
+shellflags = $shellflags
+
+# This is set to  MAKE=$make if your $make command doesn't
+# do it for you.
+$make_set_make
+
+# These variables may need to be manually set for non-Unix systems.
+AR = $ar
+EXE_EXT = $_exe
+LIB_EXT = $_a
+OBJ_EXT = $_o
+PATH_SEP = $p_
+
+FIRSTMAKEFILE = $firstmakefile
+
+# Any special object files needed by this architecture, e.g. os2/os2.obj
+ARCHOBJS = $archobjs
+
+.SUFFIXES: .c \$(OBJ_EXT)
+
+# grrr
+SHELL = $sh
+
+# how to tr(anslate) newlines
+TRNL = '$trnl'
+
+!GROK!THIS!
+
+## In the following dollars and backticks do not need the extra backslash.
+$spitshell >>Makefile <<'!NO!SUBS!'
+
+CCCMD = `sh $(shellflags) cflags $(LIBPERL) $@`
+
+private = preplibrary lib/ExtUtils/Miniperl.pm lib/Config.pm
+
+# Files to be built with variable substitution before miniperl
+# is available.
+sh = Makefile.SH cflags.SH config_h.SH makeaperl.SH makedepend.SH \
+	makedir.SH perl_exp.SH writemain.SH
+
+shextract = Makefile cflags config.h makeaperl makedepend \
+	makedir perl.exp writemain
+
+# Files to be built with variable substitution after miniperl is
+# available.  Dependencies handled manually below (for now).
+
+pl = pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL
+
+plextract = pod/pod2html pod/pod2latex pod/pod2man pod/pod2text
+
+addedbyconf = UU $(shextract) $(plextract) pstruct
+
+h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
+h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
+h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
+h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h
+h5 = bytecode.h byterun.h
+h = $(h1) $(h2) $(h3) $(h4) $(h5)
+
+c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c
+c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c
+c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c globals.c perlio.c
+
+c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c
+
+obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) byterun$(OBJ_EXT)
+obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
+obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT)
+
+obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
+
+# Once perl has been Configure'd and built ok you build different
+# perl variants (Debugging, Embedded, Multiplicity etc) by saying:
+#	make clean; make LIBPERL=libperl<type>.a
+# where <type> is some combination of 'd' and(or) 'e' or 'm'.
+# See cflags to understand how this works.
+#
+# This mechanism is getting clunky and might not even work any more.
+# EMBEDDING is on by default, and MULTIPLICITY doesn't work.
+#
+
+lintflags = -hbvxac
+
+.c$(OBJ_EXT):
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext) $(nonxs_ext)
+	@echo " ";
+	@echo "	Everything is up to date. 'make test' to run test suite."
+
+compile: all
+	echo "testing compilation" > testcompile;
+	cd utils;  $(MAKE) compile;
+	cd x2p; $(MAKE) compile; 
+	cd pod; $(MAKE) compile;
+
+translators:	miniperl lib/Config.pm FORCE
+	@echo " "; echo "	Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all
+
+utilities:	miniperl lib/Config.pm FORCE
+	@echo " "; echo "	Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all
+
+
+# This is now done by installman only if you actually want the man pages.
+#	@echo " "; echo "	Making docs"; cd pod; $(MAKE) all;
+
+# Phony target to force checking subdirectories.
+# Apparently some makes require an action for the FORCE target.
+FORCE:
+	@sh -c true
+
+miniperlmain$(OBJ_EXT): miniperlmain.c
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+perlmain.c: miniperlmain.c config.sh $(FIRSTMAKEFILE)
+	sh writemain $(DYNALOADER) $(static_ext) > tmp
+	sh mv-if-diff tmp perlmain.c
+
+perlmain$(OBJ_EXT): perlmain.c
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+# The file ext.libs is a list of libraries that must be linked in
+# for static extensions, e.g. -lm -lgdbm, etc.  The individual
+# static extension Makefile's add to it.
+ext.libs: $(static_ext)
+	-@test -f ext.libs || touch ext.libs
+
+!NO!SUBS!
+
+# How to build libperl.  This is still rather convoluted.
+# Load up custom Makefile.SH fragment for shared loading and executables:
+if test -r $osname/Makefile.SHs ; then
+	. $osname/Makefile.SHs
+	$spitshell >>Makefile <<!GROK!THIS!
+
+Makefile: $osname/Makefile.SHs
+!GROK!THIS!
+else
+	$spitshell >>Makefile <<'!NO!SUBS!'
+$(LIBPERL): $& perl$(OBJ_EXT) $(obj)
+!NO!SUBS!
+	case "$useshrplib" in
+	true)
+		$spitshell >>Makefile <<'!NO!SUBS!'
+	$(LD) $(SHRPLDFLAGS) -o $@ perl$(OBJ_EXT) $(obj)
+!NO!SUBS!
+		case "$osname" in
+		aix)
+			$spitshell >>Makefile <<'!NO!SUBS!'
+	rm -f libperl$(OBJ_EXT)
+	mv $@ libperl$(OBJ_EXT)
+	$(AR) qv $(LIBPERL) libperl$(OBJ_EXT)
+!NO!SUBS!
+			;;
+		esac
+		;;
+	*)
+		$spitshell >>Makefile <<'!NO!SUBS!'
+	rm -f $(LIBPERL)
+	$(AR) rcu $(LIBPERL) perl$(OBJ_EXT) $(obj)
+	@$(ranlib) $(LIBPERL)
+!NO!SUBS!
+		;;
+	esac
+	$spitshell >>Makefile <<'!NO!SUBS!'
+
+# How to build executables.
+
+# The $& notation tells Sequent machines that it can do a parallel make,
+# and is harmless otherwise.
+# The miniperl -w -MExporter line is a basic cheap test to catch errors
+# before make goes on to run preplibrary and then MakeMaker on extensions.
+# This is very handy because later errors are often caused by miniperl
+# build problems but that's not obvious to the novice.
+# The Module used here must not depend on Config or any extensions.
+
+miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)
+	$(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs)
+	$(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
+
+perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(LDLIBPTH) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(LDLIBPTH) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(LDLIBPTH) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+# This version, if specified in Configure, does ONLY those scripts which need
+# set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
+# checks as well as the special code to validate that the script in question
+# has been invoked correctly.
+
+suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+!NO!SUBS!
+
+fi
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+
+sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h)
+	$(RMS) sperl.c
+	$(LNS) perl.c sperl.c
+	$(CCCMD) -DIAMSUID sperl.c
+	$(RMS) sperl.c
+
+# We have to call our ./makedir because Ultrix 4.3 make can't handle the line
+#	test -d lib/auto || mkdir lib/auto
+#
+preplibrary: miniperl lib/Config.pm $(plextract)
+	@sh ./makedir lib/auto
+	@echo "	AutoSplitting perl library"
+	$(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \
+		autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm
+
+# Take care to avoid modifying lib/Config.pm without reason
+# (If trying to create a new port and having problems with the configpm script, 
+# try 'make minitest' and/or commenting out the tests at the end of configpm.)
+lib/Config.pm: config.sh miniperl configpm
+	$(LDLIBPTH) ./miniperl configpm tmp
+	sh mv-if-diff tmp $@
+
+lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm
+	$(LDLIBPTH) ./miniperl minimod.pl > tmp
+	sh mv-if-diff tmp $@
+
+lib/re.pm: ext/re/re.pm
+	rm -f $@
+	cat ext/re/re.pm > $@
+
+$(plextract):	miniperl lib/Config.pm lib/re.pm
+	$(LDLIBPTH) ./miniperl -Ilib $@.PL
+	
+install: all install.perl install.man
+
+install.perl:	all installperl
+	if [ -n "$(COMPILE)" ]; \
+	then \
+		cd utils; $(MAKE) compile; \
+		cd ../x2p; $(MAKE) compile; \
+		cd ../pod; $(MAKE) compile; \
+	else :; \
+	fi
+	$(LDLIBPTH) ./perl installperl
+
+install.man:	all installman
+	$(LDLIBPTH) ./perl installman
+
+# XXX Experimental. Hardwired values, but useful for testing.
+# Eventually Configure could ask for some of these values.
+install.html: all installhtml
+	$(LDLIBPTH) ./perl installhtml                   \
+      --podroot=. --podpath=. --recurse  \
+      --htmldir=$(privlib)/html     \
+      --htmlroot=$(privlib)/html    \
+      --splithead=pod/perlipc     \
+      --splititem=pod/perlfunc    \
+      --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \
+      --verbose
+
+
+# I now supply perly.c with the kits, so the following section is
+# used only if you force byacc to run by saying
+# 	make run_byacc
+# Since we patch up the byacc output, the perly.fixer script needs
+# to run with precisely the same version of byacc as I use.  You
+# normally shouldn't remake perly.[ch].
+
+run_byacc:	FORCE
+	@ echo 'Expect' 113 shift/reduce and 1 reduce/reduce conflict
+	$(BYACC) -d perly.y
+	chmod 664 perly.c
+	sh $(shellflags) ./perly.fixer y.tab.c perly.c
+	sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
+	    -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c
+	echo 'extern YYSTYPE yylval;' >>y.tab.h
+	cmp -s y.tab.h perly.h && rm -f y.tab.h || mv y.tab.h perly.h
+	chmod 664 vms/perly_c.vms vms/perly_h.vms
+	perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
+
+# We don't want to regenerate perly.c and perly.h, but they might
+# appear out-of-date after a patch is applied or a new distribution is
+# made.
+perly.c: perly.y
+	-@sh -c true
+
+perly.h: perly.y
+	-@sh -c true
+
+# No compat3.sym here since and including the 5.004_50.
+SYM  = global.sym interp.sym perlio.sym thread.sym
+
+SYMH = perlvars.h thrdvar.h
+
+# The following files are generated automatically
+#	keywords.h:	keywords.pl
+#	opcode.h:	opcode.pl
+#	embed.h:  	embed.pl global.sym interp.sym
+#	byterun.h:	bytecode.pl
+#	byterun.c:	bytecode.pl
+#	lib/B/Asmdata.pm:	bytecode.pl
+#	regnodes.h:	regcomp.pl
+# The correct versions should be already supplied with the perl kit,
+# in case you don't have perl available.
+# To force them to run, type
+#	make regen_headers
+regen_headers:	FORCE
+	perl keywords.pl
+	perl opcode.pl
+	perl embed.pl
+	perl bytecode.pl
+	perl regcomp.pl
+
+# Extensions:
+# Names added to $(dynamic_ext) or $(static_ext) or $(nonxs_ext) will
+# automatically get built.  There should ordinarily be no need to change
+# any of this part of makefile.
+#
+# The dummy dependency is a place holder in case $(dynamic_ext) or
+# $(static_ext) is empty.
+#
+# DynaLoader may be needed for extensions that use Makefile.PL.
+
+$(DYNALOADER):	miniperl preplibrary FORCE
+	@$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+
+d_dummy $(dynamic_ext):	miniperl preplibrary $(DYNALOADER) FORCE
+	@$(LDLIBPTH) sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+
+s_dummy $(static_ext):	miniperl preplibrary $(DYNALOADER) FORCE
+	@$(LDLIBPTH) sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+
+n_dummy $(nonxs_ext):	miniperl preplibrary $(DYNALOADER) FORCE
+	@$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+
+clean:		_tidy _mopup
+
+realclean:	_cleaner _mopup
+	@echo "Note that make realclean does not delete config.sh or Policy.sh"
+
+clobber:	_cleaner _mopup
+	rm -f config.sh cppstdin Policy.sh
+
+distclean:	clobber
+
+# Do not 'make _mopup' directly.
+_mopup:
+	rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c
+	rm -f perl.exp ext.libs
+	-rm -f perl.export perl.dll perl.libexp perl.map perl.def
+	rm -f perl suidperl miniperl $(LIBPERL)
+
+# Do not 'make _tidy' directly.
+_tidy:
+	-cd pod; $(MAKE) clean
+	-cd utils; $(MAKE) clean
+	-cd x2p; $(MAKE) clean
+	-@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
+	sh ext/util/make_ext clean $$x MAKE=$(MAKE) ; \
+	done
+	rm -f testcompile compilelog
+
+# Do not 'make _cleaner' directly.
+_cleaner:
+	-cd os2; rm -f Makefile
+	-cd pod; $(MAKE) realclean
+	-cd utils; $(MAKE) realclean
+	-cd x2p; $(MAKE) realclean
+	-@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
+	sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \
+	done
+	rm -f *.orig */*.orig *~ */*~ core t/core t/c t/perl
+	rm -rf $(addedbyconf)
+	rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old
+	rm -f $(private)
+	rm -rf lib/auto
+	rm -f lib/.exists
+	rm -f h2ph.man pstruct
+	rm -rf .config
+	rm -f testcompile compilelog
+
+# The following lint has practically everything turned on.  Unfortunately,
+# you have to wade through a lot of mumbo jumbo that can't be suppressed.
+# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
+# for that spot.
+
+lint: perly.c $(c)
+	lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz
+
+# Need to unset during recursion to go out of loop.
+# The README below ensures that the dependency list is never empty and
+# that when MAKEDEPEND is empty $(FIRSTMAKEFILE) doesn't need rebuilding.
+
+MAKEDEPEND = Makefile makedepend
+
+$(FIRSTMAKEFILE):	README $(MAKEDEPEND)
+	$(MAKE) depend MAKEDEPEND=
+
+config.h: config_h.SH config.sh
+	$(SHELL) config_h.SH
+
+# This is an AIXism.
+perl.exp: perl_exp.SH config.sh $(SYM) $(SYMH)
+	$(SHELL) perl_exp.SH
+
+# When done, touch perlmain.c so that it doesn't get remade each time.
+depend: makedepend
+	sh ./makedepend MAKE=$(MAKE)
+	- test -s perlmain.c && touch perlmain.c
+	cd x2p; $(MAKE) depend
+
+# Cannot postpone this until $firstmakefile is ready ;-)
+makedepend: makedepend.SH config.sh
+	sh ./makedepend.SH
+
+test-prep: miniperl perl preplibrary utilities $(dynamic_ext) $(nonxs_ext)
+	cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT))
+
+test check: test-prep
+	cd t && $(LDLIBPTH) ./perl TEST </dev/tty
+
+# For testing without a tty or controling terminal. See t/op/stat.t
+test-notty: test-prep
+	cd t && PERL_SKIP_TTY_TEST=1 $(LDLIBPTH) ./perl TEST
+
+# Can't depend on lib/Config.pm because that might be where miniperl
+# is crashing.
+minitest: miniperl lib/re.pm
+	@echo "You may see some irrelevant test failures if you have been unable"
+	@echo "to build lib/Config.pm."
+	- cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \
+		&& $(LDLIBPTH) ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t </dev/tty
+
+# Handy way to run perlbug -ok without having to install and run the
+# installed perlbug. We don't re-run the tests here - we trust the user.
+# Please *don't* use this unless all tests pass.
+# If you want to report test failures, use "make nok" instead.
+ok:	utilities
+	$(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
+
+okfile:	utilities
+	$(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
+
+nok:	utilities
+	$(LBLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)'
+
+clist:	$(c)
+	echo $(c) | tr ' ' $(TRNL) >.clist
+
+hlist:  $(h)
+	echo $(h) | tr ' ' $(TRNL) >.hlist
+
+shlist: $(sh)
+	echo $(sh) | tr ' ' $(TRNL) >.shlist
+
+pllist: $(pl)
+	echo $(pl) | tr ' ' $(TRNL) >.pllist
+
+Makefile: Makefile.SH ./config.sh
+	$(SHELL) Makefile.SH
+
+distcheck: FORCE
+	perl '-MExtUtils::Manifest=&fullcheck' -e 'fullcheck()'
+
+elc:	emacs/cperl-mode.elc
+
+emacs/cperl-mode.elc: emacs/cperl-mode.el
+	-cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el
+
+etags:	emacs/cperl-mode.elc
+	sh emacs/ptags
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+# If this runs make out of memory, delete /usr/include lines.
+!NO!SUBS!
+
+$eunicefix Makefile
+case `pwd` in
+*SH)
+    $rm -f ../Makefile
+    $ln Makefile ../Makefile
+    ;;
+esac
+$rm -f $firstmakefile

contrib/perl5/Policy_sh.SH

@@ -0,0 +1,153 @@
+case $CONFIG in
+'') . ./config.sh ;;
+esac
+echo "Extracting Policy.sh (with variable substitutions)"
+$spitshell <<!GROK!THIS! >Policy.sh
+$startsh
+#
+#  This file was produced by running the Policy_sh.SH script, which
+#  gets its values from config.sh, which is generally produced by
+#  running Configure.  The Policy.sh file gets overwritten each time
+#  Configure is run.  Any variables you add to Policy.sh will be lost
+#  unless you copy Policy.sh somewhere else before running Configure.
+#
+#  The idea here is to distill in one place the common site-wide
+#  "policy" answers (such as installation directories) that are
+#  to be "sticky".  If you keep the file Policy.sh around in
+#  the same directory as you are building Perl, then Configure will
+#  (by default) load up the Policy.sh file just before the
+#  platform-specific hints file.
+#
+
+#  Allow Configure command-line overrides; usually these won't be
+#  needed, but something like -Dprefix=/test/location can be quite
+#  useful for testing out new versions.
+
+#Site-specific values:
+
+case "\$perladmin" in
+'') perladmin='$perladmin' ;;
+esac
+
+# Installation prefix.  Allow a Configure -D override.  You
+# may wish to reinstall perl under a different prefix, perhaps
+# in order to test a different configuration.
+case "\$prefix" in
+'') prefix='$prefix' ;;
+esac
+
+# Installation directives.  Note that each one comes in three flavors.
+# For example, we have privlib, privlibexp, and installprivlib.
+# privlib is for private (to perl) library files.
+# privlibexp is the same, except any '~' the user gave to Configure
+#     is expanded to the user's home directory.  This is figured
+#     out automatically by Configure, so you don't have to include it here.
+# installprivlib is for systems (such as those running AFS) that
+#     need to distinguish between the place where things
+#     get installed and where they finally will reside.
+# 
+# In each case, if your previous value was the default, leave it commented
+# out.  That way, if you override prefix, all of these will be
+# automatically adjusted.
+#
+# WARNING:  Be especially careful about architecture-dependent and
+# version-dependent names, particularly if you reuse this file for
+# different versions of perl.
+
+!GROK!THIS!
+
+for var in bin scriptdir privlib archlib \
+	man1dir man3dir sitelib sitearch \
+	installbin installscript installprivlib installarchlib \
+	installman1dir installman3dir installsitelib installsitearch \
+	man1ext man3ext; do
+	
+    case "$var" in
+    bin)	dflt=$prefix/bin ;;
+    # The scriptdir test is more complex, but this is probably usually ok.
+    scriptdir)
+	if $test -d $prefix/script; then
+	    dflt=$prefix/script
+	else
+	    dflt=$bin
+	fi
+	;;
+    privlib)
+	case "$prefix" in
+	*perl*)	dflt=$prefix/lib/$version ;;
+	*)	dflt=$prefix/lib/$package/$version ;;
+	esac
+	;;
+    archlib)	
+	case "$prefix" in
+	*perl*)	dflt=$prefix/lib/$version/$archname ;;
+	*)	dflt=$prefix/lib/$package/$version/$archname ;;
+	esac
+	;;
+    sitelib)
+	case "$prefix" in
+	*perl*)	dflt=$prefix/lib/site_perl/$apiversion ;;
+	*)	dflt=$prefix/lib/$package/site_perl/$apiversion ;;
+	esac
+	;;
+    sitearch)	
+	case "$prefix" in
+	*perl*)	dflt=$prefix/lib/site_perl/$apiversion/$archname ;;
+	*)	dflt=$prefix/lib/$package/site_perl/$apiversion/$archname ;;
+	esac
+	;;
+    man1dir)	dflt="$prefix/man/man1" ;;
+    man3dir)
+	case "$prefix" in
+	*perl*) dflt=`echo $man1dir |
+		    sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;;
+	*)	dflt=$privlib/man/man3 ;;
+	esac
+	;;
+
+    # Can we assume all sed's have greedy matching?
+    man1ext)	dflt=`echo $man1dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;;
+    man3ext)	dflt=`echo $man3dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;;
+
+    # It might be possible to fool these next tests.  Please let
+    # me know if they don't work right for you.
+    installbin)		dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;;
+    installscript)	dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;;
+    installprivlib)	dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;;
+    installarchlib)	dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;;
+    installsitelib)	dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
+    installsitearch)	dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;;
+    installman1dir)	dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;;
+    installman3dir)	dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;;
+    esac
+    
+    eval val="\$$var"
+    if test X"$val" = X"$dflt"; then
+	echo "# $var='$dflt'"
+    else
+	echo "# Preserving custom $var"
+	echo "$var='$val'"
+    fi
+
+done >> Policy.sh
+
+$spitshell <<!GROK!THIS! >>Policy.sh
+
+#  Lastly, you may add additional items here.  For example, to set the
+#  pager to your local favorite value, uncomment the following line in
+#  the original Policy_sh.SH file and re-run   sh Policy_sh.SH.
+#
+#  pager='$pager'
+#
+#  A full Glossary of all the config.sh variables is in the file
+#  Porting/Glossary.
+
+!GROK!THIS!
+
+#Credits:
+#   The original design for this Policy.sh file came from Wayne Davison,
+#   maintainer of trn.
+#   This version for Perl5.004_61 originally written by
+#   Andy Dougherty <doughera@lafcol.lafayette.edu>.
+#   This file may be distributed under the same terms as Perl itself.
+

contrib/perl5/Porting/Contract

@@ -0,0 +1,108 @@
+
+                     Contributed Modules in Perl Core
+                 A Social Contract about Artistic Control
+
+What follows is a statement about artistic control, defined as the ability
+of authors of packages to guide the future of their code and maintain
+control over their work.  It is a recognition that authors should have
+control over their work, and that it is a responsibility of the rest of
+the Perl community to ensure that they retain this control.  It is an
+attempt to document the standards to which we, as Perl developers, intend
+to hold ourselves.  It is an attempt to write down rough guidelines about
+the respect we owe each other as Perl developers.
+
+This statement is not a legal contract.  This statement is not a legal
+document in any way, shape, or form.  Perl is distributed under the GNU
+Public License and under the Artistic License; those are the precise legal
+terms.  This statement isn't about the law or licenses.  It's about
+community, mutual respect, trust, and good-faith cooperation.
+
+We recognize that the Perl core, defined as the software distributed with
+the heart of Perl itself, is a joint project on the part of all of us.
+>From time to time, a script, module, or set of modules (hereafter referred
+to simply as a "module") will prove so widely useful and/or so integral to
+the correct functioning of Perl itself that it should be distributed with
+Perl core.  This should never be done without the author's explicit
+consent, and a clear recognition on all parts that this means the module
+is being distributed under the same terms as Perl itself.  A module author
+should realize that inclusion of a module into the Perl core will
+necessarily mean some loss of control over it, since changes may
+occasionally have to be made on short notice or for consistency with the
+rest of Perl.
+
+Once a module has been included in the Perl core, however, everyone
+involved in maintaining Perl should be aware that the module is still the
+property of the original author unless the original author explicitly
+gives up their ownership of it.  In particular:
+
+ 1) The version of the module in the core should still be considered the
+    work of the original author.  All patches, bug reports, and so forth
+    should be fed back to them.  Their development directions should be
+    respected whenever possible.
+
+ 2) Patches may be applied by the pumpkin holder without the explicit
+    cooperation of the module author if and only if they are very minor,
+    time-critical in some fashion (such as urgent security fixes), or if
+    the module author cannot be reached.  Those patches must still be
+    given back to the author when possible, and if the author decides on
+    an alternate fix in their version, that fix should be strongly
+    preferred unless there is a serious problem with it.  Any changes not
+    endorsed by the author should be marked as such, and the contributor
+    of the change acknowledged.
+
+ 3) The version of the module distributed with Perl should, whenever
+    possible, be the latest version of the module as distributed by the
+    author (the latest non-beta version in the case of public Perl
+    releases), although the pumpkin holder may hold off on upgrading the
+    version of the module distributed with Perl to the latest version
+    until the latest version has had sufficient testing.
+
+In other words, the author of a module should be considered to have final
+say on modifications to their module whenever possible (bearing in mind
+that it's expected that everyone involved will work together and arrive at
+reasonable compromises when there are disagreements).
+
+As a last resort, however:
+
+ 4) If the author's vision of the future of their module is sufficiently
+    different from the vision of the pumpkin holder and perl5-porters as a
+    whole so as to cause serious problems for Perl, the pumpkin holder may
+    choose to formally fork the version of the module in the core from the
+    one maintained by the author.  This should not be done lightly and
+    should *always* if at all possible be done only after direct input
+    from Larry.  If this is done, it must then be made explicit in the
+    module as distributed with Perl core that it is a forked version and
+    that while it is based on the original author's work, it is no longer
+    maintained by them.  This must be noted in both the documentation and
+    in the comments in the source of the module.
+
+Again, this should be a last resort only.  Ideally, this should never
+happen, and every possible effort at cooperation and compromise should be
+made before doing this.  If it does prove necessary to fork a module for
+the overall health of Perl, proper credit must be given to the original
+author in perpetuity and the decision should be constantly re-evaluated to
+see if a remerging of the two branches is possible down the road.
+
+In all dealings with contributed modules, everyone maintaining Perl should
+keep in mind that the code belongs to the original author, that they may
+not be on perl5-porters at any given time, and that a patch is not
+official unless it has been integrated into the author's copy of the
+module.  To aid with this, and with points #1, #2, and #3 above, contact
+information for the authors of all contributed modules should be kept with
+the Perl distribution.
+
+Finally, the Perl community as a whole recognizes that respect for
+ownership of code, respect for artistic control, proper credit, and active
+effort to prevent unintentional code skew or communication gaps is vital
+to the health of the community and Perl itself.  Members of a community
+should not normally have to resort to rules and laws to deal with each
+other, and this document, although it contains rules so as to be clear, is
+about an attitude and general approach.  The first step in any dispute
+should be open communication, respect for opposing views, and an attempt
+at a compromise.  In nearly every circumstance nothing more will be
+necessary, and certainly no more drastic measure should be used until
+every avenue of communication and discussion has failed.
+
+-- 
+Version 1.2.  By Russ Allbery (rra@stanford.edu) and the perl5-porters.
+

contrib/perl5/Porting/config.sh

@@ -0,0 +1,585 @@
+#!/bin/sh
+#
+# This file was produced by running the Configure script. It holds all the
+# definitions figured out by Configure. Should you modify one of these values,
+# do not forget to propagate your changes by running "Configure -der". You may
+# instead choose to run each of the .SH files by yourself, or "Configure -S".
+#
+
+# Package name      : perl5
+# Source directory  : .
+# Configuration time: Tue Jul 21 10:03:27 EDT 1998
+# Configured by     : doughera
+# Target system     : linux fractal 2.0.34 #1 tue jun 23 10:09:17 edt 1998 i686 unknown 
+
+Author=''
+Date='$Date'
+Header=''
+Id='$Id'
+Locker=''
+Log='$Log'
+Mcc='Mcc'
+RCSfile='$RCSfile'
+Revision='$Revision'
+Source=''
+State=''
+_a='.a'
+_exe=''
+_o='.o'
+afs='false'
+alignbytes='4'
+ansi2knr=''
+aphostname=''
+apiversion='5.005'
+ar='ar'
+archlib='/opt/perl/lib/5.005/i686-linux-thread'
+archlibexp='/opt/perl/lib/5.005/i686-linux-thread'
+archname='i686-linux-thread'
+archobjs=''
+awk='awk'
+baserev='5.0'
+bash=''
+bin='/opt/perl/bin'
+binexp='/opt/perl/bin'
+bison=''
+byacc='byacc'
+byteorder='1234'
+c=''
+castflags='0'
+cat='cat'
+cc='cc'
+cccdlflags='-fpic'
+ccdlflags='-rdynamic'
+ccflags='-D_REENTRANT -Dbool=char -DHAS_BOOL -I/usr/local/include'
+cf_by='doughera'
+cf_email='yourname@yourhost.yourplace.com'
+cf_time='Tue Jul 21 10:03:27 EDT 1998'
+chgrp=''
+chmod=''
+chown=''
+clocktype='clock_t'
+comm='comm'
+compress=''
+contains='grep'
+cp='cp'
+cpio=''
+cpp='cpp'
+cpp_stuff='42'
+cppflags='-D_REENTRANT -Dbool=char -DHAS_BOOL -I/usr/local/include'
+cpplast='-'
+cppminus='-'
+cpprun='cc -E'
+cppstdin='cc -E'
+cryptlib=''
+csh='csh'
+d_Gconvert='gcvt((x),(n),(b))'
+d_access='define'
+d_alarm='define'
+d_archlib='define'
+d_attribut='define'
+d_bcmp='define'
+d_bcopy='define'
+d_bsd='undef'
+d_bsdgetpgrp='undef'
+d_bsdsetpgrp='undef'
+d_bzero='define'
+d_casti32='undef'
+d_castneg='define'
+d_charvspr='undef'
+d_chown='define'
+d_chroot='define'
+d_chsize='undef'
+d_closedir='define'
+d_const='define'
+d_crypt='define'
+d_csh='define'
+d_cuserid='define'
+d_dbl_dig='define'
+d_difftime='define'
+d_dirnamlen='undef'
+d_dlerror='define'
+d_dlopen='define'
+d_dlsymun='undef'
+d_dosuid='undef'
+d_dup2='define'
+d_endgrent='define'
+d_endhent='define'
+d_endnent='define'
+d_endpent='define'
+d_endpwent='define'
+d_endsent='define'
+d_eofnblk='define'
+d_eunice='undef'
+d_fchmod='define'
+d_fchown='define'
+d_fcntl='define'
+d_fd_macros='define'
+d_fd_set='define'
+d_fds_bits='define'
+d_fgetpos='define'
+d_flexfnam='define'
+d_flock='define'
+d_fork='define'
+d_fpathconf='define'
+d_fsetpos='define'
+d_ftime='undef'
+d_getgrent='define'
+d_getgrps='define'
+d_gethbyaddr='define'
+d_gethbyname='define'
+d_gethent='define'
+d_gethname='undef'
+d_gethostprotos='define'
+d_getlogin='define'
+d_getnbyaddr='define'
+d_getnbyname='define'
+d_getnent='define'
+d_getnetprotos='define'
+d_getpbyname='define'
+d_getpbynumber='define'
+d_getpent='define'
+d_getpgid='define'
+d_getpgrp2='undef'
+d_getpgrp='define'
+d_getppid='define'
+d_getprior='define'
+d_getprotoprotos='define'
+d_getpwent='define'
+d_getsbyname='define'
+d_getsbyport='define'
+d_getsent='define'
+d_getservprotos='define'
+d_gettimeod='define'
+d_gnulibc='define'
+d_grpasswd='define'
+d_htonl='define'
+d_index='undef'
+d_inetaton='define'
+d_isascii='define'
+d_killpg='define'
+d_lchown='undef'
+d_link='define'
+d_locconv='define'
+d_lockf='define'
+d_longdbl='define'
+d_longlong='define'
+d_lstat='define'
+d_mblen='define'
+d_mbstowcs='define'
+d_mbtowc='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_mkfifo='define'
+d_mktime='define'
+d_msg='define'
+d_msgctl='define'
+d_msgget='define'
+d_msgrcv='define'
+d_msgsnd='define'
+d_mymalloc='undef'
+d_nice='define'
+d_oldpthreads='undef'
+d_oldsock='undef'
+d_open3='define'
+d_pathconf='define'
+d_pause='define'
+d_phostname='undef'
+d_pipe='define'
+d_poll='define'
+d_portable='define'
+d_pthread_yield='undef'
+d_pthreads_created_joinable='define'
+d_pwage='undef'
+d_pwchange='undef'
+d_pwclass='undef'
+d_pwcomment='undef'
+d_pwexpire='undef'
+d_pwgecos='define'
+d_pwquota='undef'
+d_pwpasswd='define'
+d_readdir='define'
+d_readlink='define'
+d_rename='define'
+d_rewinddir='define'
+d_rmdir='define'
+d_safebcpy='define'
+d_safemcpy='undef'
+d_sanemcmp='define'
+d_sched_yield='define'
+d_seekdir='define'
+d_select='define'
+d_sem='define'
+d_semctl='define'
+d_semctl_semid_ds='define'
+d_semctl_semun='define'
+d_semget='define'
+d_semop='define'
+d_setegid='define'
+d_seteuid='define'
+d_setgrent='define'
+d_setgrps='define'
+d_sethent='define'
+d_setlinebuf='define'
+d_setlocale='define'
+d_setnent='define'
+d_setpent='define'
+d_setpgid='define'
+d_setpgrp2='undef'
+d_setpgrp='define'
+d_setprior='define'
+d_setpwent='define'
+d_setregid='define'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setreuid='define'
+d_setrgid='undef'
+d_setruid='undef'
+d_setsent='define'
+d_setsid='define'
+d_setvbuf='define'
+d_sfio='undef'
+d_shm='define'
+d_shmat='define'
+d_shmatprototype='define'
+d_shmctl='define'
+d_shmdt='define'
+d_shmget='define'
+d_sigaction='define'
+d_sigsetjmp='define'
+d_socket='define'
+d_sockpair='define'
+d_statblks='undef'
+d_stdio_cnt_lval='undef'
+d_stdio_ptr_lval='define'
+d_stdiobase='define'
+d_stdstdio='define'
+d_strchr='define'
+d_strcoll='define'
+d_strctcpy='define'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strtod='define'
+d_strtol='define'
+d_strtoul='define'
+d_strxfrm='define'
+d_suidsafe='undef'
+d_symlink='define'
+d_syscall='define'
+d_sysconf='define'
+d_sysernlst=''
+d_syserrlst='define'
+d_system='define'
+d_tcgetpgrp='define'
+d_tcsetpgrp='define'
+d_telldir='define'
+d_time='define'
+d_times='define'
+d_truncate='define'
+d_tzname='define'
+d_umask='define'
+d_uname='define'
+d_union_semun='define'
+d_vfork='undef'
+d_void_closedir='undef'
+d_voidsig='define'
+d_voidtty=''
+d_volatile='define'
+d_vprintf='define'
+d_wait4='define'
+d_waitpid='define'
+d_wcstombs='define'
+d_wctomb='define'
+d_xenix='undef'
+date='date'
+db_hashtype='u_int32_t'
+db_prefixtype='size_t'
+defvoidused='15'
+direntrytype='struct dirent'
+dlext='so'
+dlsrc='dl_dlopen.xs'
+doublesize='8'
+dynamic_ext='B DB_File Data/Dumper Fcntl GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
+eagain='EAGAIN'
+ebcdic='undef'
+echo='echo'
+egrep='egrep'
+emacs=''
+eunicefix=':'
+exe_ext=''
+expr='expr'
+extensions='B DB_File Data/Dumper Fcntl GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno'
+find='find'
+firstmakefile='makefile'
+flex=''
+fpostype='fpos_t'
+freetype='void'
+full_csh='/bin/csh'
+full_sed='/bin/sed'
+gccversion='2.7.2.3'
+gidtype='gid_t'
+glibpth='/usr/shlib  /shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/local/lib '
+grep='grep'
+groupcat='cat /etc/group'
+groupstype='gid_t'
+gzip='gzip'
+h_fcntl='false'
+h_sysfile='true'
+hint='recommended'
+hostcat='cat /etc/hosts'
+huge=''
+i_arpainet='define'
+i_bsdioctl=''
+i_db='define'
+i_dbm='define'
+i_dirent='define'
+i_dld='undef'
+i_dlfcn='define'
+i_fcntl='undef'
+i_float='define'
+i_gdbm='define'
+i_grp='define'
+i_limits='define'
+i_locale='define'
+i_malloc='define'
+i_math='define'
+i_memory='undef'
+i_ndbm='define'
+i_netdb='define'
+i_neterrno='undef'
+i_niin='define'
+i_pwd='define'
+i_rpcsvcdbm='undef'
+i_sfio='undef'
+i_sgtty='undef'
+i_stdarg='define'
+i_stddef='define'
+i_stdlib='define'
+i_string='define'
+i_sysdir='define'
+i_sysfile='define'
+i_sysfilio='undef'
+i_sysin='undef'
+i_sysioctl='define'
+i_sysndir='undef'
+i_sysparam='define'
+i_sysresrc='define'
+i_sysselct='define'
+i_syssockio=''
+i_sysstat='define'
+i_systime='define'
+i_systimek='undef'
+i_systimes='define'
+i_systypes='define'
+i_sysun='define'
+i_syswait='define'
+i_termio='undef'
+i_termios='define'
+i_time='undef'
+i_unistd='define'
+i_utime='define'
+i_values='define'
+i_varargs='undef'
+i_varhdr='stdarg.h'
+i_vfork='undef'
+incpath=''
+inews=''
+installarchlib='/opt/perl/lib/5.005/i686-linux-thread'
+installbin='/opt/perl/bin'
+installman1dir='/opt/perl/man/man1'
+installman3dir='/opt/perl/man/man3'
+installprivlib='/opt/perl/lib/5.005'
+installscript='/opt/perl/script'
+installsitearch='/opt/perl/lib/site_perl/5.005/i686-linux-thread'
+installsitelib='/opt/perl/lib/site_perl/5.005'
+intsize='4'
+known_extensions='B DB_File Data/Dumper Fcntl GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re'
+ksh=''
+large=''
+ld='cc'
+lddlflags='-shared -L/usr/local/lib'
+ldflags=' -L/usr/local/lib'
+less='less'
+lib_ext='.a'
+libc=''
+libperl='libperl.a'
+libpth='/usr/local/lib /lib /usr/lib'
+libs='-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lpthread -lc -lposix -lcrypt'
+libswanted='sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m pthread c cposix posix ndir dir crypt ucb BSD PW x'
+line='line'
+lint=''
+lkflags=''
+ln='ln'
+lns='/bin/ln -s'
+locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
+loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblsize='12'
+longlongsize='8'
+longsize='4'
+lp=''
+lpr=''
+ls='ls'
+lseektype='off_t'
+mail=''
+mailx=''
+make='make'
+make_set_make='#'
+mallocobj=''
+mallocsrc=''
+malloctype='void *'
+man1dir='/opt/perl/man/man1'
+man1direxp='/opt/perl/man/man1'
+man1ext='1'
+man3dir='/opt/perl/man/man3'
+man3direxp='/opt/perl/man/man3'
+man3ext='3'
+medium=''
+mips=''
+mips_type=''
+mkdir='mkdir'
+models='none'
+modetype='mode_t'
+more='more'
+mv=''
+myarchname='i686-linux'
+mydomain='.yourplace.com'
+myhostname='yourhost'
+myuname='linux fractal 2.0.34 #1 tue jun 23 10:09:17 edt 1998 i686 unknown '
+n='-n'
+netdb_hlen_type='int'
+netdb_host_type='const char *'
+netdb_name_type='const char *'
+netdb_net_type='unsigned long'
+nm='nm'
+nm_opt=''
+nm_so_opt='--dynamic'
+nonxs_ext='Errno'
+nroff='nroff'
+o_nonblock='O_NONBLOCK'
+obj_ext='.o'
+optimize='-O'
+orderlib='false'
+osname='linux'
+osvers='2.0.34'
+package='perl5'
+pager='/usr/bin/less'
+passcat='cat /etc/passwd'
+patchlevel='5'
+path_sep=':'
+perl='perl'
+perladmin='yourname@yourhost.yourplace.com'
+perlpath='/opt/perl/bin/perl'
+pg='pg'
+phostname=''
+pidtype='pid_t'
+plibpth=''
+pmake=''
+pr=''
+prefix='/opt/perl'
+prefixexp='/opt/perl'
+privlib='/opt/perl/lib/5.005'
+privlibexp='/opt/perl/lib/5.005'
+prototype='define'
+ptrsize='4'
+randbits='31'
+ranlib=':'
+rd_nodata='-1'
+rm='rm'
+rmail=''
+runnm='false'
+scriptdir='/opt/perl/script'
+scriptdirexp='/opt/perl/script'
+sed='sed'
+selecttype='fd_set *'
+sendmail='sendmail'
+sh='/bin/sh'
+shar=''
+sharpbang='#!'
+shmattype='void *'
+shortsize='2'
+shrpenv=''
+shsharp='true'
+sig_name='ZERO HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2 PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN TTOU URG XCPU XFSZ VTALRM PROF WINCH IO PWR UNUSED IOT CLD POLL '
+sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "BUS", "FPE", "KILL", "USR1", "SEGV", "USR2", "PIPE", "ALRM", "TERM", "STKFLT", "CHLD", "CONT", "STOP", "TSTP", "TTIN", "TTOU", "URG", "XCPU", "XFSZ", "VTALRM", "PROF", "WINCH", "IO", "PWR", "UNUSED", "IOT", "CLD", "POLL", 0'
+sig_num='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 6, 17, 29, 0'
+signal_t='void'
+sitearch='/opt/perl/lib/site_perl/5.005/i686-linux-thread'
+sitearchexp='/opt/perl/lib/site_perl/5.005/i686-linux-thread'
+sitelib='/opt/perl/lib/site_perl/5.005'
+sitelibexp='/opt/perl/lib/site_perl/5.005'
+sizetype='size_t'
+sleep=''
+smail=''
+small=''
+so='so'
+sockethdr=''
+socketlib=''
+sort='sort'
+spackage='Perl5'
+spitshell='cat'
+split=''
+src='.'
+ssizetype='ssize_t'
+startperl='#!/opt/perl/bin/perl'
+startsh='#!/bin/sh'
+static_ext=' '
+stdchar='char'
+stdio_base='((fp)->_IO_read_base)'
+stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)'
+stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
+stdio_filbuf=''
+stdio_ptr='((fp)->_IO_read_ptr)'
+strings='/usr/include/string.h'
+submit=''
+subversion='0'
+sysman='/usr/man/man1'
+tail=''
+tar=''
+tbl=''
+tee='tee'
+test='test'
+timeincl='/usr/include/sys/time.h '
+timetype='time_t'
+touch='touch'
+tr='tr'
+trnl='\n'
+troff=''
+uidtype='uid_t'
+uname='uname'
+uniq='uniq'
+usedl='define'
+usemymalloc='n'
+usenm='false'
+useopcode='true'
+useperlio='undef'
+useposix='true'
+usesfio='false'
+useshrplib='false'
+usethreads='define'
+usevfork='false'
+usrinc='/usr/include'
+uuname=''
+version='5.005'
+vi=''
+voidflags='15'
+xlibpth='/usr/lib/386 /lib/386'
+zcat=''
+zip='zip'
+# Configure command line arguments.
+config_arg0='Configure'
+config_args='-Dprefix=/opt/perl -Doptimize=-O -Dusethreads -Dcf_by=yourname -Dcf_email=yourname@yourhost.yourplace.com -Dperladmin=yourname@yourhost.yourplace.com -Dmydomain=.yourplace.com -Dmyhostname=yourhost -dE'
+config_argc=9
+config_arg1='-Dprefix=/opt/perl'
+config_arg2='-Doptimize=-O'
+config_arg3='-Dusethreads'
+config_arg4='-Dcf_by=yourname'
+config_arg5='-Dcf_email=yourname@yourhost.yourplace.com'
+config_arg6='-Dperladmin=yourname@yourhost.yourplace.com'
+config_arg7='-Dmydomain=.yourplace.com'
+config_arg8='-Dmyhostname=yourhost'
+config_arg9='-dE'
+PATCHLEVEL=5
+SUBVERSION=0
+CONFIG=true

contrib/perl5/Porting/findvars

@@ -0,0 +1,373 @@
+#!/l/local/bin/perl -w
+
+$pat = '';
+# construct word list
+while (<DATA>) {
+  chomp;
+  next unless $_;
+  $pat .= "$_|";
+}
+chop $pat if $pat =~ /\|$/;
+
+# grep
+while (<>) {
+    if (/^(.*?)\b($pat)\b(.*)$/o) {
+        my $head = "$1#$2#";
+        $_ = $3;
+        while (/^(.*?)\b($pat)\b(.*)$/o) {
+            $head .= "$1#$2#";
+            $_ = $3;
+        }
+	print "$ARGV\:$.\:$head$_\n";
+    }
+}
+continue {
+    close ARGV if eof;
+}
+__END__
+Argv
+Cmd
+DBcv
+DBgv
+DBline
+DBsignal
+DBsingle
+DBsub
+DBtrace
+No
+Sv
+Xpv
+Yes
+amagic_generation
+ampergv
+an
+archpat_auto
+argvgv
+argvoutgv
+av_fetch_sv
+basetime
+beginav
+bodytarget
+bostr
+bufend
+bufptr
+cddir
+chopset
+collation_ix
+collation_name
+collation_standard
+collxfrm_base
+collxfrm_mult
+colors
+colorset
+compcv
+compiling
+comppad
+comppad_name
+comppad_name_fill
+comppad_name_floor
+cop_seqmax
+copline
+cryptseen
+cshlen
+cshname
+curcop
+curcopdb
+curinterp
+curpad
+curpm
+curstack
+curstackinfo
+curstash
+curstname
+curthr
+dbargs
+debdelim
+debname
+debstash
+debug
+defgv
+defoutgv
+defstash
+delaymagic
+diehook
+dirty
+dlevel
+dlmax
+do_undump
+doextract
+doswitches
+dowarn
+dumplvl
+e_script
+egid
+endav
+envgv
+errgv
+error_count
+euid
+eval_cond
+eval_mutex
+eval_owner
+eval_root
+eval_start
+evalseq
+exitlist
+exitlistlen
+expect
+extralen
+fdpid
+filemode
+firstgv
+forkprocess
+formfeed
+formtarget
+generation
+gensym
+gid
+globalstash
+he_root
+hexdigit
+hintgv
+hints
+hv_fetch_ent_mh
+hv_fetch_sv
+in_clean_all
+in_clean_objs
+in_eval
+in_my
+in_my_stash
+incgv
+initav
+inplace
+last_in_gv
+last_lop
+last_lop_op
+last_proto
+last_uni
+lastfd
+lastgotoprobe
+lastscream
+lastsize
+lastspbase
+laststatval
+laststype
+leftgv
+lex_brackets
+lex_brackstack
+lex_casemods
+lex_casestack
+lex_defer
+lex_dojoin
+lex_expect
+lex_fakebrack
+lex_formbrack
+lex_inpat
+lex_inwhat
+lex_op
+lex_repl
+lex_starts
+lex_state
+lex_stuff
+lineary
+linestart
+linestr
+localizing
+localpatches
+main_cv
+main_root
+main_start
+mainstack
+malloc_mutex
+markstack
+markstack_max
+markstack_ptr
+max_intro_pending
+maxo
+maxscream
+maxsysfd
+mess_sv
+min_intro_pending
+minus_F
+minus_a
+minus_c
+minus_l
+minus_n
+minus_p
+modcount
+modglobal
+multi_close
+multi_end
+multi_open
+multi_start
+multiline
+mystrk
+na
+nexttoke
+nexttype
+nextval
+nice_chunk
+nice_chunk_size
+ninterps
+nomemok
+nrs
+nthreads
+nthreads_cond
+numeric_local
+numeric_name
+numeric_standard
+ofmt
+ofs
+ofslen
+oldbufptr
+oldlastpm
+oldname
+oldoldbufptr
+op
+op_mask
+op_seqmax
+opsave
+origalen
+origargc
+origargv
+origenviron
+origfilename
+ors
+orslen
+osname
+pad_reset_pending
+padix
+padix_floor
+parsehook
+patchlevel
+patleave
+pending_ident
+perl_destruct_level
+perldb
+pidstatus
+preambleav
+preambled
+preprocess
+profiledata
+reg_eval_set
+reg_flags
+reg_start_tmp
+reg_start_tmpl
+regbol
+regcc
+regcode
+regcomp_parse
+regcomp_rx
+regcompp
+regdata
+regdummy
+regendp
+regeol
+regexecp
+regflags
+regindent
+reginput
+reginterp_cnt
+reglastparen
+regnarrate
+regnaughty
+regnpar
+regprecomp
+regprev
+regprogram
+regsawback
+regseen
+regsize
+regstartp
+regtill
+regxend
+replgv
+restartop
+retstack
+retstack_ix
+retstack_max
+rightgv
+rs
+rsfp
+rsfp_filters
+runops
+savestack
+savestack_ix
+savestack_max
+sawampersand
+sawstudy
+sawvec
+scopestack
+scopestack_ix
+scopestack_max
+screamfirst
+screamnext
+secondgv
+seen_evals
+seen_zerolen
+sh_path
+siggv
+sighandlerp
+sortcop
+sortcxix
+sortstash
+specialsv_list
+splitstr
+stack_base
+stack_max
+stack_sp
+start_env
+statbuf
+statcache
+statgv
+statname
+statusvalue
+statusvalue_vms
+stdingv
+strchop
+strtab
+sub_generation
+sublex_info
+subline
+subname
+sv_arenaroot
+sv_count
+sv_mutex
+sv_no
+sv_objcount
+sv_root
+sv_undef
+sv_yes
+svref_mutex
+sys_intern
+tainted
+tainting
+thisexpr
+thr_key
+threadnum
+threads_mutex
+threadsv_names
+thrsv
+timesbuf
+tmps_floor
+tmps_ix
+tmps_max
+tmps_stack
+tokenbuf
+top_env
+toptarget
+uid
+unsafe
+warnhook
+xiv_arenaroot
+xiv_root
+xnv_root
+xpv_root
+xrv_root
+piMem
+piENV
+piStdIO
+piLIO
+piDir
+piSock
+piProc

contrib/perl5/Porting/fixCORE

@@ -0,0 +1,68 @@
+#!/usr/local/bin/perl -w
+use Data::Dumper;
+
+my $targ = shift;
+my $inc  = join(' ',map("-I$_",@INC));
+
+my $work = 1;
+while ($work)
+ {
+  open(PIPE,"$^X -w $inc -M$targ -e '' 2>&1 |") || die "Cannot open pipe to child:$!";
+  my %fix;
+  while (<PIPE>)
+   {
+    if (/^Ambiguous call resolved as CORE::(\w+)\(\), qualify as such or use \& at (\S+) line (\d+)/
+         && -f $2 )
+     {
+      my ($var,$file,$line) = ($1,$2,$3);
+      $fix{$file} = [] unless exists $fix{$file}; 
+      push(@{$fix{$file}},[$line => $var]) unless ($var =~ /^PL_/ || $file =~ /\.h$/);
+     }
+    print;
+   }
+  close(PIPE);
+# warn "Make retured $?\n";
+# last unless $?;
+  my $changed = 0;
+  foreach my $file (keys %fix)
+   {          
+    my @ar = sort( { $a->[0] <=> $b->[0] } @{delete $fix{$file}});
+    my @miss;
+    my $fixed = 0;
+    @ARGV = ($file);
+    $. = 0;
+    local $^I = '.sav';
+    while (<>)
+     {
+      while (@ar && $. == $ar[0][0])
+       {
+        my ($line,$var) = @{shift(@ar)};
+        if (s/(?<!CORE::)\b$var\b(?=\s*\()/CORE::$var/)
+         {
+          warn "$file:$line: FIX $var\n"; 
+          $fixed++;
+          $changed++;
+         }
+        else
+         {
+          push(@miss,[$line,$var,$_]);
+         }
+       }
+      print;
+     }
+    unless ($fixed)
+     {
+      rename("$file$^I",$file);
+      if (@miss)
+       {
+        while (@miss)
+         {
+          my ($line,$var,$txt) = @{shift(@miss)};
+          warn "$file:$line:$var | $txt";
+         }
+       }
+     }    
+   }
+  last unless $changed;
+ }
+

contrib/perl5/Porting/fixvars

@@ -0,0 +1,69 @@
+#!/usr/local/bin/perl -w
+use Data::Dumper;
+
+my $targ = (@ARGV) ? join(' ',@ARGV) : 'miniperl' ;
+
+my $work = 1;
+while ($work)
+ {
+  open(PIPE,"make $targ 2>&1 |") || die "Cannot open pipe to make:$!";
+  my %fix;
+  while (<PIPE>)
+   {
+    if (/^(.*):(\d+):\s+\`(\w+)'\s+undeclared/ && -f $1 )
+     {
+      my ($file,$line,$var) = ($1,$2,$3);
+      $fix{$file} = [] unless exists $fix{$file}; 
+      push(@{$fix{$file}},[$line => $var]) unless ($var =~ /^PL_/ || $file =~ /\.h$/);
+     }
+    print;
+   }
+  close(PIPE);
+  warn "Make retured $?\n";
+  last unless $?;
+  my $changed = 0;
+  foreach my $file (keys %fix)
+   {          
+    my @ar = sort( { $a->[0] <=> $b->[0] } @{delete $fix{$file}});
+    my @miss;
+    my $fixed = 0;
+    unless (-w $file)
+     {
+      system("d4","edit",$file);
+     }             
+    @ARGV = ($file);
+    $. = 0;
+    local $^I = '.sav';
+    while (<>)
+     {
+      while (@ar && $. == $ar[0][0])
+       {
+        my ($line,$var) = @{shift(@ar)};
+        if (s/\b$var\b/PL_$var/)
+         {
+          warn "$file:$line: FIX $var\n"; 
+          $fixed++;
+          $changed++;
+         }
+        else
+         {
+          push(@miss,[$line,$var,$_]);
+         }
+       }
+      print;
+     }
+    unless ($fixed)
+     {
+      rename("$file$^I",$file);
+      if (@miss)
+       {
+        while (@miss)
+         {
+          my ($line,$var,$txt) = @{shift(@miss)};
+          warn "$file:$line:$var | $txt";
+         }
+       }
+     }    
+   }
+  last unless $changed;
+ }

contrib/perl5/Porting/genlog

@@ -0,0 +1,118 @@
+#!/l/local/bin/perl -w
+#
+# Generate a nice changelist by querying perforce.
+#
+# Each change is described with the change number, description,
+# which branch the change happened in, files modified,
+# and who was responsible for entering the change.
+#
+# Can be called with a list of change numbers or a range of the
+# form "12..42".  Changelog will be printed from highest number
+# to lowest.
+#
+# Outputs the changelist to stdout.
+#
+# Gurusamy Sarathy <gsar@umich.edu>
+#
+
+use Text::Wrap;
+
+$0 =~ s|^.*/||;
+unless (@ARGV) {
+    die <<USAGE;
+        $0 [-p \$P4PORT] <change numbers or from..to>
+USAGE
+}
+
+my @changes;
+
+my %editkind;
+@editkind{ qw(   add      edit    delete integrate   branch )}
+         = qw(     +         !         -        !>       +> );
+
+my $p4port = $ENV{P4PORT} || 'localhost:1666';
+
+while (@ARGV) {
+    $_ = shift;
+    if (/^(\d+)\.\.(\d+)$/) {
+        push @changes, $1 .. $2;
+    }
+    elsif (/^\d+$/) {
+        push @changes, $_;
+    }
+    elsif (/^-p(.*)$/) {
+        $p4port = $1 || shift;
+    }
+    else {
+        warn "Arguments must be change numbers, ignoring `$_'\n";
+    }
+}
+
+@changes = sort { $b <=> $a } @changes;
+
+my @desc = `p4 -p $p4port describe -s @changes`;
+if ($?) {
+    die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n";
+}
+else {
+    chomp @desc;
+    while (@desc) {
+	my ($change,$who,$date,$time,@log,$branch,$file,$type,%files);
+	$_ = shift @desc;
+	if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) {
+	    ($change, $who, $date, $time) = ($1,$2,$3,$4);
+	    $_ = shift @desc;  # get rid of empty line
+	    while (@desc) {
+	        $_ = shift @desc;
+		last if /^Affected/;
+		push @log, $_;    
+	    }
+	    if (/^Affected/) {
+		$_ = shift @desc;  # get rid of empty line
+		while ($_ = shift @desc) {
+		    last unless /^\.\.\./;
+		    if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) {
+			($branch,$file,$type) = ($1,$2,$3);
+			$files{$branch} = {} unless exists $files{$branch};
+			$files{$branch}{$type} = [] unless exists $files{$branch}{$type};
+			push @{$files{$branch}{$type}}, $file;
+		    }
+		    else {
+			warn "Unknown line [$_], ignoring\n";
+		    }
+		}
+	    }
+	}
+	next unless $change;
+	print "_" x 76, "\n";
+	printf <<EOT, $change, $who, $date, $time;
+[%6s] By: %-25s             on %9s %9s
+EOT
+	print "        Log: ";
+	my $i = 0;
+	while (@log) {
+	    $_ = shift @log;
+	    s/^\s*//;
+	    s/^\[.*\]\s*// unless $i ;
+            # don't print last empty line
+	    if ($_ or @log) {
+	        print "             " if $i++;
+	        print "$_\n";
+	    }
+	}
+	for my $branch (sort keys %files) {
+	    printf "%11s: $branch\n", 'Branch';
+	    for my $kind (sort keys %{$files{$branch}}) {
+	        warn("### $kind ###\n"), next unless exists $editkind{$kind};
+		my $files = $files{$branch}{$kind};
+		# don't show large branches and integrations
+		$files = ["($kind " . scalar(@$files) . ' files)']
+		    if (@$files > 25
+		        && ( $kind eq 'integrate' || $kind eq 'branch'));
+	        print wrap(sprintf("%12s ", $editkind{$kind}),
+			   sprintf("%12s ", $editkind{$kind}),
+			   "@$files\n");
+            }
+	}
+    }
+}

contrib/perl5/Porting/makerel

@@ -0,0 +1,129 @@
+#!/bin/env perl -w
+
+# A first attempt at some automated support for making a perl release.
+# Very basic but functional - if you're on a unix system.
+#
+# No matter how automated this gets, you'll always need to read
+# and re-read pumpkin.pod checking for things to be done at various
+# stages of the process.
+#
+# Tim Bunce, June 1997
+
+use ExtUtils::Manifest qw(fullcheck);
+
+$|=1;
+$relroot = "..";	# XXX make an option
+
+die "Must be in root of the perl source tree.\n"
+	unless -f "./MANIFEST" and -f "patchlevel.h";
+
+open PATCHLEVEL,"<patchlevel.h" or die;
+my @patchlevel_h = <PATCHLEVEL>;
+close PATCHLEVEL;
+my $patchlevel_h = join "", grep { /^#define/ } @patchlevel_h;
+print $patchlevel_h;
+$patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/;
+$subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/;
+die "Unable to parse patchlevel.h" unless $subversion >= 0;
+$vers = sprintf("5.%03d", $patchlevel);
+$vms_vers = sprintf("5_%03d", $patchlevel);
+if ($subversion) {
+    $vers.= sprintf( "_%02d", $subversion);
+    $vms_vers.= sprintf( "%02d", $subversion);
+} else {
+    $vms_vers.= "  ";
+}
+
+# fetch list of local patches
+my (@local_patches, @lpatch_tags, $lpatch_tags);
+@local_patches = grep { /^static.*local_patches/../^};/ } @patchlevel_h;
+@local_patches = grep { !/^\s*,?NULL/  } @local_patches;
+@lpatch_tags   = map  {  /^\s*,"(\w+)/ } @local_patches;
+$lpatch_tags   = join "-", @lpatch_tags;
+
+$perl = "perl$vers";
+$reldir = "$perl";
+$reldir .= "-$lpatch_tags" if $lpatch_tags;
+
+print "\nMaking a release for $perl in $relroot/$reldir\n\n";
+
+print "Cross-checking the MANIFEST...\n";
+($missfile, $missentry) = fullcheck();
+warn "Can't make a release with MANIFEST files missing.\n" if @$missfile;
+warn "Can't make a release with files not listed in MANIFEST.\n" if @$missentry;
+if ("@$missentry" =~ m/\.orig\b/) {
+    # Handy listing of find command and .orig files from patching work.
+    # I tend to run 'xargs rm' and copy and paste the file list.
+    my $cmd = "find . -name '*.orig' -print";
+    print "$cmd\n";
+    system($cmd);
+}
+die "Aborted.\n" if @$missentry or @$missfile;
+print "\n";
+
+# VMS no longer has hardcoded version numbers descrip.mms
+#print "Updating VMS version specific files with $vms_vers...\n";
+#system("perl -pi -e 's/^\QPERL_VERSION = \E\d\_\d+(\s*\#)/PERL_VERSION = $vms_vers$1/' vms/descrip.mms");
+
+
+
+print "Creating $relroot/$reldir release directory...\n";
+die "$relroot/$reldir release directory already exists\n"   if -e "$relroot/$reldir";
+die "$relroot/$reldir.tar.gz release file already exists\n" if -e "$relroot/$reldir.tar.gz";
+mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n";
+print "\n";
+
+
+print "Copying files to release directory...\n";
+# ExtUtils::Manifest maniread does not preserve the order
+$cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir";
+system($cmd) == 0 or die "$cmd failed";
+print "\n";
+
+chdir "$relroot/$reldir" or die $!;
+
+print "Setting file permissions...\n";
+system("find . -type f -print     | xargs chmod -w");
+system("find . -type d -print     | xargs chmod g-s");
+system("find t -name '*.t' -print | xargs chmod +x");
+my @exe = qw(
+    Configure
+    configpm
+    embed.pl
+    installperl
+    installman
+    keywords.pl
+    myconfig
+    opcode.pl
+    perly.fixer
+    t/TEST
+    t/*/*.t
+    *.SH
+    vms/ext/Stdio/test.pl
+    vms/ext/filespec.t
+    x2p/*.SH
+    Porting/patchls
+    Porting/makerel
+);
+system("chmod +x @exe");
+
+print "Adding CRs to DOSish files...\n";
+my @crlf = qw(
+    djgpp/configure.bat
+    README.dos
+    README.win32
+    win32/Makefile
+    win32/makefile.mk
+);
+system("perl -pi -e 's/\$/\\r/' @crlf");
+print "\n";
+
+chdir ".." or die $!;
+
+print "Creating and compressing the tar file...\n";
+my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch
+$cmd = "tar cf - $reldir | gzip --best > $reldir.tar.gz";
+system($cmd) == 0 or die "$cmd failed";
+print "\n";
+
+system("ls -ld $perl*");

contrib/perl5/Porting/p4d2p

@@ -0,0 +1,84 @@
+#!/l/local/bin/perl -wspi.bak
+
+#
+# reads a perforce style diff on stdin and outputs appropriate headers
+# so the diff can be applied with the patch program
+#
+# Gurusamy Sarathy <gsar@umich.edu>
+#
+
+BEGIN {
+    $0 =~ s|.*/||;
+    if ($h or $help) {
+	print STDERR <<USAGE;
+Usage: $0 [-v] [-h] files
+
+	-h	print this help
+	-v	output progress messages
+
+Does inplace edit of diff files output by the perforce commands
+"p4 describe", "p4 diff", and "p4 diff2". The result is suitable
+for feeding to the "patch" program.
+
+If no files are specified, reads from stdin and writes to stdout.
+
+WARNING: It only handles context or unified diffs.
+
+Example: p4 describe -du 123 | $0 > change-123.patch
+
+USAGE
+	exit(0);
+    }
+    unless (@ARGV) { @ARGV = '-'; undef $^I; }
+    use vars qw($thisfile $time $file $fnum $v $h $help);
+    $thisfile = "";
+    $time = localtime(time);
+}
+
+my ($cur, $match);
+$cur = m<^==== //depot/(.+?)\#\d+.* ====$> ... m<^(\@\@.+\@\@|\*+)$>;
+
+$match = $1;
+
+if ($ARGV ne $thisfile) {
+    warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
+    $thisfile = $ARGV;
+}
+
+# while we are within range
+if ($cur) {
+    # set the file name after first line
+    if ($cur == 1) {
+	$file = $match;
+	$fnum++;
+    }
+    # emit the diff header when we hit last line
+    elsif ($cur =~ /E0$/) {
+	my $f = $file;
+
+	# special hack for perl so we can always use "patch -p1"
+	$f =~ s<^.*?(perl.*?/)><$1>;
+
+	# unified diff
+	if ($match =~ /^\@/) {
+	    warn "emitting udiff header\n" if $v;
+	    $_ = "Index: $f\n--- $f.~1~\t$time\n+++ $f\t$time\n$_";
+	}
+	# context diff
+	elsif ($match =~ /^\*/) {
+	    warn "emitting cdiff header\n" if $v;
+	    $_ = "Index: $f\n*** $f.~1~\t$time\n--- $f\t$time\n$_";
+	}
+    }
+    # see if we hit another patch (i.e. previous patch was empty)
+    elsif (m<^==== //depot/(.+?)\#\d+.* ====$>) {
+	$file = $match = $1;
+    }
+    # suppress all other lines in the header
+    else {
+	$_ = "";
+    }
+    warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
+}
+
+$_ .= "End of Patch.\n" if eof;

contrib/perl5/Porting/patching.pod

@@ -0,0 +1,319 @@
+=head1 Name
+
+patching.pod - Appropriate format for patches to the perl source tree
+
+=head2 Where to get this document
+
+The latest version of this document is available from
+     http://perrin.dimensional.com/perl/perlpatch.html
+
+=head2 How to contribute to this document
+
+You may mail corrections, additions, and suggestions to me
+at dgris@tdrenterprises.com but the preferred method would be
+to follow the instructions set forth in this document and 
+submit a patch 8-).
+
+=head1 Description
+
+=head2 Why this document exists
+
+As an open source project Perl relies on patches and contributions from
+its users to continue functioning properly and to root out the inevitable
+bugs.  But, some users are unsure as to the I<right> way to prepare a patch
+and end up submitting seriously malformed patches.  This makes it very
+difficult for the current maintainer to integrate said patches into their
+distribution.  This document sets out usage guidelines for patches in an
+attempt to make everybody's life easier.
+
+=head2 Common problems
+
+The most common problems appear to be patches being mangled by certain
+mailers (I won't name names, but most of these seem to be originating on
+boxes running a certain popular commercial operating system). Other problems
+include patches not rooted in the appropriate place in the directory structure,
+and patches not produced using standard utilities (such as diff).
+
+=head1 Proper Patch Guidelines
+
+=head2 How to prepare your patch
+
+=over 4
+
+=item Creating your patch
+
+First, back up the original files.  This can't be stressed enough,
+back everything up _first_.
+
+Also, please create patches against a clean distribution of the perl source.
+This insures that everyone else can apply your patch without clobbering their
+source tree.
+
+=item diff
+
+While individual tastes vary (and are not the point here) patches should
+be created using either C<-u> or C<-c> arguments to diff.  These produce,
+respectively, unified diffs (where the changed line appears immediately next
+to the original) and context diffs (where several lines surrounding the changes
+are included).  See the manpage for diff for more details.
+
+Also, the preferred method for patching is -
+
+C<diff [C<-c> | C<-u>] E<lt>old-fileE<gt> E<lt>new-fileE<gt>>
+
+Note the order of files.
+
+Also, if your patch is to the core (rather than to a module) it
+is better to create it as a context diff as some machines have
+broken patch utilities that choke on unified diffs.
+
+GNU diff has many desirable features not provided by most vendor-supplied
+diffs.  Some examples using GNU diff:
+
+    # generate a patch for a newly added file
+    % diff -u /dev/null new/file
+    
+    # generate a patch to remove a file (patch > v2.4 will remove it cleanly)
+    % diff -u old/goner /dev/null
+    
+    # get additions, deletions along with everything else, recursively
+    % diff -ruN olddir newdir
+    
+    # ignore whitespace
+    % diff -bu a/file b/file
+    
+    # show function name in every hunk (safer, more informative)
+    % diff -u -F '^[_a-zA-Z0-9]+ *(' old/file new/file
+
+
+=item Directories
+
+Patches should be generated from the source root directory, not from the
+directory that the patched file resides in.  This insures that the maintainer
+patches the proper file and avoids name collisions (especially common when trying
+to apply patches to files that appear in both $src_root/ext/* and $src_root/lib/*).
+It is better to diff the file in $src_root/ext than the file in $src_root/lib.
+
+=item Filenames
+
+The most usual convention when submitting patches for a single file is to make
+your changes to a copy of the file with the same name as the original.  Rename
+the original file in such a way that it is obvious what is being patched ($file~ or
+$file.old seem to be popular).
+
+If you are submitting patches that affect multiple files then you should backup
+the entire directory tree (to $source_root.old/ for example).  This will allow
+C<diff C<-c> E<lt>old-dirE<gt> E<lt>new-dirE<gt>> to create all the patches
+at once.
+
+=back
+
+=head2 What to include in your patch
+
+=over 4
+
+=item Description of problem
+
+The first thing you should include is a description of the problem that
+the patch corrects.  If it is a code patch (rather than a documentation
+patch) you should also include a small test case that illustrates the
+bug.
+
+=item Direction for application
+
+You should include instructions on how to properly apply your patch.
+These should include the files affected, any shell scripts or commands
+that need to be run before or after application of the patch, and
+the command line necessary for application.
+
+=item If you have a code patch
+
+If you are submitting a code patch there are several other things that
+you need to do.
+
+=over 4
+
+=item Comments, Comments, Comments
+
+Be sure to adequately comment your code.  While commenting every
+line is unnecessary, anything that takes advantage of side effects of
+operators, that creates changes that will be felt outside of the
+function being patched, or that others may find confusing should
+be documented.  If you are going to err, it is better to err on the
+side of adding too many comments than too few.
+
+=item Style
+
+Please follow the indentation style and nesting style in use in the
+block of code that you are patching.
+
+=item Testsuite
+
+When submitting a patch you should make every effort to also include
+an addition to perl's regression tests to properly exercise your
+patch.  Your testsuite additions should generally follow these
+guidelines (courtesy of Gurusamy Sarathy (gsar@engin.umich.edu))-
+
+	Know what you're testing.  Read the docs, and the source.
+	Tend to fail, not succeed.
+	Interpret results strictly.
+	Use unrelated features (this will flush out bizarre interactions).
+	Use non-standard idioms (otherwise you are not testing TIMTOWTDI).
+	Avoid using hardcoded test umbers whenever possible (the EXPECTED/GOT style
+	  found in t/op/tie.t is much more maintainable, and gives better failure
+	  reports).
+	Give meaningful error messages when a test fails.
+	Avoid using qx// and system() unless you are testing for them.  If you
+	  do use them, make sure that you cover _all_ perl platforms.
+	Unlink any temporary files you create.
+	Promote unforeseen warnings to errors with $SIG{__WARN__}.
+	Be sure to use the libraries and modules shipped with version being tested,
+	  not those that were already installed.
+	Add comments to the code explaining what you are testing for.
+	Make updating the '1..42' string unnecessary.  Or make sure that you update it.
+	Test _all_ behaviors of a given operator, library, or function-
+	  All optional arguments
+	  Return values in various contexts (boolean, scalar, list, lvalue)
+	  Use both global and lexical variables
+	  Don't forget the exceptional, pathological cases.
+
+=back
+
+=item Test your patch
+
+Apply your patch to a clean distribution, compile, and run the
+regression test suite (you did remember to add one for your
+patch, didn't you).
+
+=back
+
+=head2 An example patch creation
+
+This should work for most patches-
+
+      cp MANIFEST MANIFEST.old
+      emacs MANIFEST
+      (make changes)
+      cd ..
+      diff -c perl5.008_42/MANIFEST.old perl5.008_42/MANIFEST > mypatch
+      (testing the patch:)
+      mv perl5.008_42/MANIFEST perl5.008_42/MANIFEST.new
+      cp perl5.008_42/MANIFEST.old perl5.008_42/MANIFEST
+      patch -p < mypatch
+      (should succeed)
+      diff perl5.008_42/MANIFEST perl5.008_42/MANIFEST.new
+      (should produce no output)
+
+=head2 Submitting your patch
+
+=over 4
+
+=item Mailers
+
+Please, please, please (get the point? 8-) don't use a mailer that
+word wraps your patch or that MIME encodes it.  Both of these leave
+the patch essentially worthless to the maintainer.
+
+If you have no choice in mailers and no way to get your hands on a
+better one there is, of course, a perl solution.  Just do this-
+
+      perl -ne 'print pack("u*",$_)' patch > patch.uue
+
+and post patch.uue with a note saying to unpack it using
+
+      perl -ne 'print unpack("u*",$_)' patch.uue > patch
+
+=item Subject lines for patches
+
+The subject line on your patch should read
+
+[PATCH]5.xxx_xx (Area) Description
+
+where the x's are replaced by the appropriate version number,
+area is a short keyword identifying what area of perl you are
+patching, and description is a very brief summary of the
+problem (don't forget this is an email header).
+
+Examples-
+
+[PATCH]5.004_04 (DOC) fix minor typos
+
+[PATCH]5.004_99 (CORE) New warning for foo() when frobbing
+
+[PATCH]5.005_42 (CONFIG) Added support for fribnatz 1.5
+
+=item Where to send your patch
+
+If your patch is for the perl core it should be sent perlbug@perl.org.
+If it is a patch to a module that you downloaded from CPAN you should
+submit your patch to that module's author.
+
+=back
+
+=head2 Applying a patch
+
+=over 4
+
+=item General notes on applying patches
+
+The following are some general notes on applying a patch
+to your perl distribution.
+
+=over 4
+
+=item patch C<-p>
+
+It is generally easier to apply patches with the C<-p> argument to
+patch.  This helps reconcile differing paths between the machine the
+patch was created on and the machine on which it is being applied.
+
+=item Cut and paste
+
+_Never_ cut and paste a patch into your editor.  This usually clobbers
+the tabs and confuses patch.
+
+=item Hand editing patches
+
+Avoid hand editing patches as this frequently screws up the whitespace
+in the patch and confuses the patch program.
+
+=back
+
+=back
+
+=head2 Final notes
+
+If you follow these guidelines it will make everybody's life a little
+easier.  You'll have the satisfaction of having contributed to perl,
+others will have an easy time using your work, and it should be easier
+for the maintainers to coordinate the occasionally large numbers of 
+patches received.
+
+Also, just because you're not a brilliant coder doesn't mean that you can't
+contribute.  As valuable as code patches are there is always a need for better
+documentation (especially considering the general level of joy that most
+programmers feel when forced to sit down and write docs).  If all you do
+is patch the documentation you have still contributed more than the person
+who sent in an amazing new feature that noone can use because noone understands
+the code (what I'm getting at is that documentation is both the hardest part to
+do (because everyone hates doing it) and the most valuable).
+
+Mostly, when contributing patches, imagine that it is B<you> receiving hundreds
+of patches and that it is B<your> responsibility to integrate them into the source.
+Obviously you'd want the patches to be as easy to apply as possible.  Keep that in
+mind.  8-)
+
+=head1 Last Modified
+
+Last modified 21 May 1998 by Daniel Grisinger <dgris@perrin.dimensional.com>
+
+=head1 Author and Copyright Information
+
+Copyright (c) 1998 Daniel Grisinger
+
+Adapted from a posting to perl5-porters by Tim Bunce (Tim.Bunce@ig.co.uk).
+
+I'd like to thank the perl5-porters for their suggestions.
+
+
+

contrib/perl5/Porting/patchls

@@ -0,0 +1,539 @@
+#!/bin/perl -w
+# 
+#	patchls - patch listing utility
+#
+# Input is one or more patchfiles, output is a list of files to be patched.
+#
+# Copyright (c) 1997 Tim Bunce. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# With thanks to Tom Horsley for the seed code.
+
+
+use Getopt::Std;
+use Text::Wrap qw(wrap $columns);
+use Text::Tabs qw(expand unexpand);
+use strict;
+use vars qw($VERSION);
+
+$VERSION = 2.08;
+
+sub usage {
+die qq{
+  patchls [options] patchfile [ ... ]
+
+    -h     no filename headers (like grep), only the listing.
+    -l     no listing (like grep), only the filename headers.
+    -i     Invert: for each patched file list which patch files patch it.
+    -c     Categorise the patch and sort by category (perl specific).
+    -m     print formatted Meta-information (Subject,From,Msg-ID etc).
+    -p N   strip N levels of directory Prefix (like patch), else automatic.
+    -v     more verbose (-d for noisy debugging).
+    -n     give a count of the number of patches applied to a file if >1.
+    -f F   only list patches which patch files matching regexp F
+           (F has \$ appended unless it contains a /).
+    -e     Expect patched files to Exist (relative to current directory)
+           Will print warnings for files which don't. Also affects -4 option.
+  other options for special uses:
+    -I     just gather and display summary Information about the patches.
+    -4     write to stdout the PerForce commands to prepare for patching.
+    -5     like -4 but add "|| exit 1" after each command
+    -M T   Like -m but only output listed meta tags (eg -M 'Title From')
+    -W N   set wrap width to N (defaults to 70, use 0 for no wrap)
+    -X     list patchfiles that may clash (i.e. patch the same file)
+
+  patchls version $VERSION by Tim Bunce
+}
+}
+
+$::opt_p = undef;	# undef != 0
+$::opt_d = 0;
+$::opt_v = 0;
+$::opt_m = 0;
+$::opt_n = 0;
+$::opt_i = 0;
+$::opt_h = 0;
+$::opt_l = 0;
+$::opt_c = 0;
+$::opt_f = '';
+$::opt_e = 0;
+
+# special purpose options
+$::opt_I = 0;
+$::opt_4 = 0;	# output PerForce commands to prepare for patching
+$::opt_5 = 0;
+$::opt_M = '';	# like -m but only output these meta items (-M Title)
+$::opt_W = 70;	# set wrap width columns (see Text::Wrap module)
+$::opt_C = 0;	# 'Chip' mode (handle from/tags/article/bug files) undocumented
+$::opt_X = 0;	# list patchfiles that patch the same file
+
+usage unless @ARGV;
+
+getopts("dmnihlvecC45Xp:f:IM:W:") or usage;
+
+$columns = $::opt_W || 9999999;
+
+$::opt_m = 1 if $::opt_M;
+$::opt_4 = 1 if $::opt_5;
+$::opt_i = 1 if $::opt_X;
+
+# see get_meta_info()
+my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID Files');
+my %show_meta = map { ($_,1) } @show_meta;
+
+my %cat_title = (
+    'BUILD'	=> 'BUILD PROCESS',
+    'CORE'	=> 'CORE LANGUAGE',
+    'DOC'	=> 'DOCUMENTATION',
+    'LIB'	=> 'LIBRARY',
+    'PORT1'	=> 'PORTABILITY - WIN32',
+    'PORT2'	=> 'PORTABILITY - GENERAL',
+    'TEST'	=> 'TESTS',
+    'UTIL'	=> 'UTILITIES',
+    'OTHER'	=> 'OTHER CHANGES',
+    'EXT'	=> 'EXTENSIONS',
+    'UNKNOWN'	=> 'UNKNOWN - NO FILES PATCH',
+);
+
+
+sub get_meta_info {
+    my $ls = shift;
+    local($_) = shift;
+    if (/^From:\s+(.*\S)/i) {;
+	my $from = $1;	# temporary measure for Chip Salzenberg
+	$from =~ s/chip\@(atlantic\.net|perlsupport\.com)/chip\@pobox.com/;
+	$from =~ s/\(Tim Bunce\) \(Tim Bunce\)/(Tim Bunce)/;
+	$ls->{From}{$from} = 1
+    }
+    if (/^Subject:\s+(?:Re: )?(.*\S)/i) {
+	my $title = $1;
+	$title =~ s/\[(PATCH|PERL)[\w\. ]*\]:?//g;
+	$title =~ s/\b(PATCH|PERL)[\w\.]*://g;
+	$title =~ s/\bRe:\s+/ /g;
+	$title =~ s/\s+/ /g;
+	$title =~ s/^\s*(.*?)\s*$/$1/g;
+	$ls->{Title}{$title} = 1;
+    }
+    $ls->{'Msg-ID'}{$1}=1 if /^Message-Id:\s+(.*\S)/i;
+    $ls->{Date}{$1}=1     if /^Date:\s+(.*\S)/i;
+    $ls->{$1}{$2}=1       if $::opt_M && /^([-\w]+):\s+(.*\S)/;
+}
+
+
+# Style 1:
+#	*** perl-5.004/embed.h  Sat May 10 03:39:32 1997
+#	--- perl-5.004.fixed/embed.h    Thu May 29 19:48:46 1997
+#	***************
+#	*** 308,313 ****
+#	--- 308,314 ----
+#
+# Style 2:
+#	--- perl5.004001/mg.c   Sun Jun 08 12:26:24 1997
+#	+++ perl5.004-bc/mg.c   Sun Jun 08 11:56:08 1997
+#	@@ -656,9 +656,27 @@
+# or (rcs, note the different date format)
+#	--- 1.18	1997/05/23 19:22:04
+#	+++ ./pod/perlembed.pod	1997/06/03 21:41:38
+#
+# Variation:
+#	Index: embed.h
+
+my %ls;
+
+my $in;
+my $ls;
+my $prevline = '';
+my $prevtype = '';
+my (@removed, @added);
+my $prologue = 1;	# assume prologue till patch or /^exit\b/ seen
+
+
+foreach my $argv (@ARGV) {
+    $in = $argv;
+    unless (open F, "<$in") {
+	warn "Unable to open $in: $!\n";
+	next;
+    }
+    print "Reading $in...\n" if $::opt_v and @ARGV > 1;
+    $ls = $ls{$in} ||= { is_in => 1, in => $in };
+    my $type;
+    while (<F>) {
+	unless (/^([-+*]{3}) / || /^(Index):/) {
+	    # not an interesting patch line
+	    # but possibly meta-information or prologue
+	    if ($prologue) {
+		push @added, $1     if /^touch\s+(\S+)/;
+		push @removed, $1   if /^rm\s+(?:-f)?\s*(\S+)/;
+		$prologue = 0       if /^exit\b/;
+	    }
+	    get_meta_info($ls, $_) if $::opt_m;
+	    next;
+	}
+	$type = $1;
+	next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
+	$prologue = 0;
+
+	print "Last: $prevline","This: ${_}Got:  $type\n\n" if $::opt_d;
+
+	# Some patches have Index lines but not diff headers
+	# Patch copes with this, so must we. It's also handy for
+	# documenting manual changes by simply adding Index: lines
+	# to the file which describes the problem being fixed.
+	if (/^Index:\s+(.*)/) {
+	    my $f;
+	    foreach $f (split(/ /, $1)) { add_file($ls, $f) }
+	    next;
+	}
+
+	if (	($type eq '---' and $prevtype eq '***')	# Style 1
+	    or	($type eq '+++' and $prevtype eq '---')	# Style 2
+	) {
+	    if (/^[-+*]{3} (\S+)\s*(.*?\d\d:\d\d:\d\d)?/) {	# double check
+		add_file($ls, $1);
+	    }
+	    else {
+		warn "$in $.: parse error (prev $prevtype, type $type)\n$prevline$_";
+	    }
+	}
+    }
+    continue {
+	$prevline = $_;
+	$prevtype = $type || '';
+	$type = '';
+    }
+
+    # special mode for patch sets from Chip
+    if ($in =~ m:[\\/]patch$:) {
+	my $is_chip;
+	my $chip;
+	my $dir; ($dir = $in) =~ s:[\\/]patch$::;
+	if (!$ls->{From} && (open(CHIP,"$dir/article") || open(CHIP,"$dir/bug"))) {
+	    get_meta_info($ls, $_) while (<CHIP>);
+	    $is_chip = 1;
+	}
+	if (open CHIP,"<$dir/from") {
+	    chop($chip = <CHIP>);
+	    $ls->{From} = { $chip => 1 };
+	    $is_chip = 1;
+	}
+	if (open CHIP,"<$dir/tag") {
+	    chop($chip = <CHIP>);
+	    $ls->{Title} = { $chip => 1 };
+	    $is_chip = 1;
+	}
+	$ls->{From} = { "Chip Salzenberg" => 1 } if $is_chip && !$ls->{From};
+    }
+
+    # if we don't have a title for -m then use the file name
+    $ls->{Title}{$in}=1 if $::opt_m
+	and !$ls->{Title} and $ls->{out};
+
+    $ls->{category} = $::opt_c
+	? categorize_files([keys %{ $ls->{out} }], $::opt_v) : '';
+}
+print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
+
+
+# --- Firstly we filter and sort as needed ---
+
+my @ls  = values %ls;
+
+if ($::opt_f) {		# filter out patches based on -f <regexp>
+    $::opt_f .= '$' unless $::opt_f =~ m:/:;
+    @ls = grep {
+	my $match = 0;
+	if ($_->{is_in}) {
+	    my @out = keys %{ $_->{out} };
+	    $match=1 if grep { m/$::opt_f/o } @out;
+	}
+	else {
+	    $match=1 if $_->{in} =~ m/$::opt_f/o;
+	}
+	$match;
+    } @ls;
+}
+
+@ls  = sort {
+    $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
+} @ls;
+
+
+# --- Handle special modes ---
+
+if ($::opt_4) {
+    my $tail = ($::opt_5) ? "|| exit 1" : "";
+    print map { "p4 delete $_$tail\n" } @removed if @removed;
+    print map { "p4 add    $_$tail\n" } @added   if @added;
+    my @patches = sort grep { $_->{is_in} } @ls;
+    my @no_outs = grep { keys %{$_->{out}} == 0 } @patches;
+    warn "Warning: Some files contain no patches:",
+	join("\n\t", '', map { $_->{in} } @no_outs), "\n" if @no_outs;
+    my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches;
+    delete @patched{@added};
+    my @patched = sort keys %patched;
+    foreach(@patched) {
+	my $edit = ($::opt_e && !-f $_) ? "add " : "edit";
+	print "p4 $edit   $_$tail\n";
+    }
+    exit 0 unless $::opt_C;
+}
+
+
+if ($::opt_I) {
+    my $n_patches = 0;
+    my($in,$out);
+    my %all_out;
+    my @no_outs;
+    foreach $in (@ls) {
+	next unless $in->{is_in};
+	++$n_patches;
+	my @outs = keys %{$in->{out}};
+	push @no_outs, $in unless @outs;
+	@all_out{@outs} = ($in->{in}) x @outs;
+    }
+    my @all_out = sort keys %all_out;
+    my @missing = grep { ! -f $_ } @all_out;
+    print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n";
+    print @no_outs." patch files don't contain patches.\n" if @no_outs;
+    print "(use -v to list patches which patch 'missing' files)\n"
+	    if (@missing || @no_outs) && !$::opt_v;
+    if ($::opt_v and @no_outs) {
+	print "Patch files which don't contain patches:\n";
+	foreach $out (@no_outs) {
+	    printf "  %-20s\n", $out->{in};
+	}
+    }
+    if ($::opt_v and @missing) {
+	print "Missing files:\n";
+	foreach $out (@missing) {
+	    printf "  %-20s\t", $out	unless $::opt_h;
+	    print $all_out{$out}	unless $::opt_l;
+	    print "\n";
+	}
+    }
+    print "Added files:   @added\n"   if @added;
+    print "Removed files: @removed\n" if @removed;
+    exit 0+@missing;
+}
+
+unless ($::opt_c and $::opt_m) {
+    foreach $ls (@ls) {
+	next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+	next if $::opt_X and keys %{$ls->{out}} <= 1;
+	list_files_by_patch($ls);
+    }
+}
+else {
+    my $c = '';
+    foreach $ls (@ls) {
+	next unless ($::opt_i) ? $ls->{is_out} : $ls->{is_in};
+	print "\n  ------  $cat_title{$ls->{category}}  ------\n"
+	    if $ls->{category} ne $c;
+	$c = $ls->{category};
+	unless ($::opt_i) {
+	    list_files_by_patch($ls);
+	}
+	else {
+	    my $out = $ls->{in};
+	    print "\n$out patched by:\n";
+	    # find all the patches which patch $out and list them
+	    my @p = grep { $_->{out}->{$out} } values %ls;
+	    foreach $ls (@p) {
+		list_files_by_patch($ls, '');
+	    }
+	}
+    }
+    print "\n";
+}
+
+exit 0;
+
+
+# ---
+
+
+sub add_file {
+    my $ls = shift;
+	print "add_file '$_[0]'\n" if $::opt_d;
+    my $out = trim_name(shift);
+
+    $ls->{out}->{$out} = 1;
+
+    warn "$out patched but not present\n" if $::opt_e && !-f $out;
+
+    # do the -i inverse as well, even if we're not doing -i
+    my $i = $ls{$out} ||= {
+	is_out   => 1,
+	in       => $out,
+	category => $::opt_c ? categorize_files([ $out ], $::opt_v) : '',
+    };
+    $i->{out}->{$in} = 1;
+}
+
+
+sub trim_name {		# reduce/tidy file paths from diff lines
+    my $name = shift;
+    $name = "$name ($in)" if $name eq "/dev/null";
+    $name =~ s:\\:/:g;	# adjust windows paths
+    $name =~ s://:/:g;	# simplify (and make win \\share into absolute path)
+    if (defined $::opt_p) {
+	# strip on -p levels of directory prefix
+	my $dc = $::opt_p;
+	$name =~ s:^[^/]+/(.+)$:$1: while $dc-- > 0;
+    }
+    else {	# try to strip off leading path to perl directory
+	# if absolute path, strip down to any *perl* directory first
+	$name =~ s:^/.*?perl.*?/::i;
+	$name =~ s:.*perl[-_]?5?[._]?[-_a-z0-9.+]*/::i;
+	$name =~ s:^\./::;
+    }
+    return $name;
+}
+
+
+sub list_files_by_patch {
+    my($ls, $name) = @_;
+    $name = $ls->{in} unless defined $name;
+    my @meta;
+    if ($::opt_m) {
+	my $meta;
+	foreach $meta (@show_meta) {
+	    next unless $ls->{$meta};
+	    my @list = sort keys %{$ls->{$meta}};
+	    push @meta, sprintf "%7s:  ", $meta;
+	    if ($meta eq 'Title') {
+		@list = map { "\"$_\""; } @list;
+		push @list, "#$1" if $::opt_C && $ls->{in} =~ m:\b(\w\d+)/patch$:;
+	    }
+	    elsif ($meta eq 'From') {
+		# fix-up bizzare addresses from japan and ibm :-)
+		foreach(@list) {
+		    s:\W+=?iso.*?<: <:;
+		    s/\d\d-\w\w\w-\d{4}\s+\d\d:\S+\s*//;
+		}
+	    }
+	    elsif ($meta eq 'Msg-ID') {
+		my %from; # limit long threads to one msg-id per site
+		@list = map {
+		    $from{(/@(.*?)>/ ? $1 : $_)}++ ? () : ($_);
+		} @list;
+	    }
+	    push @meta, my_wrap("","          ", join(", ",@list)."\n");
+	}
+	$name = "\n$name" if @meta and $name;
+    }
+    # don't print the header unless the file contains something interesting
+    return if !@meta and !$ls->{out} and !$::opt_v;
+    if ($::opt_l) {	# -l = no listing, just names
+	print "$ls->{in}";
+	my $n = keys %{ $ls->{out} };
+	print " ($n patches)" if $::opt_n and $n>1;
+	print "\n";
+	return;
+    }
+
+    # a twisty maze of little options
+    my $cat = ($ls->{category} and !$::opt_m) ? "\t$ls->{category}" : "";
+    print "$name$cat: "	unless ($::opt_h and !$::opt_v) or !"$name$cat";
+    print join('',"\n",@meta) if @meta;
+
+    return if $::opt_m && !$show_meta{Files};
+    my @v = sort PATORDER keys %{ $ls->{out} };
+    my $n = @v;
+    my $v = "@v";
+    print $::opt_m ? "  Files:  ".my_wrap("","          ",$v) : $v;
+    print " ($n patches)" if $::opt_n and $n>1;
+    print "\n";
+}
+
+
+sub my_wrap {
+	my $txt = eval { expand(wrap(@_)) };	# die's on long lines!
+    return $txt unless $@;
+	return expand("@_");
+}
+
+
+
+sub categorize_files {
+    my($files, $verb) = @_;
+    my(%c, $refine);
+
+    foreach (@$files) {	# assign a score to a file path
+	# the order of some of the tests is important
+	$c{TEST} += 5,next   if m:^t/:;
+	$c{DOC}  += 5,next   if m:^pod/:;
+	$c{UTIL} += 10,next  if m:^(utils|x2p|h2pl)/:;
+	$c{PORT1}+= 15,next  if m:^win32:;
+	$c{PORT2} += 15,next
+	    if m:^(cygwin32|os2|plan9|qnx|vms)/:
+	    or m:^(hints|Porting|ext/DynaLoader)/:
+	    or m:^README\.:;
+	$c{EXT}  += 10,next
+	    if m:^(ext|lib/ExtUtils)/:;
+	$c{LIB}  += 10,next
+	    if m:^(lib)/:;
+	$c{'CORE'} += 15,next
+	    if m:^[^/]+[\._]([chH]|sym|pl)$:;
+	$c{BUILD} += 10,next
+	    if m:^[A-Z]+$: or m:^[^/]+\.SH$:
+	    or m:^(install|configure|configpm):i;
+	print "Couldn't categorise $_\n" if $::opt_v;
+	$c{OTHER} += 1;
+    }
+    if (keys %c > 1) {	# sort to find category with highest score
+      refine:
+	++$refine;
+	my @c = sort { $c{$b} <=> $c{$a} || $a cmp $b } keys %c;
+	my @v = map  { $c{$_} } @c;
+	if (@v > 1 and $refine <= 1 and "@v" =~ /^(\d) \1/
+		and $c[0] =~ m/^(DOC|TESTS|OTHER)/) { # rare
+	    print "Tie, promoting $c[1] over $c[0]\n" if $::opt_d;
+	    ++$c{$c[1]};
+	    goto refine;
+	}
+	print "  ".@$files." patches: ", join(", ", map { "$_: $c{$_}" } @c),".\n"
+	    if $verb;
+	return $c[0] || 'OTHER';
+    }
+    else {
+	my($c, $v) = %c;
+	$c ||= 'UNKNOWN'; $v ||= 0;
+	print "  ".@$files." patches: $c: $v\n" if $verb;
+	return $c;
+    }
+}
+
+
+sub PATORDER {		# PATORDER sort by Chip Salzenberg
+    my ($i, $j);
+
+    $i = ($a =~ m#^[A-Z]+$#);
+    $j = ($b =~ m#^[A-Z]+$#);
+    return $j - $i if $i != $j;
+
+    $i = ($a =~ m#configure|hint#i) || ($a =~ m#[S_]H$#);
+    $j = ($b =~ m#configure|hint#i) || ($b =~ m#[S_]H$#);
+    return $j - $i if $i != $j;
+
+    $i = ($a =~ m#\.pod$#);
+    $j = ($b =~ m#\.pod$#);
+    return $j - $i if $i != $j;
+
+    $i = ($a =~ m#include/#);
+    $j = ($b =~ m#include/#);
+    return $j - $i if $i != $j;
+
+    if ((($i = $a) =~ s#/+[^/]*$##)
+	&& (($j = $b) =~ s#/+[^/]*$##)) {
+	    return $i cmp $j if $i ne $j;
+    }
+
+    $i = ($a =~ m#\.h$#);
+    $j = ($b =~ m#\.h$#);
+    return $j - $i if $i != $j;
+
+    return $a cmp $b;
+}
+

contrib/perl5/README

@@ -0,0 +1,102 @@
+
+			   Perl Kit, Version 5.0
+
+		       Copyright 1989-1997, Larry Wall
+			    All rights reserved.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of either:
+
+	a) the GNU General Public License as published by the Free
+	Software Foundation; either version 1, or (at your option) any
+	later version, or
+
+	b) the "Artistic License" which comes with this Kit.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this
+    Kit, in the file named "Artistic".  If not, I'll be glad to provide one.
+
+    You should also have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+    For those of you that choose to use the GNU General Public License,
+    my interpretation of the GNU General Public License is that no Perl
+    script falls under the terms of the GPL unless you explicitly put
+    said script under the terms of the GPL yourself.  Furthermore, any
+    object code linked with perl does not automatically fall under the
+    terms of the GPL, provided such object code only adds definitions
+    of subroutines and variables, and does not otherwise impair the
+    resulting interpreter from executing any standard Perl script.  I
+    consider linking in C subroutines in this manner to be the moral
+    equivalent of defining subroutines in the Perl language itself.  You
+    may sell such an object file as proprietary provided that you provide
+    or offer to provide the Perl source, as specified by the GNU General
+    Public License.  (This is merely an alternate way of specifying input
+    to the program.)  You may also sell a binary produced by the dumping of
+    a running Perl script that belongs to you, provided that you provide or
+    offer to provide the Perl source as specified by the GPL.  (The
+    fact that a Perl interpreter and your code are in the same binary file
+    is, in this case, a form of mere aggregation.)  This is my interpretation
+    of the GPL.  If you still have concerns or difficulties understanding
+    my intent, feel free to contact me.  Of course, the Artistic License
+    spells all this out for your protection, so you may prefer to use that.
+
+--------------------------------------------------------------------------
+
+Perl is a language that combines some of the features of C, sed, awk
+and shell.  See the manual page for more hype.  There are also two Nutshell
+Handbooks published by O'Reilly & Assoc.  See pod/perlbook.pod
+for more information.
+
+Please read all the directions below before you proceed any further, and
+then follow them carefully.
+
+After you have unpacked your kit, you should have all the files listed
+in MANIFEST.
+
+Installation
+
+1) Detailed instructions are in the file INSTALL which you should read.
+In brief, the following should work on most systems:
+	rm -f config.sh
+	sh Configure
+	make
+	make test
+	make install
+For most systems, it should be safe to accept all the Configure defaults.
+(It is recommended that you accept the defaults the first time you build
+or if you have any problems building.)
+
+2) Read the manual entries before running perl.
+
+3) IMPORTANT!  Help save the world!  Communicate any problems and suggested
+patches to perlbug@perl.com so we can keep the world in sync.
+If you have a problem, there's someone else out there who either has had
+or will have the same problem.  It's usually helpful if you send the
+output of the "myconfig" script in the main perl directory.
+
+If you've succeeded in compiling perl, the perlbug script in the utils/
+subdirectory can be used to help mail in a bug report.
+
+If possible, send in patches such that the patch program will apply them.
+Context diffs are the best, then normal diffs.  Don't send ed scripts--
+I've probably changed my copy since the version you have.
+
+Watch for perl patches in comp.lang.perl.announce.  Patches will generally
+be in a form usable by the patch program.  If you are just now bringing
+up perl and aren't sure how many patches there are, write to me and I'll
+send any you don't have.  Your current patch level is shown in
+patchlevel.h.
+
+
+Just a personal note:  I want you to know that I create nice things like this
+because it pleases the Author of my story.  If this bothers you, then your
+notion of Authorship needs some revision.  But you can use perl anyway. :-)
+
+							The author.

contrib/perl5/README.threads

@@ -0,0 +1,277 @@
+Building
+
+If you want to build with multi-threading support and you are
+running one of the following:
+
+  * Linux 2.x (with the LinuxThreads library installed: that's
+    the linuxthreads and linuxthreads-devel RPMs for RedHat)
+
+  * Digital UNIX 4.x
+
+  * Digital UNIX 3.x (Formerly DEC OSF/1), see additional note below
+
+  * Solaris 2.x for recentish x (2.5 is OK)
+
+  * IRIX 6.2 or newer. 6.2 will require a few os patches.
+    IMPORTANT: Without patch 2401, a kernel bug in IRIX 6.2 will
+    cause your machine to panic and crash when running threaded perl.
+    IRIX 6.3 and up should be OK. See lower down for patch details.
+
+then you should be able to use
+
+    ./Configure -Dusethreads -des
+    make
+
+and ignore the rest of this "Building" section. If it doesn't
+work or you are using another platform which you believe supports
+POSIX.1c threads then read on.  Additional information may be in
+a platform-specific "hints" file in the hints/ subdirectory.
+
+Omit the -d from your ./Configure arguments. For example, use
+
+    ./Configure -Dusethreads
+
+When Configure prompts you for ccflags, insert any other arguments in
+there that your compiler needs to use POSIX threads. When Configure
+prompts you for linking flags, include any flags required for
+threading (usually nothing special is required here).  Finally, when
+COnfigure prompts you for libraries, include any necessary libraries
+(e.g. -lpthread).  Pay attention to the order of libraries.  It is
+probably necessary to specify your threading library *before* your
+standard C library, e.g.  it might be necessary to have -lpthread -lc,
+instead of -lc -lpthread.
+
+Once you have specified all your compiler flags, you can have Configure
+accept all the defaults for the remainder of the session by typing  &-d
+at any Configure prompt.
+
+Some additional notes (some of these may be obsolete now, other items
+may be handled automatically):
+
+For Digital Unix 4.x:
+    Add -pthread to ccflags
+    Add -pthread to ldflags
+    Add -lpthread -lc_r to lddlflags
+
+    For some reason, the extra includes for pthreads make Digital UNIX
+    complain fatally about the sbrk() delcaration in perl's malloc.c
+    so use the native malloc, e.g.  sh Configure -Uusemymalloc, or
+    manually edit your config.sh as follows:
+	Change usemymalloc to n
+	Zap mallocobj and mallocsrc (foo='')
+	Change d_mymalloc to undef
+
+For Digital Unix 3.x (Formerly DEC OSF/1):
+    Add -DOLD_PTHREADS_API to ccflags
+    If compiling with the GNU cc compiler, remove -thread from ccflags
+
+    (The following should be done automatically if you call Configure
+      with the -Dusethreads option).
+    Add -lpthread -lmach -lc_r to libs (in the order specified).
+
+For IRIX:
+    (This should all be done automatically by the hint file).
+    Add -lpthread to libs
+    For IRIX 6.2, you have to have the following patches installed:
+	1404 Irix 6.2 Posix 1003.1b man pages
+	1645 IRIX 6.2 & 6.3 POSIX header file updates
+	2000 Irix 6.2 Posix 1003.1b support modules
+	2254 Pthread library fixes
+	2401 6.2 all platform kernel rollup
+    IMPORTANT: Without patch 2401, a kernel bug in IRIX 6.2 will
+    cause your machine to panic and crash when running threaded perl.
+    IRIX 6.3 and up should be OK.
+
+    For IRIX 6.3 and 6.4 the pthreads should work out of the box.
+    Thanks to Hannu Napari <Hannu.Napari@hut.fi> for the IRIX
+    pthreads patches information.
+For AIX:
+    (This should all be done automatically by the hint file).
+    Change cc to xlc_r or cc_r.
+    Add -DNEED_PTHREAD_INIT to ccflags and cppflags
+    Add -lc_r to libswanted
+    Change -lc in lddflags to be -lpthread -lc_r -lc
+
+Now you can do a
+    make
+
+
+O/S specific bugs
+
+Irix 6.2:  See the Irix warning above.
+
+LinuxThreads 0.5 has a bug which can cause file descriptor 0 to be
+closed after a fork() leading to many strange symptoms. Version 0.6
+has this fixed but the following patch can be applied to 0.5 for now:
+
+----------------------------- cut here -----------------------------
+--- linuxthreads-0.5/pthread.c.ORI	Mon Oct  6 13:55:50 1997
++++ linuxthreads-0.5/pthread.c	Mon Oct  6 13:57:24 1997
+@@ -312,8 +312,10 @@
+   free(pthread_manager_thread_bos);
+   pthread_manager_thread_bos = pthread_manager_thread_tos = NULL;
+   /* Close the two ends of the pipe */
+-  close(pthread_manager_request);
+-  close(pthread_manager_reader);
++  if (pthread_manager_request >= 0) {
++    close(pthread_manager_request);
++    close(pthread_manager_reader);
++  }
+   pthread_manager_request = pthread_manager_reader = -1;
+   /* Update the pid of the main thread */
+   self->p_pid = getpid();
+----------------------------- cut here -----------------------------
+
+
+Building the Thread extension
+
+The Thread extension is now part of the main perl distribution tree.
+If you did Configure -Dusethreads then it will have been added to
+the list of extensions automatically.
+
+You can try some of the tests with
+    cd ext/Thread
+    perl create.t
+    perl join.t
+    perl lock.t
+    perl io.t
+etc.
+The io one leaves a thread reading from the keyboard on stdin so
+as the ping messages appear you can type lines and see them echoed.
+
+Try running the main perl test suite too. There are known
+failures for some of the DBM/DB extensions (if their underlying
+libraries were not compiled to be thread-aware).
+
+
+Bugs
+
+* FAKE_THREADS should produce a working perl but the Thread
+extension won't build with it yet.
+
+* There's a known memory leak (curstack isn't freed at the end
+of each thread because it causes refcount problems that I
+haven't tracked down yet) and there are very probably others too.
+
+* There may still be races where bugs show up under contention.
+
+* Need to document "lock", Thread.pm, Queue.pm, ...
+
+
+Debugging
+
+Use the -DS command-line option to turn on debugging of the
+multi-threading code. Under Linux, that also turns on a quick
+hack I did to grab a bit of extra information from segfaults.
+If you have a fancier gdb/threads setup than I do then you'll
+have to delete the lines in perl.c which say
+    #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
+        DEBUG_S(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
+    #endif
+
+
+Background
+
+Some old globals (e.g. stack_sp, op) and some old per-interpreter
+variables (e.g. tmps_stack, cxstack) move into struct thread.
+All fields of struct thread which derived from original perl
+variables have names of the form Tfoo. For example, stack_sp becomes
+the field Tstack_sp of struct thread. For those fields which moved
+from original perl, thread.h does
+    #define foo (thr->Tfoo)
+This means that all functions in perl which need to use one of these
+fields need an (automatic) variable thr which points at the current
+thread's struct thread. For pp_foo functions, it is passed around as
+an argument, for other functions they do
+    dTHR;
+which declares and initialises thr from thread-specific data
+via pthread_getspecific. If a function fails to compile with an
+error about "no such variable thr", it probably just needs a dTHR
+at the top.
+
+
+Fake threads
+
+For FAKE_THREADS, thr is a global variable and perl schedules threads
+by altering thr in between appropriate ops. The next and prev fields
+of struct thread keep all fake threads on a doubly linked list and
+the next_run and prev_run fields keep all runnable threads on a
+doubly linked list. Mutexes are stubs for FAKE_THREADS. Condition
+variables are implemented as a list of waiting threads.
+
+
+Mutexes and condition variables
+
+The API is via macros MUTEX_{INIT,LOCK,UNLOCK,DESTROY} and
+COND_{INIT,WAIT,SIGNAL,BROADCAST,DESTROY}.
+
+A mutex is only required to be a simple, fast mutex (e.g. it does not
+have to be recursive). It is only ever held across very short pieces
+of code. Condition variables are only ever signalled/broadcast while
+their associated mutex is held. (This constraint simplifies the
+implementation of condition variables in certain porting situations.)
+For POSIX threads, perl mutexes and condition variables correspond to
+POSIX ones.  For FAKE_THREADS, mutexes are stubs and condition variables
+are implmented as lists of waiting threads. For FAKE_THREADS, a thread
+waits on a condition variable by removing itself from the runnable
+list, calling SCHEDULE to change thr to the next appropriate
+runnable thread and returning op (i.e. the new threads next op).
+This means that fake threads can only block while in PP code.
+A PP function which contains a COND_WAIT must be prepared to
+handle such restarts and can use the field "private" of struct
+thread to record its state. For fake threads, COND_SIGNAL and
+COND_BROADCAST work by putting back all the threads on the
+condition variables list into the run queue. Note that a mutex
+must *not* be held while returning from a PP function.
+
+Perl locks and condition variables are both implemented as a
+condpair_t structure, containing a mutex, an "owner" condition
+variable, an owner thread field and another condition variable).
+The structure is attached by 'm' magic to any SV. pp_lock locks
+such an object by waiting on the ownercond condition variable until
+the owner field is zero and then setting the owner field to its own
+thread pointer. The lock is semantically recursive so if the owner
+field already matches the current thread then pp_lock returns
+straight away. If the owner field has to be filled in then
+unlock_condpair is queued as an end-of-block destructor and
+that function zeroes out the owner field and signals the ownercond
+condition variable, thus waking up any other thread that wants to
+lock it. When used as a condition variable, the condpair is locked
+(involving the above wait-for-ownership and setting the owner field)
+and the spare condition variable field is used for waiting on.
+
+
+Thread states
+
+
+              $t->join
+R_JOINABLE ---------------------> R_JOINED >----\
+    |      \  pthread_join(t)         |  ^      |
+    |       \                         |  | join | pthread_join
+    |        \                        |  |      |
+    |         \                       |  \------/
+    |          \                      |
+    |           \                     |
+    |  $t->detach\ pthread_detach     |
+    |            _\|                  |
+ends|             R_DETACHED     ends | unlink
+    |                       \         |
+    |                   ends \ unlink |
+    |                         \       |
+    |                          \      |
+    |                           \     |
+    |                            \    |
+    |                             \   |
+    V    join          detach     _\| V
+ZOMBIE ----------------------------> DEAD
+       pthread_join   pthread_detach
+       and unlink     and unlink
+
+
+
+Malcolm Beattie
+mbeattie@sable.ox.ac.uk
+Last updated: 27 November 1997
+
+Configure-related info updated 16 July 1998 by
+Andy Dougherty <doughera@lafayette.edu>

contrib/perl5/Todo

@@ -0,0 +1,57 @@
+Tie Modules
+	VecArray		Implement array using vec()
+	SubstrArray		Implement array using substr()
+	VirtualArray		Implement array using a file
+	ShiftSplice		Defines shift et al in terms of splice method
+
+Would be nice to have
+	pack "(stuff)*"
+	Contiguous bitfields in pack/unpack
+	lexperl
+	Bundled perl preprocessor
+	Use posix calls internally where possible
+	gettimeofday
+	format BOTTOM
+	-iprefix.
+	-i rename file only when successfully changed
+	All ARGV input should act like <>
+	report HANDLE [formats].
+	support in perlmain to rerun debugger
+	regression tests using __DIE__ hook
+	reference to compiled regexp
+	lexically scoped functions: my sub foo { ... }
+	lvalue functions
+	regression/sanity tests for suidperl
+	Full 64 bit support (i.e. "long long")
+
+Possible pragmas
+	debugger
+	optimize (use less memory, CPU)
+
+Optimizations
+	constant function cache
+	switch structures
+	eval qw() at compile time
+	foreach(reverse...)
+	Set KEEP on constant split
+	Cache eval tree (unless lexical outer scope used (mark in &compiling?))
+	rcatmaybe
+	Shrink opcode tables via multiple implementations selected in peep
+	Cache hash value?  (Not a win, according to Guido)
+	Optimize away @_ where possible
+	"one pass" global destruction
+	Optimize sort by { $a <=> $b }
+	Rewrite regexp parser for better integrated optimization
+	LRU cache of regexp: foreach $pat (@pats) { foo() if /$pat/ }
+
+Vague possibilities
+	ref function in list context
+	make tr/// return histogram in list context?
+	Loop control on do{} et al
+	Explicit switch statements
+	built-in globbing
+	compile to real threaded code
+	structured types
+	autocroak?
+	Modifiable $1 et al
+

contrib/perl5/Todo-5.005

@@ -0,0 +1,68 @@
+Multi-threading
+    $AUTOLOAD. Hmm.
+    without USE_THREADS, change extern variable for dTHR
+    consistent semantics for exit/die in threads
+    SvREFCNT_dec(curstack) in threadstart() in Thread.xs
+    better support for externally created threads
+    Thread::Pool
+    more Configure support
+    spot-check globals like statcache and global GVs for thread-safety
+
+Compiler
+    auto-produce executable
+    typed lexicals should affect B::CC::load_pad
+    workarounds to help Win32
+    $^C to track compiler/checker status
+    END blocks need saving in compiled output
+    _AUTOLOAD prodding
+    fix comppadlist (names in comppad_name can have fake SvCUR
+	from where newASSIGNOP steals the field)
+
+Namespace cleanup
+    symbol-space: "pl_" prefix for all global vars
+                  "Perl_" prefix for all functions
+    CPP-space:	  restrict what we export from headers
+                  stop malloc()/free() pollution unless asked
+    header-space: move into CORE/perl/
+    API-space:    begin list of things that constitute public api
+
+MULTIPLICITY support
+    complete work on safe recursive interpreters, C<Perl->new()>
+
+Configure
+    installation layout changes to avoid overwriting old versions
+
+Reliable Signals
+    alternate runops() for signal despatch
+    figure out how to die() in delayed sighandler
+    add tests for Thread::Signal
+
+Win32 stuff
+    automate maintenance of most PERL_OBJECT code
+    get PERL_OBJECT building under gcc
+    rename new headers to be consistent with the rest
+    sort out the spawnvp() mess
+    work out DLL versioning
+    put perlobject in $ARCHNAME so it can coexist with rest
+    get PERL_OBJECT building on non-win32?
+    style-check
+
+Miscellaneous
+    rename and alter ISA.pm
+    magic_setisa should be made to update %FIELDS [???]
+    be generous in accepting foreign line terminations
+    make filenames 8.3 friendly, where feasible
+    upgrade to newer versions of all independently maintained modules
+    add new modules (Data-Dumper, Storable?)
+    test it with large parts of CPAN
+    fix pod2html to generate relative URLs
+
+Documentation
+    comprehensive perldelta.pod
+    describe new age patterns
+    update perl{guts,call,embed,xs} with additions, changes to API
+    document Win32 choices
+    rework INSTALL to reflect changes in installation structure
+    spot-check all new modules for completeness
+    better docs for pack()/unpack()
+    add perlport.pod

contrib/perl5/XSUB.h

@@ -0,0 +1,93 @@
+#define ST(off) PL_stack_base[ax + (off)]
+
+#ifdef CAN_PROTOTYPE
+#ifdef PERL_OBJECT
+#define XS(name) void name(CV* cv, CPerlObj* pPerl)
+#else
+#define XS(name) void name(CV* cv)
+#endif
+#else
+#define XS(name) void name(cv) CV* cv;
+#endif
+
+#define dXSARGS				\
+	dSP; dMARK;			\
+	I32 ax = mark - PL_stack_base + 1;	\
+	I32 items = sp - mark
+
+#define XSANY CvXSUBANY(cv)
+
+#define dXSI32 I32 ix = XSANY.any_i32
+
+#ifdef __cplusplus
+#  define XSINTERFACE_CVT(ret,name) ret (*name)(...)
+#else
+#  define XSINTERFACE_CVT(ret,name) ret (*name)()
+#endif
+#define dXSFUNCTION(ret)		XSINTERFACE_CVT(ret,XSFUNCTION)
+#define XSINTERFACE_FUNC(ret,cv,f)	((XSINTERFACE_CVT(ret,))(f))
+#define XSINTERFACE_FUNC_SET(cv,f)	\
+		CvXSUBANY(cv).any_dptr = (void (*) _((void*)))(f)
+
+#define XSRETURN(off)					\
+    STMT_START {					\
+	PL_stack_sp = PL_stack_base + ax + ((off) - 1);	\
+	return;						\
+    } STMT_END
+
+/* Simple macros to put new mortal values onto the stack.   */
+/* Typically used to return values from XS functions.       */
+#define XST_mIV(i,v)  (ST(i) = sv_2mortal(newSViv(v))  )
+#define XST_mNV(i,v)  (ST(i) = sv_2mortal(newSVnv(v))  )
+#define XST_mPV(i,v)  (ST(i) = sv_2mortal(newSVpv(v,0)))
+#define XST_mNO(i)    (ST(i) = &PL_sv_no   )
+#define XST_mYES(i)   (ST(i) = &PL_sv_yes  )
+#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef)
+ 
+#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_NO    STMT_START { XST_mNO(0);    XSRETURN(1); } STMT_END
+#define XSRETURN_YES   STMT_START { XST_mYES(0);   XSRETURN(1); } STMT_END
+#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END
+#define XSRETURN_EMPTY STMT_START {                XSRETURN(0); } STMT_END
+
+#define newXSproto(a,b,c,d)	sv_setpv((SV*)newXS(a,b,c), d)
+
+#ifdef XS_VERSION
+# define XS_VERSION_BOOTCHECK \
+    STMT_START {							\
+	SV *tmpsv;							\
+	char *vn = Nullch, *module = SvPV(ST(0),PL_na);			\
+	if (items >= 2)	 /* version supplied as bootstrap arg */	\
+	    tmpsv = ST(1);						\
+	else {								\
+	    /* XXX GV_ADDWARN */					\
+	    tmpsv = perl_get_sv(form("%s::%s", module,			\
+				  vn = "XS_VERSION"), FALSE);		\
+	    if (!tmpsv || !SvOK(tmpsv))					\
+		tmpsv = perl_get_sv(form("%s::%s", module,		\
+				      vn = "VERSION"), FALSE);		\
+	}								\
+	if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na))))	\
+	    croak("%s object version %s does not match %s%s%s%s %_",	\
+		  module, XS_VERSION,					\
+		  vn ? "$" : "", vn ? module : "", vn ? "::" : "",	\
+		  vn ? vn : "bootstrap parameter", tmpsv);		\
+    } STMT_END
+#else
+# define XS_VERSION_BOOTCHECK
+#endif
+
+#ifdef PERL_OBJECT
+#include "objXSUB.h"
+#ifndef NO_XSLOCKS
+#ifdef WIN32
+#include "XSlock.h"
+#endif  /* WIN32 */
+#endif  /* NO_XSLOCKS */
+#else
+#ifdef PERL_CAPI
+#include "perlCAPI.h"
+#endif
+#endif	/* PERL_OBJECT */

contrib/perl5/XSlock.h

@@ -0,0 +1,35 @@
+#ifndef __XSlock_h__
+#define __XSlock_h__
+
+class XSLockManager
+{
+public:
+	XSLockManager() { InitializeCriticalSection(&cs); };
+	~XSLockManager() { DeleteCriticalSection(&cs); };
+	void Enter(void) { EnterCriticalSection(&cs); };
+	void Leave(void) { LeaveCriticalSection(&cs); };
+protected:
+	CRITICAL_SECTION cs;
+};
+
+XSLockManager g_XSLock;
+
+class XSLock
+{
+public:
+	XSLock() { g_XSLock.Enter(); };
+	~XSLock() { g_XSLock.Leave(); };
+};
+
+CPerlObj* pPerl;
+
+#undef dXSARGS
+#define dXSARGS	\
+	dSP; dMARK;		\
+	I32 ax = mark - PL_stack_base + 1;	\
+	I32 items = sp - mark; \
+	XSLock localLock; \
+	::pPerl = pPerl
+
+
+#endif

contrib/perl5/av.c

@@ -0,0 +1,658 @@
+/*    av.c
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "...for the Entwives desired order, and plenty, and peace (by which they
+ * meant that things should remain where they had set them)." --Treebeard
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void
+av_reify(AV *av)
+{
+    I32 key;
+    SV* sv;
+
+    if (AvREAL(av))
+	return;
+#ifdef DEBUGGING
+    if (SvRMAGICAL(av) && mg_find((SV*)av,'P'))
+	warn("av_reify called on tied array");
+#endif
+    key = AvMAX(av) + 1;
+    while (key > AvFILLp(av) + 1)
+	AvARRAY(av)[--key] = &PL_sv_undef;
+    while (key) {
+	sv = AvARRAY(av)[--key];
+	assert(sv);
+	if (sv != &PL_sv_undef) {
+	    dTHR;
+	    (void)SvREFCNT_inc(sv);
+	}
+    }
+    key = AvARRAY(av) - AvALLOC(av);
+    while (key)
+	AvALLOC(av)[--key] = &PL_sv_undef;
+    AvREAL_on(av);
+}
+
+void
+av_extend(AV *av, I32 key)
+{
+    dTHR;			/* only necessary if we have to extend stack */
+    MAGIC *mg;
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,2);
+	PUSHs(mg->mg_obj);
+	PUSHs(sv_2mortal(newSViv(key+1)));
+        PUTBACK;
+	perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
+	POPSTACK;
+	FREETMPS;
+	LEAVE;
+	return;
+    }
+    if (key > AvMAX(av)) {
+	SV** ary;
+	I32 tmp;
+	I32 newmax;
+
+	if (AvALLOC(av) != AvARRAY(av)) {
+	    ary = AvALLOC(av) + AvFILLp(av) + 1;
+	    tmp = AvARRAY(av) - AvALLOC(av);
+	    Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
+	    AvMAX(av) += tmp;
+	    SvPVX(av) = (char*)AvALLOC(av);
+	    if (AvREAL(av)) {
+		while (tmp)
+		    ary[--tmp] = &PL_sv_undef;
+	    }
+	    
+	    if (key > AvMAX(av) - 10) {
+		newmax = key + AvMAX(av);
+		goto resize;
+	    }
+	}
+	else {
+	    if (AvALLOC(av)) {
+#ifndef STRANGE_MALLOC
+		U32 bytes;
+#endif
+
+#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
+		newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
+
+		if (key <= newmax) 
+		    goto resized;
+#endif 
+		newmax = key + AvMAX(av) / 5;
+	      resize:
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+		Renew(AvALLOC(av),newmax+1, SV*);
+#else
+		bytes = (newmax + 1) * sizeof(SV*);
+#define MALLOC_OVERHEAD 16
+		tmp = MALLOC_OVERHEAD;
+		while (tmp - MALLOC_OVERHEAD < bytes)
+		    tmp += tmp;
+		tmp -= MALLOC_OVERHEAD;
+		tmp /= sizeof(SV*);
+		assert(tmp > newmax);
+		newmax = tmp - 1;
+		New(2,ary, newmax+1, SV*);
+		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
+		if (AvMAX(av) > 64)
+		    offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
+		else
+		    Safefree(AvALLOC(av));
+		AvALLOC(av) = ary;
+#endif
+	      resized:
+		ary = AvALLOC(av) + AvMAX(av) + 1;
+		tmp = newmax - AvMAX(av);
+		if (av == PL_curstack) {	/* Oops, grew stack (via av_store()?) */
+		    PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
+		    PL_stack_base = AvALLOC(av);
+		    PL_stack_max = PL_stack_base + newmax;
+		}
+	    }
+	    else {
+		newmax = key < 3 ? 3 : key;
+		New(2,AvALLOC(av), newmax+1, SV*);
+		ary = AvALLOC(av) + 1;
+		tmp = newmax;
+		AvALLOC(av)[0] = &PL_sv_undef;	/* For the stacks */
+	    }
+	    if (AvREAL(av)) {
+		while (tmp)
+		    ary[--tmp] = &PL_sv_undef;
+	    }
+	    
+	    SvPVX(av) = (char*)AvALLOC(av);
+	    AvMAX(av) = newmax;
+	}
+    }
+}
+
+SV**
+av_fetch(register AV *av, I32 key, I32 lval)
+{
+    SV *sv;
+
+    if (!av)
+	return 0;
+
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return 0;
+    }
+
+    if (SvRMAGICAL(av)) {
+	if (mg_find((SV*)av,'P')) {
+	    dTHR;
+	    sv = sv_newmortal();
+	    mg_copy((SV*)av, sv, 0, key);
+	    PL_av_fetch_sv = sv;
+	    return &PL_av_fetch_sv;
+	}
+    }
+
+    if (key > AvFILLp(av)) {
+	if (!lval)
+	    return 0;
+	if (AvREALISH(av))
+	    sv = NEWSV(5,0);
+	else
+	    sv = sv_newmortal();
+	return av_store(av,key,sv);
+    }
+    if (AvARRAY(av)[key] == &PL_sv_undef) {
+    emptyness:
+	if (lval) {
+	    sv = NEWSV(6,0);
+	    return av_store(av,key,sv);
+	}
+	return 0;
+    }
+    else if (AvREIFY(av)
+	     && (!AvARRAY(av)[key]	/* eg. @_ could have freed elts */
+		 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
+	AvARRAY(av)[key] = &PL_sv_undef;	/* 1/2 reify */
+	goto emptyness;
+    }
+    return &AvARRAY(av)[key];
+}
+
+SV**
+av_store(register AV *av, I32 key, SV *val)
+{
+    SV** ary;
+    U32  fill;
+
+
+    if (!av)
+	return 0;
+    if (!val)
+	val = &PL_sv_undef;
+
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return 0;
+    }
+
+    if (SvREADONLY(av) && key >= AvFILL(av))
+	croak(no_modify);
+
+    if (SvRMAGICAL(av)) {
+	if (mg_find((SV*)av,'P')) {
+	    if (val != &PL_sv_undef) {
+		mg_copy((SV*)av, val, 0, key);
+	    }
+	    return 0;
+	}
+    }
+
+    if (!AvREAL(av) && AvREIFY(av))
+	av_reify(av);
+    if (key > AvMAX(av))
+	av_extend(av,key);
+    ary = AvARRAY(av);
+    if (AvFILLp(av) < key) {
+	if (!AvREAL(av)) {
+	    dTHR;
+	    if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
+		PL_stack_sp = PL_stack_base + key;	/* XPUSH in disguise */
+	    do
+		ary[++AvFILLp(av)] = &PL_sv_undef;
+	    while (AvFILLp(av) < key);
+	}
+	AvFILLp(av) = key;
+    }
+    else if (AvREAL(av))
+	SvREFCNT_dec(ary[key]);
+    ary[key] = val;
+    if (SvSMAGICAL(av)) {
+	if (val != &PL_sv_undef) {
+	    MAGIC* mg = SvMAGIC(av);
+	    sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
+	}
+	mg_set((SV*)av);
+    }
+    return &ary[key];
+}
+
+AV *
+newAV(void)
+{
+    register AV *av;
+
+    av = (AV*)NEWSV(3,0);
+    sv_upgrade((SV *)av, SVt_PVAV);
+    AvREAL_on(av);
+    AvALLOC(av) = 0;
+    SvPVX(av) = 0;
+    AvMAX(av) = AvFILLp(av) = -1;
+    return av;
+}
+
+AV *
+av_make(register I32 size, register SV **strp)
+{
+    register AV *av;
+    register I32 i;
+    register SV** ary;
+
+    av = (AV*)NEWSV(8,0);
+    sv_upgrade((SV *) av,SVt_PVAV);
+    AvFLAGS(av) = AVf_REAL;
+    if (size) {		/* `defined' was returning undef for size==0 anyway. */
+	New(4,ary,size,SV*);
+	AvALLOC(av) = ary;
+	SvPVX(av) = (char*)ary;
+	AvFILLp(av) = size - 1;
+	AvMAX(av) = size - 1;
+	for (i = 0; i < size; i++) {
+	    assert (*strp);
+	    ary[i] = NEWSV(7,0);
+	    sv_setsv(ary[i], *strp);
+	    strp++;
+	}
+    }
+    return av;
+}
+
+AV *
+av_fake(register I32 size, register SV **strp)
+{
+    register AV *av;
+    register SV** ary;
+
+    av = (AV*)NEWSV(9,0);
+    sv_upgrade((SV *)av, SVt_PVAV);
+    New(4,ary,size+1,SV*);
+    AvALLOC(av) = ary;
+    Copy(strp,ary,size,SV*);
+    AvFLAGS(av) = AVf_REIFY;
+    SvPVX(av) = (char*)ary;
+    AvFILLp(av) = size - 1;
+    AvMAX(av) = size - 1;
+    while (size--) {
+	assert (*strp);
+	SvTEMP_off(*strp);
+	strp++;
+    }
+    return av;
+}
+
+void
+av_clear(register AV *av)
+{
+    register I32 key;
+    SV** ary;
+
+#ifdef DEBUGGING
+    if (SvREFCNT(av) <= 0) {
+	warn("Attempt to clear deleted array");
+    }
+#endif
+    if (!av)
+	return;
+    /*SUPPRESS 560*/
+
+    if (SvREADONLY(av))
+	croak(no_modify);
+
+    /* Give any tie a chance to cleanup first */
+    if (SvRMAGICAL(av))
+	mg_clear((SV*)av); 
+
+    if (AvMAX(av) < 0)
+	return;
+
+    if (AvREAL(av)) {
+	ary = AvARRAY(av);
+	key = AvFILLp(av) + 1;
+	while (key) {
+	    SvREFCNT_dec(ary[--key]);
+	    ary[key] = &PL_sv_undef;
+	}
+    }
+    if (key = AvARRAY(av) - AvALLOC(av)) {
+	AvMAX(av) += key;
+	SvPVX(av) = (char*)AvALLOC(av);
+    }
+    AvFILLp(av) = -1;
+
+}
+
+void
+av_undef(register AV *av)
+{
+    register I32 key;
+
+    if (!av)
+	return;
+    /*SUPPRESS 560*/
+
+    /* Give any tie a chance to cleanup first */
+    if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) 
+	av_fill(av, -1);   /* mg_clear() ? */
+
+    if (AvREAL(av)) {
+	key = AvFILLp(av) + 1;
+	while (key)
+	    SvREFCNT_dec(AvARRAY(av)[--key]);
+    }
+    Safefree(AvALLOC(av));
+    AvALLOC(av) = 0;
+    SvPVX(av) = 0;
+    AvMAX(av) = AvFILLp(av) = -1;
+    if (AvARYLEN(av)) {
+	SvREFCNT_dec(AvARYLEN(av));
+	AvARYLEN(av) = 0;
+    }
+}
+
+void
+av_push(register AV *av, SV *val)
+{             
+    MAGIC *mg;
+    if (!av)
+	return;
+    if (SvREADONLY(av))
+	croak(no_modify);
+
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,2);
+	PUSHs(mg->mg_obj);
+	PUSHs(val);
+	PUTBACK;
+	ENTER;
+	perl_call_method("PUSH", G_SCALAR|G_DISCARD);
+	LEAVE;
+	POPSTACK;
+	return;
+    }
+    av_store(av,AvFILLp(av)+1,val);
+}
+
+SV *
+av_pop(register AV *av)
+{
+    SV *retval;
+    MAGIC* mg;
+
+    if (!av || AvFILL(av) < 0)
+	return &PL_sv_undef;
+    if (SvREADONLY(av))
+	croak(no_modify);
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;    
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	XPUSHs(mg->mg_obj);
+	PUTBACK;
+	ENTER;
+	if (perl_call_method("POP", G_SCALAR)) {
+	    retval = newSVsv(*PL_stack_sp--);    
+	} else {    
+	    retval = &PL_sv_undef;
+	}
+	LEAVE;
+	POPSTACK;
+	return retval;
+    }
+    retval = AvARRAY(av)[AvFILLp(av)];
+    AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
+    if (SvSMAGICAL(av))
+	mg_set((SV*)av);
+    return retval;
+}
+
+void
+av_unshift(register AV *av, register I32 num)
+{
+    register I32 i;
+    register SV **ary;
+    MAGIC* mg;
+
+    if (!av || num <= 0)
+	return;
+    if (SvREADONLY(av))
+	croak(no_modify);
+
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,1+num);
+	PUSHs(mg->mg_obj);
+	while (num-- > 0) {
+	    PUSHs(&PL_sv_undef);
+	}
+	PUTBACK;
+	ENTER;
+	perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD);
+	LEAVE;
+	POPSTACK;
+	return;
+    }
+
+    if (!AvREAL(av) && AvREIFY(av))
+	av_reify(av);
+    i = AvARRAY(av) - AvALLOC(av);
+    if (i) {
+	if (i > num)
+	    i = num;
+	num -= i;
+    
+	AvMAX(av) += i;
+	AvFILLp(av) += i;
+	SvPVX(av) = (char*)(AvARRAY(av) - i);
+    }
+    if (num) {
+	i = AvFILLp(av);
+	av_extend(av, i + num);
+	AvFILLp(av) += num;
+	ary = AvARRAY(av);
+	Move(ary, ary + num, i + 1, SV*);
+	do {
+	    ary[--num] = &PL_sv_undef;
+	} while (num);
+    }
+}
+
+SV *
+av_shift(register AV *av)
+{
+    SV *retval;
+    MAGIC* mg;
+
+    if (!av || AvFILL(av) < 0)
+	return &PL_sv_undef;
+    if (SvREADONLY(av))
+	croak(no_modify);
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	XPUSHs(mg->mg_obj);
+	PUTBACK;
+	ENTER;
+	if (perl_call_method("SHIFT", G_SCALAR)) {
+	    retval = newSVsv(*PL_stack_sp--);            
+	} else {    
+	    retval = &PL_sv_undef;
+	}     
+	LEAVE;
+	POPSTACK;
+	return retval;
+    }
+    retval = *AvARRAY(av);
+    if (AvREAL(av))
+	*AvARRAY(av) = &PL_sv_undef;
+    SvPVX(av) = (char*)(AvARRAY(av) + 1);
+    AvMAX(av)--;
+    AvFILLp(av)--;
+    if (SvSMAGICAL(av))
+	mg_set((SV*)av);
+    return retval;
+}
+
+I32
+av_len(register AV *av)
+{
+    return AvFILL(av);
+}
+
+void
+av_fill(register AV *av, I32 fill)
+{
+    MAGIC *mg;
+    if (!av)
+	croak("panic: null array");
+    if (fill < 0)
+	fill = -1;
+    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+	dSP;            
+	ENTER;
+	SAVETMPS;
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,2);
+	PUSHs(mg->mg_obj);
+	PUSHs(sv_2mortal(newSViv(fill+1)));
+	PUTBACK;
+	perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
+	POPSTACK;
+	FREETMPS;
+	LEAVE;
+	return;
+    }
+    if (fill <= AvMAX(av)) {
+	I32 key = AvFILLp(av);
+	SV** ary = AvARRAY(av);
+
+	if (AvREAL(av)) {
+	    while (key > fill) {
+		SvREFCNT_dec(ary[key]);
+		ary[key--] = &PL_sv_undef;
+	    }
+	}
+	else {
+	    while (key < fill)
+		ary[++key] = &PL_sv_undef;
+	}
+	    
+	AvFILLp(av) = fill;
+	if (SvSMAGICAL(av))
+	    mg_set((SV*)av);
+    }
+    else
+	(void)av_store(av,fill,&PL_sv_undef);
+}
+
+
+/* AVHV: Support for treating arrays as if they were hashes.  The
+ * first element of the array should be a hash reference that maps
+ * hash keys to array indices.
+ */
+
+STATIC I32
+avhv_index_sv(SV* sv)
+{
+    I32 index = SvIV(sv);
+    if (index < 1)
+	croak("Bad index while coercing array into hash");
+    return index;    
+}
+
+HV*
+avhv_keys(AV *av)
+{
+    SV **keysp = av_fetch(av, 0, FALSE);
+    if (keysp) {
+	SV *sv = *keysp;
+	if (SvGMAGICAL(sv))
+	    mg_get(sv);
+	if (SvROK(sv)) {
+	    sv = SvRV(sv);
+	    if (SvTYPE(sv) == SVt_PVHV)
+		return (HV*)sv;
+	}
+    }
+    croak("Can't coerce array into hash");
+    return Nullhv;
+}
+
+SV**
+avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
+{
+    SV **indsvp;
+    HV *keys = avhv_keys(av);
+    HE *he;
+    
+    he = hv_fetch_ent(keys, keysv, FALSE, hash);
+    if (!he)
+        croak("No such array field");
+    return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
+}
+
+bool
+avhv_exists_ent(AV *av, SV *keysv, U32 hash)
+{
+    HV *keys = avhv_keys(av);
+    return hv_exists_ent(keys, keysv, hash);
+}
+
+HE *
+avhv_iternext(AV *av)
+{
+    HV *keys = avhv_keys(av);
+    return hv_iternext(keys);
+}
+
+SV *
+avhv_iterval(AV *av, register HE *entry)
+{
+    SV *sv = hv_iterval(avhv_keys(av), entry);
+    return *av_fetch(av, avhv_index_sv(sv), TRUE);
+}

contrib/perl5/av.h

@@ -0,0 +1,51 @@
+/*    av.h
+ *
+ *    Copyright (c) 1991-1998, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+struct xpvav {
+    char*	xav_array;      /* pointer to first array element */
+    SSize_t	xav_fill;       /* Index of last element present */
+    SSize_t	xav_max;        /* Number of elements for which array has space */
+    IV		xof_off;	/* ptr is incremented by offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    SV**	xav_alloc;	/* pointer to malloced string */
+    SV*		xav_arylen;
+    U8		xav_flags;
+};
+
+#define AVf_REAL 1	/* free old entries */
+#define AVf_REIFY 2	/* can become real */
+#define AVf_REUSED 4	/* got undeffed--don't turn old memory into SVs now */
+
+#define Nullav Null(AV*)
+
+#define AvARRAY(av)	((SV**)((XPVAV*)  SvANY(av))->xav_array)
+#define AvALLOC(av)	((XPVAV*)  SvANY(av))->xav_alloc
+#define AvMAX(av)	((XPVAV*)  SvANY(av))->xav_max
+#define AvFILLp(av)	((XPVAV*)  SvANY(av))->xav_fill
+#define AvARYLEN(av)	((XPVAV*)  SvANY(av))->xav_arylen
+#define AvFLAGS(av)	((XPVAV*)  SvANY(av))->xav_flags
+
+#define AvREAL(av)	(AvFLAGS(av) & AVf_REAL)
+#define AvREAL_on(av)	(AvFLAGS(av) |= AVf_REAL)
+#define AvREAL_off(av)	(AvFLAGS(av) &= ~AVf_REAL)
+#define AvREIFY(av)	(AvFLAGS(av) & AVf_REIFY)
+#define AvREIFY_on(av)	(AvFLAGS(av) |= AVf_REIFY)
+#define AvREIFY_off(av)	(AvFLAGS(av) &= ~AVf_REIFY)
+#define AvREUSED(av)	(AvFLAGS(av) & AVf_REUSED)
+#define AvREUSED_on(av)	(AvFLAGS(av) |= AVf_REUSED)
+#define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
+
+#define AvREALISH(av)	(AvFLAGS(av) & (AVf_REAL|AVf_REIFY))
+                                          
+#define AvFILL(av)	((SvRMAGICAL((SV *) (av))) \
+			  ? mg_size((SV *) av) : AvFILLp(av))
+

contrib/perl5/bytecode.h

@@ -0,0 +1,161 @@
+typedef char *pvcontents;
+typedef char *strconst;
+typedef U32 PV;
+typedef char *op_tr_array;
+typedef int comment_t;
+typedef SV *svindex;
+typedef OP *opindex;
+typedef IV IV64;
+
+#ifdef INDIRECT_BGET_MACROS
+#define BGET_FREAD(argp, len, nelem)	\
+	 bs.fread((char*)(argp),(len),(nelem),bs.data)
+#define BGET_FGETC() bs.fgetc(bs.data)
+#else
+#define BGET_FREAD(argp, len, nelem) PerlIO_read(fp, (argp), (len)*(nelem))
+#define BGET_FGETC() PerlIO_getc(fp)
+#endif /* INDIRECT_BGET_MACROS */
+
+#define BGET_U32(arg)	\
+	BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
+#define BGET_I32(arg)	\
+	BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg)
+#define BGET_U16(arg)	\
+	BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg)
+#define BGET_U8(arg)	arg = BGET_FGETC()
+
+#if INDIRECT_BGET_MACROS
+#define BGET_PV(arg)	STMT_START {	\
+	BGET_U32(arg);			\
+	if (arg)			\
+	    bs.freadpv(arg, bs.data);	\
+	else {				\
+	    PL_bytecode_pv.xpv_pv = 0;		\
+	    PL_bytecode_pv.xpv_len = 0;		\
+	    PL_bytecode_pv.xpv_cur = 0;		\
+	}				\
+    } STMT_END
+#else
+#define BGET_PV(arg)	STMT_START {		\
+	BGET_U32(arg);				\
+	if (arg) {				\
+	    New(666, PL_bytecode_pv.xpv_pv, arg, char);	\
+	    PerlIO_read(fp, PL_bytecode_pv.xpv_pv, arg);	\
+	    PL_bytecode_pv.xpv_len = arg;			\
+	    PL_bytecode_pv.xpv_cur = arg - 1;		\
+	} else {				\
+	    PL_bytecode_pv.xpv_pv = 0;			\
+	    PL_bytecode_pv.xpv_len = 0;			\
+	    PL_bytecode_pv.xpv_cur = 0;			\
+	}					\
+    } STMT_END
+#endif /* INDIRECT_BGET_MACROS */
+
+#define BGET_comment_t(arg) \
+	do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
+
+/*
+ * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV
+ * machines such that 32-bit machine compilers don't whine about the shift
+ * count being too high even though the code is never reached there.
+ */
+#define BGET_IV64(arg) STMT_START {			\
+	U32 hi, lo;					\
+	BGET_U32(hi);					\
+	BGET_U32(lo);					\
+	if (sizeof(IV) == 8)				\
+	    arg = (IV) (hi << (sizeof(IV)*4) | lo);	\
+	else if (((I32)hi == -1 && (I32)lo < 0)		\
+		 || ((I32)hi == 0 && (I32)lo >= 0)) {	\
+	    arg = (I32)lo;				\
+	}						\
+	else {						\
+	    PL_bytecode_iv_overflows++;				\
+	    arg = 0;					\
+	}						\
+    } STMT_END
+
+#define BGET_op_tr_array(arg) do {	\
+	unsigned short *ary;		\
+	int i;				\
+	New(666, ary, 256, unsigned short); \
+	BGET_FREAD(ary, 256, 2);	\
+	for (i = 0; i < 256; i++)	\
+	    ary[i] = PerlSock_ntohs(ary[i]);	\
+	arg = (char *) ary;		\
+    } while (0)
+
+#define BGET_pvcontents(arg)	arg = PL_bytecode_pv.xpv_pv
+#define BGET_strconst(arg) STMT_START {	\
+	for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
+	arg = PL_tokenbuf;			\
+    } STMT_END
+
+#define BGET_double(arg) STMT_START {	\
+	char *str;			\
+	BGET_strconst(str);		\
+	arg = atof(str);		\
+    } STMT_END
+
+#define BGET_objindex(arg, type) STMT_START {	\
+	U32 ix;					\
+	BGET_U32(ix);				\
+	arg = (type)PL_bytecode_obj_list[ix];		\
+    } STMT_END
+#define BGET_svindex(arg) BGET_objindex(arg, svindex)
+#define BGET_opindex(arg) BGET_objindex(arg, opindex)
+
+#define BSET_ldspecsv(sv, arg) sv = PL_specialsv_list[arg]
+				    
+#define BSET_sv_refcnt_add(svrefcnt, arg)	svrefcnt += arg
+#define BSET_gp_refcnt_add(gprefcnt, arg)	gprefcnt += arg
+#define BSET_gp_share(sv, arg) STMT_START {	\
+	gp_free((GV*)sv);			\
+	GvGP(sv) = GvGP(arg);			\
+    } STMT_END
+
+#define BSET_gv_fetchpv(sv, arg)	sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
+#define BSET_gv_stashpv(sv, arg)	sv = (SV*)gv_stashpv(arg, TRUE)
+#define BSET_sv_magic(sv, arg)		sv_magic(sv, Nullsv, arg, 0, 0)
+#define BSET_mg_pv(mg, arg)	mg->mg_ptr = arg; mg->mg_len = PL_bytecode_pv.xpv_cur
+#define BSET_sv_upgrade(sv, arg)	(void)SvUPGRADE(sv, arg)
+#define BSET_xpv(sv)	do {	\
+	SvPV_set(sv, PL_bytecode_pv.xpv_pv);	\
+	SvCUR_set(sv, PL_bytecode_pv.xpv_cur);	\
+	SvLEN_set(sv, PL_bytecode_pv.xpv_len);	\
+    } while (0)
+#define BSET_av_extend(sv, arg)	av_extend((AV*)sv, arg)
+
+#define BSET_av_push(sv, arg)	av_push((AV*)sv, arg)
+#define BSET_hv_store(sv, arg)	\
+	hv_store((HV*)sv, PL_bytecode_pv.xpv_pv, PL_bytecode_pv.xpv_cur, arg, 0)
+#define BSET_pv_free(pv)	Safefree(pv.xpv_pv)
+#define BSET_pregcomp(o, arg) \
+	((PMOP*)o)->op_pmregexp = arg ? \
+		CALLREGCOMP(arg, arg + PL_bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
+#define BSET_newsv(sv, arg)	sv = NEWSV(666,0); SvUPGRADE(sv, arg)
+#define BSET_newop(o, arg)	o = (OP*)safemalloc(optype_size[arg])
+#define BSET_newopn(o, arg) STMT_START {	\
+	OP *oldop = o;				\
+	BSET_newop(o, arg);			\
+	oldop->op_next = o;			\
+    } STMT_END
+
+#define BSET_ret(foo) return
+
+/*
+ * Kludge special-case workaround for OP_MAPSTART
+ * which needs the ppaddr for OP_GREPSTART. Blech.
+ */
+#define BSET_op_type(o, arg) STMT_START {	\
+	o->op_type = arg;			\
+	if (arg == OP_MAPSTART)			\
+	    arg = OP_GREPSTART;			\
+	o->op_ppaddr = ppaddr[arg];		\
+    } STMT_END
+#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented")
+#define BSET_curpad(pad, arg) pad = AvARRAY(arg)
+
+#define BSET_OBJ_STORE(obj, ix)		\
+	(I32)ix > PL_bytecode_obj_list_fill ?	\
+	bset_obj_store(obj, (I32)ix) : (PL_bytecode_obj_list[ix] = obj)

contrib/perl5/bytecode.pl

@@ -0,0 +1,388 @@
+use strict;
+my %alias_to = (
+    U32 => [qw(PADOFFSET STRLEN)],
+    I32 => [qw(SSize_t long)],
+    U16 => [qw(OPCODE line_t short)],
+    U8 => [qw(char)],
+);
+
+my @optype= qw(OP UNOP BINOP LOGOP CONDOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
+
+# Nullsv *must* come first in the following so that the condition
+# ($$sv == 0) can continue to be used to test (sv == Nullsv).
+my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
+
+my (%alias_from, $from, $tos);
+while (($from, $tos) = each %alias_to) {
+    map { $alias_from{$_} = $from } @$tos;
+}
+
+my $c_header = <<'EOT';
+/*
+ *      Copyright (c) 1996-1998 Malcolm Beattie
+ *
+ *      You may distribute under the terms of either the GNU General Public
+ *      License or the Artistic License, as specified in the README file.
+ *
+ */
+/*
+ * This file is autogenerated from bytecode.pl. Changes made here will be lost.
+ */
+EOT
+
+my $perl_header;
+($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
+
+unlink "byterun.c", "byterun.h", "ext/B/B/Asmdata.pm";
+
+#
+# Start with boilerplate for Asmdata.pm
+#
+open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!";
+print ASMDATA_PM $perl_header, <<'EOT';
+package B::Asmdata;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
+use vars qw(%insn_data @insn_name @optype @specialsv_name);
+
+EOT
+print ASMDATA_PM <<"EOT";
+\@optype = qw(@optype);
+\@specialsv_name = qw(@specialsv);
+
+# XXX insn_data is initialised this way because with a large
+# %insn_data = (foo => [...], bar => [...], ...) initialiser
+# I get a hard-to-track-down stack underflow and segfault.
+EOT
+
+#
+# Boilerplate for byterun.c
+#
+open(BYTERUN_C, ">byterun.c") or die "byterun.c: $!";
+print BYTERUN_C $c_header, <<'EOT';
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void *
+bset_obj_store(void *obj, I32 ix)
+{
+    if (ix > PL_bytecode_obj_list_fill) {
+	if (PL_bytecode_obj_list_fill == -1)
+	    New(666, PL_bytecode_obj_list, ix + 1, void*);
+	else
+	    Renew(PL_bytecode_obj_list, ix + 1, void*);
+	PL_bytecode_obj_list_fill = ix;
+    }
+    PL_bytecode_obj_list[ix] = obj;
+    return obj;
+}
+
+#ifdef INDIRECT_BGET_MACROS
+void byterun(struct bytestream bs)
+#else
+void byterun(PerlIO *fp)
+#endif /* INDIRECT_BGET_MACROS */
+{
+    dTHR;
+    int insn;
+    while ((insn = BGET_FGETC()) != EOF) {
+	switch (insn) {
+EOT
+
+
+my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
+
+while (<DATA>) {
+    chop;
+    s/#.*//;			# remove comments
+    next unless length;
+    if (/^%number\s+(.*)/) {
+	$insn_num = $1;
+	next;
+    } elsif (/%enum\s+(.*?)\s+(.*)/) {
+	create_enum($1, $2);	# must come before instructions
+	next;
+    }
+    ($insn, $lvalue, $argtype, $flags) = split;
+    $insn_name[$insn_num] = $insn;
+    $fundtype = $alias_from{$argtype} || $argtype;
+
+    #
+    # Add the case statement and code for the bytecode interpreter in byterun.c
+    #
+    printf BYTERUN_C "\t  case INSN_%s:\t\t/* %d */\n\t    {\n",
+	uc($insn), $insn_num;
+    my $optarg = $argtype eq "none" ? "" : ", arg";
+    if ($optarg) {
+	printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
+    }
+    if ($flags =~ /x/) {
+	print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
+    } elsif ($flags =~ /s/) {
+	# Store instructions store to PL_bytecode_obj_list[arg]. "lvalue" field is rvalue.
+	print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
+    }
+    elsif ($optarg && $lvalue ne "none") {
+	print BYTERUN_C "\t\t$lvalue = arg;\n";
+    }
+    print BYTERUN_C "\t\tbreak;\n\t    }\n";
+
+    #
+    # Add the initialiser line for %insn_data in Asmdata.pm
+    #
+    print ASMDATA_PM <<"EOT";
+\$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"];
+EOT
+
+    # Find the next unused instruction number
+    do { $insn_num++ } while $insn_name[$insn_num];
+}
+
+#
+# Finish off byterun.c
+#
+print BYTERUN_C <<'EOT';
+	  default:
+	    croak("Illegal bytecode instruction %d\n", insn);
+	    /* NOTREACHED */
+	}
+    }
+}
+EOT
+
+#
+# Write the instruction and optype enum constants into byterun.h
+#
+open(BYTERUN_H, ">byterun.h") or die "byterun.h: $!";
+print BYTERUN_H $c_header, <<'EOT';
+#ifdef INDIRECT_BGET_MACROS
+struct bytestream {
+    void *data;
+    int (*fgetc)(void *);
+    int (*fread)(char *, size_t, size_t, void*);
+    void (*freadpv)(U32, void*);
+};
+#endif /* INDIRECT_BGET_MACROS */
+
+void *bset_obj_store _((void *, I32));
+
+enum {
+EOT
+
+my $i = 0;
+my $add_enum_value = 0;
+my $max_insn;
+for ($i = 0; $i < @insn_name; $i++) {
+    $insn = uc($insn_name[$i]);
+    if (defined($insn)) {
+	$max_insn = $i;
+	if ($add_enum_value) {
+	    print BYTERUN_H "    INSN_$insn = $i,\t\t\t/* $i */\n";
+	    $add_enum_value = 0;
+	} else {
+	    print BYTERUN_H "    INSN_$insn,\t\t\t/* $i */\n";
+	}
+    } else {
+	$add_enum_value = 1;
+    }
+}
+
+print BYTERUN_H "    MAX_INSN = $max_insn\n};\n";
+
+print BYTERUN_H "\nenum {\n";
+for ($i = 0; $i < @optype - 1; $i++) {
+    printf BYTERUN_H "    OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
+}
+printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
+print BYTERUN_H <<'EOT';
+EXT int optype_size[]
+#ifdef DOINIT
+= {
+EOT
+for ($i = 0; $i < @optype - 1; $i++) {
+    printf BYTERUN_H "    sizeof(%s),\n", $optype[$i], $i;
+}
+printf BYTERUN_H "    sizeof(%s)\n}\n", $optype[$i], $i;
+print BYTERUN_H <<'EOT';
+#endif /* DOINIT */
+;
+
+EOT
+
+print BYTERUN_H <<'EOT';
+#define INIT_SPECIALSV_LIST STMT_START { \
+EOT
+for ($i = 0; $i < @specialsv; $i++) {
+    print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n";
+}
+print BYTERUN_H <<'EOT';
+    } STMT_END
+EOT
+
+#
+# Finish off insn_data and create array initialisers in Asmdata.pm
+#
+print ASMDATA_PM <<'EOT';
+
+my ($insn_name, $insn_data);
+while (($insn_name, $insn_data) = each %insn_data) {
+    $insn_name[$insn_data->[0]] = $insn_name;
+}
+# Fill in any gaps
+@insn_name = map($_ || "unused", @insn_name);
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+
+=head1 SYNOPSIS
+
+	use Asmdata;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Asmdata.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut
+EOT
+
+__END__
+# First set instruction ord("#") to read comment to end-of-line (sneaky)
+%number 35
+comment		arg			comment_t
+# Then make ord("\n") into a no-op
+%number 10
+nop		none			none
+# Now for the rest of the ordinary ones, beginning with \0 which is
+# ret so that \0-terminated strings can be read properly as bytecode.
+%number 0
+#
+#opcode		lvalue					argtype		flags	
+#
+ret		none					none		x
+ldsv		PL_bytecode_sv				svindex
+ldop		PL_op					opindex
+stsv		PL_bytecode_sv				U32		s
+stop		PL_op					U32		s
+ldspecsv	PL_bytecode_sv				U8		x
+newsv		PL_bytecode_sv				U8		x
+newop		PL_op					U8		x
+newopn		PL_op					U8		x
+newpv		none					PV
+pv_cur		PL_bytecode_pv.xpv_cur			STRLEN
+pv_free		PL_bytecode_pv				none		x
+sv_upgrade	PL_bytecode_sv				char		x
+sv_refcnt	SvREFCNT(PL_bytecode_sv)		U32
+sv_refcnt_add	SvREFCNT(PL_bytecode_sv)		I32		x
+sv_flags	SvFLAGS(PL_bytecode_sv)			U32
+xrv		SvRV(PL_bytecode_sv)			svindex
+xpv		PL_bytecode_sv				none		x
+xiv32		SvIVX(PL_bytecode_sv)			I32
+xiv64		SvIVX(PL_bytecode_sv)			IV64
+xnv		SvNVX(PL_bytecode_sv)			double
+xlv_targoff	LvTARGOFF(PL_bytecode_sv)		STRLEN
+xlv_targlen	LvTARGLEN(PL_bytecode_sv)		STRLEN
+xlv_targ	LvTARG(PL_bytecode_sv)			svindex
+xlv_type	LvTYPE(PL_bytecode_sv)			char
+xbm_useful	BmUSEFUL(PL_bytecode_sv)		I32
+xbm_previous	BmPREVIOUS(PL_bytecode_sv)		U16
+xbm_rare	BmRARE(PL_bytecode_sv)			U8
+xfm_lines	FmLINES(PL_bytecode_sv)			I32
+xio_lines	IoLINES(PL_bytecode_sv)			long
+xio_page	IoPAGE(PL_bytecode_sv)			long
+xio_page_len	IoPAGE_LEN(PL_bytecode_sv)		long
+xio_lines_left	IoLINES_LEFT(PL_bytecode_sv)		long
+xio_top_name	IoTOP_NAME(PL_bytecode_sv)		pvcontents
+xio_top_gv	*(SV**)&IoTOP_GV(PL_bytecode_sv)	svindex
+xio_fmt_name	IoFMT_NAME(PL_bytecode_sv)		pvcontents
+xio_fmt_gv	*(SV**)&IoFMT_GV(PL_bytecode_sv)	svindex
+xio_bottom_name	IoBOTTOM_NAME(PL_bytecode_sv)		pvcontents
+xio_bottom_gv	*(SV**)&IoBOTTOM_GV(PL_bytecode_sv)	svindex
+xio_subprocess	IoSUBPROCESS(PL_bytecode_sv)		short
+xio_type	IoTYPE(PL_bytecode_sv)			char
+xio_flags	IoFLAGS(PL_bytecode_sv)			char
+xcv_stash	*(SV**)&CvSTASH(PL_bytecode_sv)		svindex
+xcv_start	CvSTART(PL_bytecode_sv)			opindex
+xcv_root	CvROOT(PL_bytecode_sv)			opindex
+xcv_gv		*(SV**)&CvGV(PL_bytecode_sv)		svindex
+xcv_filegv	*(SV**)&CvFILEGV(PL_bytecode_sv)	svindex
+xcv_depth	CvDEPTH(PL_bytecode_sv)			long
+xcv_padlist	*(SV**)&CvPADLIST(PL_bytecode_sv)	svindex
+xcv_outside	*(SV**)&CvOUTSIDE(PL_bytecode_sv)	svindex
+xcv_flags	CvFLAGS(PL_bytecode_sv)			U8
+av_extend	PL_bytecode_sv				SSize_t		x
+av_push		PL_bytecode_sv				svindex		x
+xav_fill	AvFILLp(PL_bytecode_sv)			SSize_t
+xav_max		AvMAX(PL_bytecode_sv)			SSize_t
+xav_flags	AvFLAGS(PL_bytecode_sv)			U8
+xhv_riter	HvRITER(PL_bytecode_sv)			I32
+xhv_name	HvNAME(PL_bytecode_sv)			pvcontents
+hv_store	PL_bytecode_sv				svindex		x
+sv_magic	PL_bytecode_sv				char		x
+mg_obj		SvMAGIC(PL_bytecode_sv)->mg_obj		svindex
+mg_private	SvMAGIC(PL_bytecode_sv)->mg_private	U16
+mg_flags	SvMAGIC(PL_bytecode_sv)->mg_flags	U8
+mg_pv		SvMAGIC(PL_bytecode_sv)			pvcontents	x
+xmg_stash	*(SV**)&SvSTASH(PL_bytecode_sv)		svindex
+gv_fetchpv	PL_bytecode_sv				strconst	x
+gv_stashpv	PL_bytecode_sv				strconst	x
+gp_sv		GvSV(PL_bytecode_sv)			svindex
+gp_refcnt	GvREFCNT(PL_bytecode_sv)		U32
+gp_refcnt_add	GvREFCNT(PL_bytecode_sv)		I32		x
+gp_av		*(SV**)&GvAV(PL_bytecode_sv)		svindex
+gp_hv		*(SV**)&GvHV(PL_bytecode_sv)		svindex
+gp_cv		*(SV**)&GvCV(PL_bytecode_sv)		svindex
+gp_filegv	*(SV**)&GvFILEGV(PL_bytecode_sv)	svindex
+gp_io		*(SV**)&GvIOp(PL_bytecode_sv)		svindex
+gp_form		*(SV**)&GvFORM(PL_bytecode_sv)		svindex
+gp_cvgen	GvCVGEN(PL_bytecode_sv)			U32
+gp_line		GvLINE(PL_bytecode_sv)			line_t
+gp_share	PL_bytecode_sv				svindex		x
+xgv_flags	GvFLAGS(PL_bytecode_sv)			U8
+op_next		PL_op->op_next				opindex
+op_sibling	PL_op->op_sibling			opindex
+op_ppaddr	PL_op->op_ppaddr			strconst	x
+op_targ		PL_op->op_targ				PADOFFSET
+op_type		PL_op					OPCODE		x
+op_seq		PL_op->op_seq				U16
+op_flags	PL_op->op_flags				U8
+op_private	PL_op->op_private			U8
+op_first	cUNOP->op_first				opindex
+op_last		cBINOP->op_last				opindex
+op_other	cLOGOP->op_other			opindex
+op_true		cCONDOP->op_true			opindex
+op_false	cCONDOP->op_false			opindex
+op_children	cLISTOP->op_children			U32
+op_pmreplroot	cPMOP->op_pmreplroot			opindex
+op_pmreplrootgv	*(SV**)&cPMOP->op_pmreplroot		svindex
+op_pmreplstart	cPMOP->op_pmreplstart			opindex
+op_pmnext	*(OP**)&cPMOP->op_pmnext		opindex
+pregcomp	PL_op					pvcontents	x
+op_pmflags	cPMOP->op_pmflags			U16
+op_pmpermflags	cPMOP->op_pmpermflags			U16
+op_sv		cSVOP->op_sv				svindex
+op_gv		*(SV**)&cGVOP->op_gv			svindex
+op_pv		cPVOP->op_pv				pvcontents
+op_pv_tr	cPVOP->op_pv				op_tr_array
+op_redoop	cLOOP->op_redoop			opindex
+op_nextop	cLOOP->op_nextop			opindex
+op_lastop	cLOOP->op_lastop			opindex
+cop_label	cCOP->cop_label				pvcontents
+cop_stash	*(SV**)&cCOP->cop_stash			svindex
+cop_filegv	*(SV**)&cCOP->cop_filegv		svindex
+cop_seq		cCOP->cop_seq				U32
+cop_arybase	cCOP->cop_arybase			I32
+cop_line	cCOP->cop_line				line_t
+main_start	PL_main_start				opindex
+main_root	PL_main_root				opindex
+curpad		PL_curpad				svindex		x

contrib/perl5/byterun.c

@@ -0,0 +1,867 @@
+/*
+ *      Copyright (c) 1996-1998 Malcolm Beattie
+ *
+ *      You may distribute under the terms of either the GNU General Public
+ *      License or the Artistic License, as specified in the README file.
+ *
+ */
+/*
+ * This file is autogenerated from bytecode.pl. Changes made here will be lost.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void *
+bset_obj_store(void *obj, I32 ix)
+{
+    if (ix > PL_bytecode_obj_list_fill) {
+	if (PL_bytecode_obj_list_fill == -1)
+	    New(666, PL_bytecode_obj_list, ix + 1, void*);
+	else
+	    Renew(PL_bytecode_obj_list, ix + 1, void*);
+	PL_bytecode_obj_list_fill = ix;
+    }
+    PL_bytecode_obj_list[ix] = obj;
+    return obj;
+}
+
+#ifdef INDIRECT_BGET_MACROS
+void byterun(struct bytestream bs)
+#else
+void byterun(PerlIO *fp)
+#endif /* INDIRECT_BGET_MACROS */
+{
+    dTHR;
+    int insn;
+    while ((insn = BGET_FGETC()) != EOF) {
+	switch (insn) {
+	  case INSN_COMMENT:		/* 35 */
+	    {
+		comment_t arg;
+		BGET_comment_t(arg);
+		arg = arg;
+		break;
+	    }
+	  case INSN_NOP:		/* 10 */
+	    {
+		break;
+	    }
+	  case INSN_RET:		/* 0 */
+	    {
+		BSET_ret(none);
+		break;
+	    }
+	  case INSN_LDSV:		/* 1 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		PL_bytecode_sv = arg;
+		break;
+	    }
+	  case INSN_LDOP:		/* 2 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		PL_op = arg;
+		break;
+	    }
+	  case INSN_STSV:		/* 3 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		BSET_OBJ_STORE(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_STOP:		/* 4 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		BSET_OBJ_STORE(PL_op, arg);
+		break;
+	    }
+	  case INSN_LDSPECSV:		/* 5 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_ldspecsv(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_NEWSV:		/* 6 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newsv(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_NEWOP:		/* 7 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newop(PL_op, arg);
+		break;
+	    }
+	  case INSN_NEWOPN:		/* 8 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newopn(PL_op, arg);
+		break;
+	    }
+	  case INSN_NEWPV:		/* 9 */
+	    {
+		PV arg;
+		BGET_PV(arg);
+		break;
+	    }
+	  case INSN_PV_CUR:		/* 11 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		PL_bytecode_pv.xpv_cur = arg;
+		break;
+	    }
+	  case INSN_PV_FREE:		/* 12 */
+	    {
+		BSET_pv_free(PL_bytecode_pv);
+		break;
+	    }
+	  case INSN_SV_UPGRADE:		/* 13 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		BSET_sv_upgrade(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_SV_REFCNT:		/* 14 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		SvREFCNT(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_SV_REFCNT_ADD:		/* 15 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BSET_sv_refcnt_add(SvREFCNT(PL_bytecode_sv), arg);
+		break;
+	    }
+	  case INSN_SV_FLAGS:		/* 16 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		SvFLAGS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XRV:		/* 17 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		SvRV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XPV:		/* 18 */
+	    {
+		BSET_xpv(PL_bytecode_sv);
+		break;
+	    }
+	  case INSN_XIV32:		/* 19 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		SvIVX(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIV64:		/* 20 */
+	    {
+		IV64 arg;
+		BGET_IV64(arg);
+		SvIVX(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XNV:		/* 21 */
+	    {
+		double arg;
+		BGET_double(arg);
+		SvNVX(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARGOFF:		/* 22 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		LvTARGOFF(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARGLEN:		/* 23 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		LvTARGLEN(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARG:		/* 24 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		LvTARG(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TYPE:		/* 25 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		LvTYPE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_USEFUL:		/* 26 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BmUSEFUL(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_PREVIOUS:		/* 27 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		BmPREVIOUS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_RARE:		/* 28 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BmRARE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XFM_LINES:		/* 29 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		FmLINES(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_LINES:		/* 30 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoLINES(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_PAGE:		/* 31 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoPAGE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_PAGE_LEN:		/* 32 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoPAGE_LEN(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_LINES_LEFT:		/* 33 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoLINES_LEFT(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TOP_NAME:		/* 34 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoTOP_NAME(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TOP_GV:		/* 36 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&IoTOP_GV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FMT_NAME:		/* 37 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoFMT_NAME(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FMT_GV:		/* 38 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&IoFMT_GV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_BOTTOM_NAME:		/* 39 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoBOTTOM_NAME(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_BOTTOM_GV:		/* 40 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&IoBOTTOM_GV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_SUBPROCESS:		/* 41 */
+	    {
+		short arg;
+		BGET_U16(arg);
+		IoSUBPROCESS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TYPE:		/* 42 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		IoTYPE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FLAGS:		/* 43 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		IoFLAGS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_STASH:		/* 44 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&CvSTASH(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_START:		/* 45 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		CvSTART(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_ROOT:		/* 46 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		CvROOT(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_GV:		/* 47 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&CvGV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_FILEGV:		/* 48 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&CvFILEGV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_DEPTH:		/* 49 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		CvDEPTH(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_PADLIST:		/* 50 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&CvPADLIST(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_OUTSIDE:		/* 51 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&CvOUTSIDE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_FLAGS:		/* 52 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		CvFLAGS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_AV_EXTEND:		/* 53 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		BSET_av_extend(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_AV_PUSH:		/* 54 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		BSET_av_push(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_XAV_FILL:		/* 55 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		AvFILLp(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XAV_MAX:		/* 56 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		AvMAX(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XAV_FLAGS:		/* 57 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		AvFLAGS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XHV_RITER:		/* 58 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		HvRITER(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_XHV_NAME:		/* 59 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		HvNAME(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_HV_STORE:		/* 60 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		BSET_hv_store(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_SV_MAGIC:		/* 61 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		BSET_sv_magic(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_MG_OBJ:		/* 62 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		SvMAGIC(PL_bytecode_sv)->mg_obj = arg;
+		break;
+	    }
+	  case INSN_MG_PRIVATE:		/* 63 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		SvMAGIC(PL_bytecode_sv)->mg_private = arg;
+		break;
+	    }
+	  case INSN_MG_FLAGS:		/* 64 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		SvMAGIC(PL_bytecode_sv)->mg_flags = arg;
+		break;
+	    }
+	  case INSN_MG_PV:		/* 65 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		BSET_mg_pv(SvMAGIC(PL_bytecode_sv), arg);
+		break;
+	    }
+	  case INSN_XMG_STASH:		/* 66 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&SvSTASH(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GV_FETCHPV:		/* 67 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_gv_fetchpv(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_GV_STASHPV:		/* 68 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_gv_stashpv(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_GP_SV:		/* 69 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		GvSV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_REFCNT:		/* 70 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		GvREFCNT(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_REFCNT_ADD:		/* 71 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BSET_gp_refcnt_add(GvREFCNT(PL_bytecode_sv), arg);
+		break;
+	    }
+	  case INSN_GP_AV:		/* 72 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvAV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_HV:		/* 73 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvHV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_CV:		/* 74 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvCV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_FILEGV:		/* 75 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvFILEGV(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_IO:		/* 76 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvIOp(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_FORM:		/* 77 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&GvFORM(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_CVGEN:		/* 78 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		GvCVGEN(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_LINE:		/* 79 */
+	    {
+		line_t arg;
+		BGET_U16(arg);
+		GvLINE(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_GP_SHARE:		/* 80 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		BSET_gp_share(PL_bytecode_sv, arg);
+		break;
+	    }
+	  case INSN_XGV_FLAGS:		/* 81 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		GvFLAGS(PL_bytecode_sv) = arg;
+		break;
+	    }
+	  case INSN_OP_NEXT:		/* 82 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		PL_op->op_next = arg;
+		break;
+	    }
+	  case INSN_OP_SIBLING:		/* 83 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		PL_op->op_sibling = arg;
+		break;
+	    }
+	  case INSN_OP_PPADDR:		/* 84 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_op_ppaddr(PL_op->op_ppaddr, arg);
+		break;
+	    }
+	  case INSN_OP_TARG:		/* 85 */
+	    {
+		PADOFFSET arg;
+		BGET_U32(arg);
+		PL_op->op_targ = arg;
+		break;
+	    }
+	  case INSN_OP_TYPE:		/* 86 */
+	    {
+		OPCODE arg;
+		BGET_U16(arg);
+		BSET_op_type(PL_op, arg);
+		break;
+	    }
+	  case INSN_OP_SEQ:		/* 87 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		PL_op->op_seq = arg;
+		break;
+	    }
+	  case INSN_OP_FLAGS:		/* 88 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		PL_op->op_flags = arg;
+		break;
+	    }
+	  case INSN_OP_PRIVATE:		/* 89 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		PL_op->op_private = arg;
+		break;
+	    }
+	  case INSN_OP_FIRST:		/* 90 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cUNOP->op_first = arg;
+		break;
+	    }
+	  case INSN_OP_LAST:		/* 91 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cBINOP->op_last = arg;
+		break;
+	    }
+	  case INSN_OP_OTHER:		/* 92 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cLOGOP->op_other = arg;
+		break;
+	    }
+	  case INSN_OP_TRUE:		/* 93 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cCONDOP->op_true = arg;
+		break;
+	    }
+	  case INSN_OP_FALSE:		/* 94 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cCONDOP->op_false = arg;
+		break;
+	    }
+	  case INSN_OP_CHILDREN:		/* 95 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		cLISTOP->op_children = arg;
+		break;
+	    }
+	  case INSN_OP_PMREPLROOT:		/* 96 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cPMOP->op_pmreplroot = arg;
+		break;
+	    }
+	  case INSN_OP_PMREPLROOTGV:		/* 97 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&cPMOP->op_pmreplroot = arg;
+		break;
+	    }
+	  case INSN_OP_PMREPLSTART:		/* 98 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cPMOP->op_pmreplstart = arg;
+		break;
+	    }
+	  case INSN_OP_PMNEXT:		/* 99 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		*(OP**)&cPMOP->op_pmnext = arg;
+		break;
+	    }
+	  case INSN_PREGCOMP:		/* 100 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		BSET_pregcomp(PL_op, arg);
+		break;
+	    }
+	  case INSN_OP_PMFLAGS:		/* 101 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		cPMOP->op_pmflags = arg;
+		break;
+	    }
+	  case INSN_OP_PMPERMFLAGS:		/* 102 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		cPMOP->op_pmpermflags = arg;
+		break;
+	    }
+	  case INSN_OP_SV:		/* 103 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		cSVOP->op_sv = arg;
+		break;
+	    }
+	  case INSN_OP_GV:		/* 104 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&cGVOP->op_gv = arg;
+		break;
+	    }
+	  case INSN_OP_PV:		/* 105 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		cPVOP->op_pv = arg;
+		break;
+	    }
+	  case INSN_OP_PV_TR:		/* 106 */
+	    {
+		op_tr_array arg;
+		BGET_op_tr_array(arg);
+		cPVOP->op_pv = arg;
+		break;
+	    }
+	  case INSN_OP_REDOOP:		/* 107 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cLOOP->op_redoop = arg;
+		break;
+	    }
+	  case INSN_OP_NEXTOP:		/* 108 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cLOOP->op_nextop = arg;
+		break;
+	    }
+	  case INSN_OP_LASTOP:		/* 109 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		cLOOP->op_lastop = arg;
+		break;
+	    }
+	  case INSN_COP_LABEL:		/* 110 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		cCOP->cop_label = arg;
+		break;
+	    }
+	  case INSN_COP_STASH:		/* 111 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&cCOP->cop_stash = arg;
+		break;
+	    }
+	  case INSN_COP_FILEGV:		/* 112 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		*(SV**)&cCOP->cop_filegv = arg;
+		break;
+	    }
+	  case INSN_COP_SEQ:		/* 113 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		cCOP->cop_seq = arg;
+		break;
+	    }
+	  case INSN_COP_ARYBASE:		/* 114 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		cCOP->cop_arybase = arg;
+		break;
+	    }
+	  case INSN_COP_LINE:		/* 115 */
+	    {
+		line_t arg;
+		BGET_U16(arg);
+		cCOP->cop_line = arg;
+		break;
+	    }
+	  case INSN_MAIN_START:		/* 116 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		PL_main_start = arg;
+		break;
+	    }
+	  case INSN_MAIN_ROOT:		/* 117 */
+	    {
+		opindex arg;
+		BGET_opindex(arg);
+		PL_main_root = arg;
+		break;
+	    }
+	  case INSN_CURPAD:		/* 118 */
+	    {
+		svindex arg;
+		BGET_svindex(arg);
+		BSET_curpad(PL_curpad, arg);
+		break;
+	    }
+	  default:
+	    croak("Illegal bytecode instruction %d\n", insn);
+	    /* NOTREACHED */
+	}
+    }
+}

contrib/perl5/byterun.h

@@ -0,0 +1,184 @@
+/*
+ *      Copyright (c) 1996-1998 Malcolm Beattie
+ *
+ *      You may distribute under the terms of either the GNU General Public
+ *      License or the Artistic License, as specified in the README file.
+ *
+ */
+/*
+ * This file is autogenerated from bytecode.pl. Changes made here will be lost.
+ */
+#ifdef INDIRECT_BGET_MACROS
+struct bytestream {
+    void *data;
+    int (*fgetc)(void *);
+    int (*fread)(char *, size_t, size_t, void*);
+    void (*freadpv)(U32, void*);
+};
+#endif /* INDIRECT_BGET_MACROS */
+
+void *bset_obj_store _((void *, I32));
+
+enum {
+    INSN_RET,			/* 0 */
+    INSN_LDSV,			/* 1 */
+    INSN_LDOP,			/* 2 */
+    INSN_STSV,			/* 3 */
+    INSN_STOP,			/* 4 */
+    INSN_LDSPECSV,			/* 5 */
+    INSN_NEWSV,			/* 6 */
+    INSN_NEWOP,			/* 7 */
+    INSN_NEWOPN,			/* 8 */
+    INSN_NEWPV,			/* 9 */
+    INSN_NOP,			/* 10 */
+    INSN_PV_CUR,			/* 11 */
+    INSN_PV_FREE,			/* 12 */
+    INSN_SV_UPGRADE,			/* 13 */
+    INSN_SV_REFCNT,			/* 14 */
+    INSN_SV_REFCNT_ADD,			/* 15 */
+    INSN_SV_FLAGS,			/* 16 */
+    INSN_XRV,			/* 17 */
+    INSN_XPV,			/* 18 */
+    INSN_XIV32,			/* 19 */
+    INSN_XIV64,			/* 20 */
+    INSN_XNV,			/* 21 */
+    INSN_XLV_TARGOFF,			/* 22 */
+    INSN_XLV_TARGLEN,			/* 23 */
+    INSN_XLV_TARG,			/* 24 */
+    INSN_XLV_TYPE,			/* 25 */
+    INSN_XBM_USEFUL,			/* 26 */
+    INSN_XBM_PREVIOUS,			/* 27 */
+    INSN_XBM_RARE,			/* 28 */
+    INSN_XFM_LINES,			/* 29 */
+    INSN_XIO_LINES,			/* 30 */
+    INSN_XIO_PAGE,			/* 31 */
+    INSN_XIO_PAGE_LEN,			/* 32 */
+    INSN_XIO_LINES_LEFT,			/* 33 */
+    INSN_XIO_TOP_NAME,			/* 34 */
+    INSN_COMMENT,			/* 35 */
+    INSN_XIO_TOP_GV,			/* 36 */
+    INSN_XIO_FMT_NAME,			/* 37 */
+    INSN_XIO_FMT_GV,			/* 38 */
+    INSN_XIO_BOTTOM_NAME,			/* 39 */
+    INSN_XIO_BOTTOM_GV,			/* 40 */
+    INSN_XIO_SUBPROCESS,			/* 41 */
+    INSN_XIO_TYPE,			/* 42 */
+    INSN_XIO_FLAGS,			/* 43 */
+    INSN_XCV_STASH,			/* 44 */
+    INSN_XCV_START,			/* 45 */
+    INSN_XCV_ROOT,			/* 46 */
+    INSN_XCV_GV,			/* 47 */
+    INSN_XCV_FILEGV,			/* 48 */
+    INSN_XCV_DEPTH,			/* 49 */
+    INSN_XCV_PADLIST,			/* 50 */
+    INSN_XCV_OUTSIDE,			/* 51 */
+    INSN_XCV_FLAGS,			/* 52 */
+    INSN_AV_EXTEND,			/* 53 */
+    INSN_AV_PUSH,			/* 54 */
+    INSN_XAV_FILL,			/* 55 */
+    INSN_XAV_MAX,			/* 56 */
+    INSN_XAV_FLAGS,			/* 57 */
+    INSN_XHV_RITER,			/* 58 */
+    INSN_XHV_NAME,			/* 59 */
+    INSN_HV_STORE,			/* 60 */
+    INSN_SV_MAGIC,			/* 61 */
+    INSN_MG_OBJ,			/* 62 */
+    INSN_MG_PRIVATE,			/* 63 */
+    INSN_MG_FLAGS,			/* 64 */
+    INSN_MG_PV,			/* 65 */
+    INSN_XMG_STASH,			/* 66 */
+    INSN_GV_FETCHPV,			/* 67 */
+    INSN_GV_STASHPV,			/* 68 */
+    INSN_GP_SV,			/* 69 */
+    INSN_GP_REFCNT,			/* 70 */
+    INSN_GP_REFCNT_ADD,			/* 71 */
+    INSN_GP_AV,			/* 72 */
+    INSN_GP_HV,			/* 73 */
+    INSN_GP_CV,			/* 74 */
+    INSN_GP_FILEGV,			/* 75 */
+    INSN_GP_IO,			/* 76 */
+    INSN_GP_FORM,			/* 77 */
+    INSN_GP_CVGEN,			/* 78 */
+    INSN_GP_LINE,			/* 79 */
+    INSN_GP_SHARE,			/* 80 */
+    INSN_XGV_FLAGS,			/* 81 */
+    INSN_OP_NEXT,			/* 82 */
+    INSN_OP_SIBLING,			/* 83 */
+    INSN_OP_PPADDR,			/* 84 */
+    INSN_OP_TARG,			/* 85 */
+    INSN_OP_TYPE,			/* 86 */
+    INSN_OP_SEQ,			/* 87 */
+    INSN_OP_FLAGS,			/* 88 */
+    INSN_OP_PRIVATE,			/* 89 */
+    INSN_OP_FIRST,			/* 90 */
+    INSN_OP_LAST,			/* 91 */
+    INSN_OP_OTHER,			/* 92 */
+    INSN_OP_TRUE,			/* 93 */
+    INSN_OP_FALSE,			/* 94 */
+    INSN_OP_CHILDREN,			/* 95 */
+    INSN_OP_PMREPLROOT,			/* 96 */
+    INSN_OP_PMREPLROOTGV,			/* 97 */
+    INSN_OP_PMREPLSTART,			/* 98 */
+    INSN_OP_PMNEXT,			/* 99 */
+    INSN_PREGCOMP,			/* 100 */
+    INSN_OP_PMFLAGS,			/* 101 */
+    INSN_OP_PMPERMFLAGS,			/* 102 */
+    INSN_OP_SV,			/* 103 */
+    INSN_OP_GV,			/* 104 */
+    INSN_OP_PV,			/* 105 */
+    INSN_OP_PV_TR,			/* 106 */
+    INSN_OP_REDOOP,			/* 107 */
+    INSN_OP_NEXTOP,			/* 108 */
+    INSN_OP_LASTOP,			/* 109 */
+    INSN_COP_LABEL,			/* 110 */
+    INSN_COP_STASH,			/* 111 */
+    INSN_COP_FILEGV,			/* 112 */
+    INSN_COP_SEQ,			/* 113 */
+    INSN_COP_ARYBASE,			/* 114 */
+    INSN_COP_LINE,			/* 115 */
+    INSN_MAIN_START,			/* 116 */
+    INSN_MAIN_ROOT,			/* 117 */
+    INSN_CURPAD,			/* 118 */
+    MAX_INSN = 118
+};
+
+enum {
+    OPt_OP,		/* 0 */
+    OPt_UNOP,		/* 1 */
+    OPt_BINOP,		/* 2 */
+    OPt_LOGOP,		/* 3 */
+    OPt_CONDOP,		/* 4 */
+    OPt_LISTOP,		/* 5 */
+    OPt_PMOP,		/* 6 */
+    OPt_SVOP,		/* 7 */
+    OPt_GVOP,		/* 8 */
+    OPt_PVOP,		/* 9 */
+    OPt_LOOP,		/* 10 */
+    OPt_COP		/* 11 */
+};
+
+EXT int optype_size[]
+#ifdef DOINIT
+= {
+    sizeof(OP),
+    sizeof(UNOP),
+    sizeof(BINOP),
+    sizeof(LOGOP),
+    sizeof(CONDOP),
+    sizeof(LISTOP),
+    sizeof(PMOP),
+    sizeof(SVOP),
+    sizeof(GVOP),
+    sizeof(PVOP),
+    sizeof(LOOP),
+    sizeof(COP)
+}
+#endif /* DOINIT */
+;
+
+#define INIT_SPECIALSV_LIST STMT_START { \
+	PL_specialsv_list[0] = Nullsv; \
+	PL_specialsv_list[1] = &PL_sv_undef; \
+	PL_specialsv_list[2] = &PL_sv_yes; \
+	PL_specialsv_list[3] = &PL_sv_no; \
+    } STMT_END

contrib/perl5/cc_runtime.h

@@ -0,0 +1,71 @@
+#define DOOP(ppname) PUTBACK; PL_op = ppname(ARGS); SPAGAIN
+
+#define PP_LIST(g) do {			\
+	dMARK;				\
+	if (g != G_ARRAY) {		\
+	    if (++MARK <= SP)		\
+		*MARK = *SP;		\
+	    else			\
+		*MARK = &PL_sv_undef;	\
+	    SP = MARK;			\
+	}				\
+   } while (0)
+
+#define MAYBE_TAINT_SASSIGN_SRC(sv) \
+    if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \
+                                !((mg=mg_find(left, 't')) && mg->mg_len & 1)))\
+        TAINT_NOT
+
+#define PP_PREINC(sv) do {	\
+	if (SvIOK(sv)) {	\
+            ++SvIVX(sv);	\
+	    SvFLAGS(sv) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); \
+	}			\
+	else			\
+	    sv_inc(sv);		\
+	SvSETMAGIC(sv);		\
+    } while (0)
+
+#define PP_UNSTACK do {		\
+	TAINT_NOT;		\
+	PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;	\
+	FREETMPS;		\
+	oldsave = PL_scopestack[PL_scopestack_ix - 1]; \
+	LEAVE_SCOPE(oldsave);	\
+	SPAGAIN;		\
+    } while(0)
+
+/* Anyone using eval "" deserves this mess */
+#define PP_EVAL(ppaddr, nxt) do {		\
+	dJMPENV;				\
+	int ret;				\
+	PUTBACK;				\
+	JMPENV_PUSH(ret);			\
+	switch (ret) {				\
+	case 0:					\
+	    PL_op = ppaddr(ARGS);			\
+	    PL_retstack[PL_retstack_ix - 1] = Nullop;	\
+	    if (PL_op != nxt) runops();		\
+	    JMPENV_POP;				\
+	    break;				\
+	case 1: JMPENV_POP; JMPENV_JUMP(1);	\
+	case 2: JMPENV_POP; JMPENV_JUMP(2);	\
+	case 3:					\
+	    JMPENV_POP;				\
+	    if (PL_restartop != nxt)		\
+		JMPENV_JUMP(3);			\
+	}					\
+	PL_op = nxt;				\
+	SPAGAIN;				\
+    } while (0)
+
+#define PP_ENTERTRY(jmpbuf,label) do {		\
+	dJMPENV;				\
+	int ret;				\
+	JMPENV_PUSH(ret);			\
+	switch (ret) {				\
+	case 1: JMPENV_POP; JMPENV_JUMP(1);	\
+	case 2: JMPENV_POP; JMPENV_JUMP(2);	\
+	case 3: JMPENV_POP; SPAGAIN; goto label;\
+	}					\
+    } while (0)

contrib/perl5/cflags.SH

@@ -0,0 +1,136 @@
+case $CONFIG in
+'')
+	if test -f config.sh; then TOP=.;
+	elif test -f ../config.sh; then TOP=..;
+	elif test -f ../../config.sh; then TOP=../..;
+	elif test -f ../../../config.sh; then TOP=../../..;
+	elif test -f ../../../../config.sh; then TOP=../../../..;
+	else
+		echo "Can't find config.sh."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting cflags (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+rm -f cflags
+$spitshell >cflags <<!GROK!THIS!
+$startsh
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>cflags <<'!NO!SUBS!'
+case $CONFIG in
+'')
+	if test -f config.sh; then TOP=.;
+	elif test -f ../config.sh; then TOP=..;
+	elif test -f ../../config.sh; then TOP=../..;
+	elif test -f ../../../config.sh; then TOP=../../..;
+	elif test -f ../../../../config.sh; then TOP=../../../..;
+	else
+		echo "Can't find config.sh."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+
+perltype=''
+optdebug=''	# ensure -g used if building a -DDEBUGGING libperl
+case $# in
+2) case $1 in
+    *perl.*)    perltype='';;
+    *perld.*)   perltype='-DDEBUGGING'; optdebug='-g' ;;
+    *perle.*)   perltype='-DEMBED';;
+    *perlde.*)  perltype='-DDEBUGGING -DEMBED'; optdebug='-g' ;;
+    *perlm.*)   perltype='-DEMBED -DMULTIPLICITY';;
+    *perldm.*)  perltype='-DDEBUGGING -DEMBED -DMULTIPLICITY'; optdebug='-g' ;;
+    esac
+    shift ;;
+esac
+
+also=': '
+case $# in
+1) also='echo 1>&2 "	  CCCMD = "'
+esac
+
+case $# in
+0) set *.c; echo "The current C flags are:" ;;
+esac
+
+set `echo "$* " | sed -e 's/\.[oc] / /g' -e 's/\.obj / /g'`
+
+for file do
+
+    case "$#" in
+    1) ;;
+    *) echo $n "    $file.c	$c" ;;
+    esac
+
+    : allow variables like toke_cflags to be evaluated
+
+    eval 'eval ${'"${file}_cflags"'-""}'
+
+    : or customize here
+
+    case "$file" in
+    DB_File) ;;
+    GDBM_File) ;;
+    NDBM_File) ;;
+    ODBM_File) ;;
+    POSIX) ;;
+    SDBM_File) ;;
+    av) ;;
+    byterun) ;;
+    deb) ;;
+    dl) ;;
+    doio) ;;
+    doop) ;;
+    dump) ;;
+    gv) ;;
+    hv) ;;
+    main) ;;
+    malloc) ;;
+    mg) ;;
+    miniperlmain) ;;
+    op) ;;
+    perl) ;;
+    perlmain) ;;
+    perly) ;;
+    pp) ;;
+    pp_ctl) ;;
+    pp_hot) ;;
+    pp_sys) ;;
+    regcomp) ;;
+    regexec) ;;
+    run) ;;
+    scope) ;;
+    sv) ;;
+    taint) ;;
+    toke) ;;
+    usersub) ;;
+    util) ;;
+    *) ;;
+    esac
+
+	if test "X$optdebug" != "X"; then
+		optimize="$optdebug"
+	fi
+
+    : Can we perhaps use $ansi2knr here
+    echo "$cc -c -DPERL_CORE $ccflags $optimize $perltype $large $split"
+    eval "$also "'"$cc -DPERL_CORE -c $ccflags $optimize $perltype $large $split"'
+
+    . $TOP/config.sh
+
+done
+!NO!SUBS!
+chmod 755 cflags
+$eunicefix cflags

contrib/perl5/configpm

@@ -0,0 +1,417 @@
+#!./miniperl -w
+
+my $config_pm = $ARGV[0] || 'lib/Config.pm';
+my $glossary = $ARGV[1] || 'Porting/Glossary';
+@ARGV = "./config.sh";
+
+# list names to put first (and hence lookup fastest)
+@fast = qw(archname osname osvers prefix libs libpth
+	dynamic_ext static_ext extensions dlsrc so
+	sig_name sig_num cc ccflags cppflags
+	privlibexp archlibexp installprivlib installarchlib
+	sharpbang startsh shsharp
+);
+
+# names of things which may need to have slashes changed to double-colons
+@extensions = qw(dynamic_ext static_ext extensions known_extensions);
+
+
+open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
+$myver = $];
+
+print CONFIG <<"ENDOFBEG";
+package Config;
+use Exporter ();
+\@ISA = (Exporter);
+\@EXPORT = qw(%Config);
+\@EXPORT_OK = qw(myconfig config_sh config_vars);
+
+\$] == $myver
+  or die "Perl lib version ($myver) doesn't match executable version (\$])";
+
+# This file was created by configpm when Perl was built. Any changes
+# made to this file will be lost the next time perl is built.
+
+ENDOFBEG
+
+
+@fast{@fast} = @fast;
+@extensions{@extensions} = @extensions;
+@non_v=();
+@v_fast=();
+@v_others=();
+$in_v = 0;
+
+while (<>) {
+    next if m:^#!/bin/sh:;
+    # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
+    s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
+    # We can delimit things in config.sh with either ' or ". 
+    unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
+	push(@non_v, "#$_"); # not a name='value' line
+	next;
+    }
+    $quote = $2;
+    if ($in_v) { $val .= $_;             }
+    else       { ($name,$val) = ($1,$3); }
+    $in_v = $val !~ /$quote\n/;
+    next if $in_v;
+    if ($extensions{$name}) { s,/,::,g }
+    if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
+    push(@v_fast,"$name=$quote$val");
+}
+
+foreach(@non_v){ print CONFIG $_ }
+
+print CONFIG "\n",
+    "my \$config_sh = <<'!END!';\n",
+    join("", @v_fast, sort @v_others),
+    "!END!\n\n";
+
+# copy config summary format from the myconfig script
+
+print CONFIG "my \$summary = <<'!END!';\n";
+
+open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
+1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
+do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
+close(MYCONFIG);
+
+print CONFIG "\n!END!\n", <<'EOT';
+my $summary_expanded = 0;
+
+sub myconfig {
+	return $summary if $summary_expanded;
+	$summary =~ s{\$(\w+)}
+		     { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
+	$summary_expanded = 1;
+	$summary;
+}
+EOT
+
+# ----
+
+print CONFIG <<'ENDOFEND';
+
+sub FETCH { 
+    # check for cached value (which may be undef so we use exists not defined)
+    return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
+
+    # Search for it in the big string 
+    my($value, $start, $marker, $quote_type);
+    $marker = "$_[1]=";
+    $quote_type = "'";
+    # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
+    # Check for the common case, ' delimeted
+    $start = index($config_sh, "\n$marker$quote_type");
+    # If that failed, check for " delimited
+    if ($start == -1) {
+      $quote_type = '"';
+      $start = index($config_sh, "\n$marker$quote_type");
+    }
+    return undef if ( ($start == -1) &&  # in case it's first 
+        (substr($config_sh, 0, length($marker)) ne $marker) );
+    if ($start == -1) { 
+      # It's the very first thing we found. Skip $start forward
+      # and figure out the quote mark after the =.
+      $start = length($marker) + 1;
+      $quote_type = substr($config_sh, $start - 1, 1);
+    } 
+    else { 
+      $start += length($marker) + 2;
+    }
+    $value = substr($config_sh, $start, 
+        index($config_sh, "$quote_type\n", $start) - $start);
+ 
+    # If we had a double-quote, we'd better eval it so escape
+    # sequences and such can be interpolated. Since the incoming
+    # value is supposed to follow shell rules and not perl rules,
+    # we escape any perl variable markers
+    if ($quote_type eq '"') {
+      $value =~ s/\$/\\\$/g;
+      $value =~ s/\@/\\\@/g;
+      eval "\$value = \"$value\"";
+    }
+    #$value = sprintf($value) if $quote_type eq '"';
+    $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
+    $_[0]->{$_[1]} = $value; # cache it
+    return $value;
+}
+ 
+my $prevpos = 0;
+
+sub FIRSTKEY {
+    $prevpos = 0;
+    # my($key) = $config_sh =~ m/^(.*?)=/;
+    substr($config_sh, 0, index($config_sh, '=') );
+    # $key;
+}
+
+sub NEXTKEY {
+    # Find out how the current key's quoted so we can skip to its end.
+    my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
+    my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
+    my $len = index($config_sh, "=", $pos) - $pos;
+    $prevpos = $pos;
+    $len > 0 ? substr($config_sh, $pos, $len) : undef;
+}
+
+sub EXISTS { 
+    # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
+    exists($_[0]->{$_[1]}) or
+    index($config_sh, "\n$_[1]='") != -1 or
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
+    index($config_sh, "\n$_[1]=\"") != -1 or
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
+}
+
+sub STORE  { die "\%Config::Config is read-only\n" }
+sub DELETE { &STORE }
+sub CLEAR  { &STORE }
+
+
+sub config_sh {
+    $config_sh
+}
+
+sub config_re {
+    my $re = shift;
+    my @matches = ($config_sh =~ /^$re=.*\n/mg);
+    @matches ? (print @matches) : print "$re: not found\n";
+}
+
+sub config_vars {
+    foreach(@_){
+	config_re($_), next if /\W/;
+	my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
+	$v='undef' unless defined $v;
+	print "$_='$v';\n";
+    }
+}
+
+ENDOFEND
+
+if ($^O eq 'os2') {
+  print CONFIG <<'ENDOFSET';
+my %preconfig;
+if ($OS2::is_aout) {
+    my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
+    for (split ' ', $value) {
+        ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
+        $preconfig{$_} = $v eq 'undef' ? undef : $v;
+    }
+}
+sub TIEHASH { bless {%preconfig} }
+ENDOFSET
+} else {
+  print CONFIG <<'ENDOFSET';
+sub TIEHASH { bless {} }
+ENDOFSET
+}
+
+print CONFIG <<'ENDOFTAIL';
+
+# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
+sub DESTROY { }
+
+tie %Config, 'Config';
+
+1;
+__END__
+
+=head1 NAME
+
+Config - access Perl configuration information
+
+=head1 SYNOPSIS
+
+    use Config;
+    if ($Config{'cc'} =~ /gcc/) {
+	print "built by gcc\n";
+    } 
+
+    use Config qw(myconfig config_sh config_vars);
+
+    print myconfig();
+
+    print config_sh();
+
+    config_vars(qw(osname archname));
+
+
+=head1 DESCRIPTION
+
+The Config module contains all the information that was available to
+the C<Configure> program at Perl build time (over 900 values).
+
+Shell variables from the F<config.sh> file (written by Configure) are
+stored in the readonly-variable C<%Config>, indexed by their names.
+
+Values stored in config.sh as 'undef' are returned as undefined
+values.  The perl C<exists> function can be used to check if a
+named variable exists.
+
+=over 4
+
+=item myconfig()
+
+Returns a textual summary of the major perl configuration values.
+See also C<-V> in L<perlrun/Switches>.
+
+=item config_sh()
+
+Returns the entire perl configuration information in the form of the
+original config.sh shell variable assignment script.
+
+=item config_vars(@names)
+
+Prints to STDOUT the values of the named configuration variable. Each is
+printed on a separate line in the form:
+
+  name='value';
+
+Names which are unknown are output as C<name='UNKNOWN';>.
+See also C<-V:name> in L<perlrun/Switches>.
+
+=back
+
+=head1 EXAMPLE
+
+Here's a more sophisticated example of using %Config:
+
+    use Config;
+    use strict;
+
+    my %sig_num;
+    my @sig_name;
+    unless($Config{sig_name} && $Config{sig_num}) {
+	die "No sigs?";
+    } else {
+	my @names = split ' ', $Config{sig_name};
+	@sig_num{@names} = split ' ', $Config{sig_num};
+	foreach (@names) {
+	    $sig_name[$sig_num{$_}] ||= $_;
+	}   
+    }
+
+    print "signal #17 = $sig_name[17]\n";
+    if ($sig_num{ALRM}) { 
+	print "SIGALRM is $sig_num{ALRM}\n";
+    }   
+
+=head1 WARNING
+
+Because this information is not stored within the perl executable
+itself it is possible (but unlikely) that the information does not
+relate to the actual perl binary which is being used to access it.
+
+The Config module is installed into the architecture and version
+specific library directory ($Config{installarchlib}) and it checks the
+perl version number when loaded.
+
+The values stored in config.sh may be either single-quoted or
+double-quoted. Double-quoted strings are handy for those cases where you
+need to include escape sequences in the strings. To avoid runtime variable
+interpolation, any C<$> and C<@> characters are replaced by C<\$> and
+C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
+or C<\@> in double-quoted strings unless you're willing to deal with the
+consequences. (The slashes will end up escaped and the C<$> or C<@> will
+trigger variable interpolation)
+
+=head1 GLOSSARY
+
+Most C<Config> variables are determined by the C<Configure> script
+on platforms supported by it (which is most UNIX platforms).  Some
+platforms have custom-made C<Config> variables, and may thus not have
+some of the variables described below, or may have extraneous variables
+specific to that particular port.  See the port specific documentation
+in such cases.
+
+ENDOFTAIL
+
+open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
+%seen = ();
+$text = 0;
+$/ = '';
+
+sub process {
+  s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
+  my $c = substr $1, 0, 1;
+  unless ($seen{$c}++) {
+    print CONFIG <<EOF if $text;
+=back
+
+EOF
+    print CONFIG <<EOF;
+=head2 $c
+
+=over
+
+EOF
+    $text = 1;
+  }
+  s/n't/n\00t/g;		# leave can't, won't etc untouched
+  s/^\t\s+(.*)/\n\t$1\n/gm;	# Indented lines ===> paragraphs
+  s/^(?<!\n\n)\t(.*)/$1/gm;	# Not indented lines ===> text
+  s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
+  s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
+  s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
+  s{
+     (?<! [\w./<\'\"] )		# Only standalone file names
+     (?! e \. g \. )		# Not e.g.
+     (?! \. \. \. )		# Not ...
+     (?! \d )			# Not 5.004
+     ( [\w./]* [./] [\w./]* )	# Require . or / inside
+     (?<! \. (?= \s ) )		# Do not include trailing dot
+     (?! [\w/] )		# Include all of it
+   }
+   (F<$1>)xg;			# /usr/local
+  s/((?<=\s)~\w*)/F<$1>/g;	# ~name
+  s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;	# UNISTD
+  s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
+  s/n[\0]t/n't/g;		# undo can't, won't damage
+}
+
+<GLOS>;				# Skip the preamble
+while (<GLOS>) {
+  process;
+  print CONFIG;
+}
+
+print CONFIG <<'ENDOFTAIL';
+
+=back
+
+=head1 NOTE
+
+This module contains a good example of how to use tie to implement a
+cache and an example of how to make a tied variable readonly to those
+outside of it.
+
+=cut
+
+ENDOFTAIL
+
+close(CONFIG);
+close(GLOS);
+
+# Now do some simple tests on the Config.pm file we have created
+unshift(@INC,'lib');
+require $config_pm;
+import Config;
+
+die "$0: $config_pm not valid"
+	unless $Config{'CONFIG'} eq 'true';
+
+die "$0: error processing $config_pm"
+	if defined($Config{'an impossible name'})
+	or $Config{'CONFIG'} ne 'true' # test cache
+	;
+
+die "$0: error processing $config_pm"
+	if eval '$Config{"cc"} = 1'
+	or eval 'delete $Config{"cc"}'
+	;
+
+
+exit 0;

contrib/perl5/configure.gnu

@@ -0,0 +1,124 @@
+#! /bin/sh
+#
+# $Id: configure,v 3.0.1.1 1995/07/25 14:16:21 ram Exp $
+#
+# GNU configure-like front end to metaconfig's Configure.
+#
+# Written by Andy Dougherty <doughera@lafcol.lafayette.edu>
+# and Matthew Green <mrg@mame.mu.oz.au>.
+#
+# Reformatted and modified for inclusion in the dist-3.0 package by
+# Raphael Manfredi <ram@hptnos02.grenoble.hp.com>.
+#
+# This script belongs to the public domain and may be freely redistributed.
+#
+# The remaining of this leading shell comment may be removed if you
+# include this script in your own package.
+#
+# $Log: configure,v $
+# Revision 3.0.1.1  1995/07/25  14:16:21  ram
+# patch56: created
+#
+
+(exit $?0) || exec sh $0 $argv:q
+
+case "$0" in
+*configure)
+    if cmp $0 `echo $0 | sed -e s/configure/Configure/` >/dev/null; then
+	echo "Your configure and Configure scripts seem to be identical."
+	echo "This can happen on filesystems that aren't fully case sensitive."
+	echo "You'll have to explicitly extract Configure and run that."
+	exit 1
+    fi
+    ;;
+esac
+
+opts=''
+verbose=''
+create='-e'
+while test $# -gt 0; do
+	case $1 in
+    --help)
+		cat <<EOM
+Usage: configure.gnu [options]
+This is GNU configure-like front end for a metaconfig-generated Configure.
+It emulates the following GNU configure options (must be fully spelled out):
+	--help
+	--no-create
+	--prefix=PREFIX
+ 	--cache-file  (ignored)
+	--quiet
+	--silent
+	--verbose
+	--version
+
+And it honours these environment variables: CC, CFLAGS and DEFS.
+EOM
+		exit 0
+		;;
+	--no-create)
+		create='-E'
+		shift
+		;;
+	--prefix=*)
+		arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'`
+		opts="$opts $arg"
+		shift
+		;;
+ 	--cache-file=*)
+ 		shift		# Just ignore it.
+ 		;;
+	--quiet|--silent)
+		exec >/dev/null 2>&1
+		shift
+		;;
+	--verbose)
+		verbose=true
+		shift
+		;;
+	--version)
+		copt="$copt -V"
+		shift
+		;;
+	--*)
+		opt=`echo $1 | sed 's/=.*//'`
+		echo "This GNU configure front end does not understand $opt"
+		exit 1
+		;;
+	*)
+		opts="$opts $1"
+		shift
+		;;
+	esac
+done
+
+case "$CC" in
+'') ;;
+*) opts="$opts -Dcc='$CC'";;
+esac
+
+# Join DEFS and CFLAGS together.
+ccflags=''
+case "$DEFS" in
+'') ;;
+*) ccflags=$DEFS;;
+esac
+case "$CFLAGS" in
+'') ;;
+*) ccflags="$ccflags $CFLAGS";;
+esac
+case "$ccflags" in
+'') ;;
+*) opts="$opts -Dccflags='$ccflags'";;
+esac
+
+# Don't use -s if they want verbose mode
+case "$verbose" in
+'') copt="$copt -ds";;
+*) copt="$copt -d";;
+esac
+
+set X sh Configure $copt $create $opts
+shift
+echo "$@"
+exec "$@"

contrib/perl5/cop.h

@@ -0,0 +1,368 @@
+/*    cop.h
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+struct cop {
+    BASEOP
+    char *	cop_label;	/* label for this construct */
+    HV *	cop_stash;	/* package line was compiled in */
+    GV *	cop_filegv;	/* file the following line # is from */
+    U32		cop_seq;	/* parse sequence number */
+    I32		cop_arybase;	/* array base this line was compiled with */
+    line_t      cop_line;       /* line # of this command */
+};
+
+#define Nullcop Null(COP*)
+
+/*
+ * Here we have some enormously heavy (or at least ponderous) wizardry.
+ */
+
+/* subroutine context */
+struct block_sub {
+    CV *	cv;
+    GV *	gv;
+    GV *	dfoutgv;
+#ifndef USE_THREADS
+    AV *	savearray;
+#endif /* USE_THREADS */
+    AV *	argarray;
+    U16		olddepth;
+    U8		hasargs;
+};
+
+#define PUSHSUB(cx)							\
+	cx->blk_sub.cv = cv;						\
+	cx->blk_sub.olddepth = CvDEPTH(cv);				\
+	cx->blk_sub.hasargs = hasargs;
+
+#define PUSHFORMAT(cx)							\
+	cx->blk_sub.cv = cv;						\
+	cx->blk_sub.gv = gv;						\
+	cx->blk_sub.hasargs = 0;					\
+	cx->blk_sub.dfoutgv = PL_defoutgv;				\
+	(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
+
+#define POPSUB(cx)							\
+	{ struct block_sub cxsub;					\
+	  POPSUB1(cx);							\
+	  POPSUB2(); }
+
+#define POPSUB1(cx)							\
+	cxsub = cx->blk_sub;	/* because DESTROY may clobber *cx */
+
+#ifdef USE_THREADS
+#define POPSAVEARRAY() NOOP
+#else
+#define POPSAVEARRAY()							\
+    STMT_START {							\
+	SvREFCNT_dec(GvAV(PL_defgv));					\
+	GvAV(PL_defgv) = cxsub.savearray;					\
+    } STMT_END
+#endif /* USE_THREADS */
+
+#define POPSUB2()							\
+	if (cxsub.hasargs) {						\
+	    POPSAVEARRAY();						\
+	    /* destroy arg array */					\
+	    av_clear(cxsub.argarray);					\
+	    AvREAL_off(cxsub.argarray);					\
+	}								\
+	if (cxsub.cv) {							\
+	    if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth))			\
+		SvREFCNT_dec(cxsub.cv);					\
+	}
+
+#define POPFORMAT(cx)							\
+	setdefout(cx->blk_sub.dfoutgv);					\
+	SvREFCNT_dec(cx->blk_sub.dfoutgv);
+
+/* eval context */
+struct block_eval {
+    I32		old_in_eval;
+    I32		old_op_type;
+    char *	old_name;
+    OP *	old_eval_root;
+    SV *	cur_text;
+};
+
+#define PUSHEVAL(cx,n,fgv)						\
+	cx->blk_eval.old_in_eval = PL_in_eval;				\
+	cx->blk_eval.old_op_type = PL_op->op_type;				\
+	cx->blk_eval.old_name = n;					\
+	cx->blk_eval.old_eval_root = PL_eval_root;				\
+	cx->blk_eval.cur_text = PL_linestr;
+
+#define POPEVAL(cx)							\
+	PL_in_eval = cx->blk_eval.old_in_eval;				\
+	optype = cx->blk_eval.old_op_type;				\
+	PL_eval_root = cx->blk_eval.old_eval_root;
+
+/* loop context */
+struct block_loop {
+    char *	label;
+    I32		resetsp;
+    OP *	redo_op;
+    OP *	next_op;
+    OP *	last_op;
+    SV **	itervar;
+    SV *	itersave;
+    SV *	iterlval;
+    AV *	iterary;
+    IV		iterix;
+    IV		itermax;
+};
+
+#define PUSHLOOP(cx, ivar, s)						\
+	cx->blk_loop.label = PL_curcop->cop_label;				\
+	cx->blk_loop.resetsp = s - PL_stack_base;				\
+	cx->blk_loop.redo_op = cLOOP->op_redoop;			\
+	cx->blk_loop.next_op = cLOOP->op_nextop;			\
+	cx->blk_loop.last_op = cLOOP->op_lastop;			\
+	if (cx->blk_loop.itervar = (ivar))				\
+	    cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
+	cx->blk_loop.iterlval = Nullsv;					\
+	cx->blk_loop.iterary = Nullav;					\
+	cx->blk_loop.iterix = -1;
+
+#define POPLOOP(cx)							\
+	{ struct block_loop cxloop;					\
+	  POPLOOP1(cx);							\
+	  POPLOOP2(); }
+
+#define POPLOOP1(cx)							\
+	cxloop = cx->blk_loop;	/* because DESTROY may clobber *cx */	\
+	newsp = PL_stack_base + cxloop.resetsp;
+
+#define POPLOOP2()							\
+	SvREFCNT_dec(cxloop.iterlval);					\
+	if (cxloop.itervar) {						\
+	    SvREFCNT_dec(*cxloop.itervar);				\
+	    *cxloop.itervar = cxloop.itersave;				\
+	}								\
+	if (cxloop.iterary && cxloop.iterary != PL_curstack)		\
+	    SvREFCNT_dec(cxloop.iterary);
+
+/* context common to subroutines, evals and loops */
+struct block {
+    I32		blku_oldsp;	/* stack pointer to copy stuff down to */
+    COP *	blku_oldcop;	/* old curcop pointer */
+    I32		blku_oldretsp;	/* return stack index */
+    I32		blku_oldmarksp;	/* mark stack index */
+    I32		blku_oldscopesp;	/* scope stack index */
+    PMOP *	blku_oldpm;	/* values of pattern match vars */
+    U8		blku_gimme;	/* is this block running in list context? */
+
+    union {
+	struct block_sub	blku_sub;
+	struct block_eval	blku_eval;
+	struct block_loop	blku_loop;
+    } blk_u;
+};
+#define blk_oldsp	cx_u.cx_blk.blku_oldsp
+#define blk_oldcop	cx_u.cx_blk.blku_oldcop
+#define blk_oldretsp	cx_u.cx_blk.blku_oldretsp
+#define blk_oldmarksp	cx_u.cx_blk.blku_oldmarksp
+#define blk_oldscopesp	cx_u.cx_blk.blku_oldscopesp
+#define blk_oldpm	cx_u.cx_blk.blku_oldpm
+#define blk_gimme	cx_u.cx_blk.blku_gimme
+#define blk_sub		cx_u.cx_blk.blk_u.blku_sub
+#define blk_eval	cx_u.cx_blk.blk_u.blku_eval
+#define blk_loop	cx_u.cx_blk.blk_u.blku_loop
+
+/* Enter a block. */
+#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],		\
+	cx->cx_type		= t,					\
+	cx->blk_oldsp		= sp - PL_stack_base,			\
+	cx->blk_oldcop		= PL_curcop,				\
+	cx->blk_oldmarksp	= PL_markstack_ptr - PL_markstack,		\
+	cx->blk_oldscopesp	= PL_scopestack_ix,			\
+	cx->blk_oldretsp	= PL_retstack_ix,				\
+	cx->blk_oldpm		= PL_curpm,				\
+	cx->blk_gimme		= gimme;				\
+	DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n",	\
+		    (long)cxstack_ix, block_type[t]); )
+
+/* Exit a block (RETURN and LAST). */
+#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],			\
+	newsp		 = PL_stack_base + cx->blk_oldsp,			\
+	PL_curcop	 = cx->blk_oldcop,				\
+	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,		\
+	PL_scopestack_ix = cx->blk_oldscopesp,				\
+	PL_retstack_ix	 = cx->blk_oldretsp,				\
+	pm		 = cx->blk_oldpm,				\
+	gimme		 = cx->blk_gimme;				\
+	DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n",		\
+		    (long)cxstack_ix+1,block_type[cx->cx_type]); )
+
+/* Continue a block elsewhere (NEXT and REDO). */
+#define TOPBLOCK(cx) cx  = &cxstack[cxstack_ix],			\
+	PL_stack_sp	 = PL_stack_base + cx->blk_oldsp,			\
+	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,		\
+	PL_scopestack_ix = cx->blk_oldscopesp,				\
+	PL_retstack_ix	 = cx->blk_oldretsp
+
+/* substitution context */
+struct subst {
+    I32		sbu_iters;
+    I32		sbu_maxiters;
+    I32		sbu_safebase;
+    I32		sbu_oldsave;
+    bool	sbu_once;
+    bool	sbu_rxtainted;
+    char *	sbu_orig;
+    SV *	sbu_dstr;
+    SV *	sbu_targ;
+    char *	sbu_s;
+    char *	sbu_m;
+    char *	sbu_strend;
+    void *	sbu_rxres;
+    REGEXP *	sbu_rx;
+};
+#define sb_iters	cx_u.cx_subst.sbu_iters
+#define sb_maxiters	cx_u.cx_subst.sbu_maxiters
+#define sb_safebase	cx_u.cx_subst.sbu_safebase
+#define sb_oldsave	cx_u.cx_subst.sbu_oldsave
+#define sb_once		cx_u.cx_subst.sbu_once
+#define sb_rxtainted	cx_u.cx_subst.sbu_rxtainted
+#define sb_orig		cx_u.cx_subst.sbu_orig
+#define sb_dstr		cx_u.cx_subst.sbu_dstr
+#define sb_targ		cx_u.cx_subst.sbu_targ
+#define sb_s		cx_u.cx_subst.sbu_s
+#define sb_m		cx_u.cx_subst.sbu_m
+#define sb_strend	cx_u.cx_subst.sbu_strend
+#define sb_rxres	cx_u.cx_subst.sbu_rxres
+#define sb_rx		cx_u.cx_subst.sbu_rx
+
+#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],			\
+	cx->sb_iters		= iters,				\
+	cx->sb_maxiters		= maxiters,				\
+	cx->sb_safebase		= safebase,				\
+	cx->sb_oldsave		= oldsave,				\
+	cx->sb_once		= once,					\
+	cx->sb_rxtainted	= rxtainted,				\
+	cx->sb_orig		= orig,					\
+	cx->sb_dstr		= dstr,					\
+	cx->sb_targ		= targ,					\
+	cx->sb_s		= s,					\
+	cx->sb_m		= m,					\
+	cx->sb_strend		= strend,				\
+	cx->sb_rxres		= Null(void*),				\
+	cx->sb_rx		= rx,					\
+	cx->cx_type		= CXt_SUBST;				\
+	rxres_save(&cx->sb_rxres, rx)
+
+#define POPSUBST(cx) cx = &cxstack[cxstack_ix--];			\
+	rxres_free(&cx->sb_rxres)
+
+struct context {
+    I32		cx_type;	/* what kind of context this is */
+    union {
+	struct block	cx_blk;
+	struct subst	cx_subst;
+    } cx_u;
+};
+#define CXt_NULL	0
+#define CXt_SUB		1
+#define CXt_EVAL	2
+#define CXt_LOOP	3
+#define CXt_SUBST	4
+#define CXt_BLOCK	5
+
+#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
+
+/* "gimme" values */
+#define G_SCALAR	0
+#define G_ARRAY		1
+#define G_VOID		128	/* skip this bit when adding flags below */
+
+/* extra flags for perl_call_* routines */
+#define G_DISCARD	2	/* Call FREETMPS. */
+#define G_EVAL		4	/* Assume eval {} around subroutine call. */
+#define G_NOARGS	8	/* Don't construct a @_ array. */
+#define G_KEEPERR      16	/* Append errors to $@, don't overwrite it */
+#define G_NODEBUG      32	/* Disable debugging at toplevel.  */
+
+/* Support for switching (stack and block) contexts.
+ * This ensures magic doesn't invalidate local stack and cx pointers.
+ */
+
+#define PERLSI_UNKNOWN		-1
+#define PERLSI_UNDEF		0
+#define PERLSI_MAIN		1
+#define PERLSI_MAGIC		2
+#define PERLSI_SORT		3
+#define PERLSI_SIGNAL		4
+#define PERLSI_OVERLOAD		5
+#define PERLSI_DESTROY		6
+#define PERLSI_WARNHOOK		7
+#define PERLSI_DIEHOOK		8
+#define PERLSI_REQUIRE		9
+
+struct stackinfo {
+    AV *		si_stack;	/* stack for current runlevel */
+    PERL_CONTEXT *	si_cxstack;	/* context stack for runlevel */
+    I32			si_cxix;	/* current context index */
+    I32			si_cxmax;	/* maximum allocated index */
+    I32			si_type;	/* type of runlevel */
+    struct stackinfo *	si_prev;
+    struct stackinfo *	si_next;
+    I32 *		si_markbase;	/* where markstack begins for us.
+					 * currently used only with DEBUGGING,
+					 * but not #ifdef-ed for bincompat */
+};
+
+typedef struct stackinfo PERL_SI;
+
+#define cxstack		(PL_curstackinfo->si_cxstack)
+#define cxstack_ix	(PL_curstackinfo->si_cxix)
+#define cxstack_max	(PL_curstackinfo->si_cxmax)
+
+#ifdef DEBUGGING
+#  define	SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
+#else
+#  define	SET_MARKBASE NOOP
+#endif
+
+#define PUSHSTACKi(type) \
+    STMT_START {							\
+	PERL_SI *next = PL_curstackinfo->si_next;			\
+	if (!next) {							\
+	    next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1);	\
+	    next->si_prev = PL_curstackinfo;				\
+	    PL_curstackinfo->si_next = next;				\
+	}								\
+	next->si_type = type;						\
+	next->si_cxix = -1;						\
+	AvFILLp(next->si_stack) = 0;					\
+	SWITCHSTACK(PL_curstack,next->si_stack);			\
+	PL_curstackinfo = next;						\
+	SET_MARKBASE;							\
+    } STMT_END
+
+#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
+
+#define POPSTACK \
+    STMT_START {							\
+	PERL_SI *prev = PL_curstackinfo->si_prev;			\
+	if (!prev) {							\
+	    PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n");	\
+	    my_exit(1);							\
+	}								\
+	SWITCHSTACK(PL_curstack,prev->si_stack);			\
+	/* don't free prev here, free them all at the END{} */		\
+	PL_curstackinfo = prev;						\
+    } STMT_END
+
+#define POPSTACK_TO(s) \
+    STMT_START {							\
+	while (PL_curstack != s) {					\
+	    dounwind(-1);						\
+	    POPSTACK;							\
+	}								\
+    } STMT_END

contrib/perl5/cv.h

@@ -0,0 +1,96 @@
+/*    cv.h
+ *
+ *    Copyright (c) 1991-1997, 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.
+ *
+ */
+
+/* This structure much match the beginning of XPVFM */
+
+struct xpvcv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xp_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xof_off;	/* integer value */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    HV *	xcv_stash;
+    OP *	xcv_start;
+    OP *	xcv_root;
+    void      (*xcv_xsub) _((CV* _CPERLproto));
+    ANY		xcv_xsubany;
+    GV *	xcv_gv;
+    GV *	xcv_filegv;
+    long	xcv_depth;		/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+#ifdef USE_THREADS
+    perl_mutex *xcv_mutexp;
+    struct perl_thread *xcv_owner;	/* current owner thread */
+#endif /* USE_THREADS */
+    cv_flags_t	xcv_flags;
+};
+
+#define Nullcv Null(CV*)
+
+#define CvSTASH(sv)	((XPVCV*)SvANY(sv))->xcv_stash
+#define CvSTART(sv)	((XPVCV*)SvANY(sv))->xcv_start
+#define CvROOT(sv)	((XPVCV*)SvANY(sv))->xcv_root
+#define CvXSUB(sv)	((XPVCV*)SvANY(sv))->xcv_xsub
+#define CvXSUBANY(sv)	((XPVCV*)SvANY(sv))->xcv_xsubany
+#define CvGV(sv)	((XPVCV*)SvANY(sv))->xcv_gv
+#define CvFILEGV(sv)	((XPVCV*)SvANY(sv))->xcv_filegv
+#define CvDEPTH(sv)	((XPVCV*)SvANY(sv))->xcv_depth
+#define CvPADLIST(sv)	((XPVCV*)SvANY(sv))->xcv_padlist
+#define CvOUTSIDE(sv)	((XPVCV*)SvANY(sv))->xcv_outside
+#ifdef USE_THREADS
+#define CvMUTEXP(sv)	((XPVCV*)SvANY(sv))->xcv_mutexp
+#define CvOWNER(sv)	((XPVCV*)SvANY(sv))->xcv_owner
+#endif /* USE_THREADS */
+#define CvFLAGS(sv)	((XPVCV*)SvANY(sv))->xcv_flags
+
+#define CVf_CLONE	0x0001	/* anon CV uses external lexicals */
+#define CVf_CLONED	0x0002	/* a clone of one of those */
+#define CVf_ANON	0x0004	/* CvGV() can't be trusted */
+#define CVf_OLDSTYLE	0x0008
+#define CVf_UNIQUE	0x0010	/* can't be cloned */
+#define CVf_NODEBUG	0x0020	/* no DB::sub indirection for this CV
+				   (esp. useful for special XSUBs) */
+#define CVf_METHOD	0x0040	/* CV is explicitly marked as a method */
+#define CVf_LOCKED	0x0080	/* CV locks itself or first arg on entry */
+
+#define CvCLONE(cv)		(CvFLAGS(cv) & CVf_CLONE)
+#define CvCLONE_on(cv)		(CvFLAGS(cv) |= CVf_CLONE)
+#define CvCLONE_off(cv)		(CvFLAGS(cv) &= ~CVf_CLONE)
+
+#define CvCLONED(cv)		(CvFLAGS(cv) & CVf_CLONED)
+#define CvCLONED_on(cv)		(CvFLAGS(cv) |= CVf_CLONED)
+#define CvCLONED_off(cv)	(CvFLAGS(cv) &= ~CVf_CLONED)
+
+#define CvANON(cv)		(CvFLAGS(cv) & CVf_ANON)
+#define CvANON_on(cv)		(CvFLAGS(cv) |= CVf_ANON)
+#define CvANON_off(cv)		(CvFLAGS(cv) &= ~CVf_ANON)
+
+#define CvOLDSTYLE(cv)		(CvFLAGS(cv) & CVf_OLDSTYLE)
+#define CvOLDSTYLE_on(cv)	(CvFLAGS(cv) |= CVf_OLDSTYLE)
+#define CvOLDSTYLE_off(cv)	(CvFLAGS(cv) &= ~CVf_OLDSTYLE)
+
+#define CvUNIQUE(cv)		(CvFLAGS(cv) & CVf_UNIQUE)
+#define CvUNIQUE_on(cv)		(CvFLAGS(cv) |= CVf_UNIQUE)
+#define CvUNIQUE_off(cv)	(CvFLAGS(cv) &= ~CVf_UNIQUE)
+
+#define CvNODEBUG(cv)		(CvFLAGS(cv) & CVf_NODEBUG)
+#define CvNODEBUG_on(cv)	(CvFLAGS(cv) |= CVf_NODEBUG)
+#define CvNODEBUG_off(cv)	(CvFLAGS(cv) &= ~CVf_NODEBUG)
+
+#define CvMETHOD(cv)		(CvFLAGS(cv) & CVf_METHOD)
+#define CvMETHOD_on(cv)		(CvFLAGS(cv) |= CVf_METHOD)
+#define CvMETHOD_off(cv)	(CvFLAGS(cv) &= ~CVf_METHOD)
+
+#define CvLOCKED(cv)		(CvFLAGS(cv) & CVf_LOCKED)
+#define CvLOCKED_on(cv)		(CvFLAGS(cv) |= CVf_LOCKED)
+#define CvLOCKED_off(cv)	(CvFLAGS(cv) &= ~CVf_LOCKED)

contrib/perl5/deb.c

@@ -0,0 +1,114 @@
+/*    deb.c
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "Didst thou think that the eyes of the White Tower were blind?  Nay, I
+ * have seen more than thou knowest, Gray Fool."  --Denethor
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void
+deb(const char *pat, ...)
+{
+#ifdef DEBUGGING
+    dTHR;
+    va_list args;
+    register I32 i;
+    GV* gv = PL_curcop->cop_filegv;
+
+#ifdef USE_THREADS
+    PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t",
+		  (unsigned long) thr,
+		  SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+		  (long)PL_curcop->cop_line);
+#else
+    PerlIO_printf(Perl_debug_log, "(%s:%ld)\t",
+	SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+	(long)PL_curcop->cop_line);
+#endif /* USE_THREADS */
+    for (i=0; i<PL_dlevel; i++)
+	PerlIO_printf(Perl_debug_log, "%c%c ",PL_debname[i],PL_debdelim[i]);
+
+    va_start(args, pat);
+    (void) PerlIO_vprintf(Perl_debug_log,pat,args);
+    va_end( args );
+#endif /* DEBUGGING */
+}
+
+void
+deb_growlevel(void)
+{
+#ifdef DEBUGGING
+    PL_dlmax += 128;
+    Renew(PL_debname, PL_dlmax, char);
+    Renew(PL_debdelim, PL_dlmax, char);
+#endif /* DEBUGGING */
+}
+
+I32
+debstackptrs(void)
+{
+#ifdef DEBUGGING
+    dTHR;
+    PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
+	(unsigned long)PL_curstack, (unsigned long)PL_stack_base,
+	(long)*PL_markstack_ptr, (long)(PL_stack_sp-PL_stack_base),
+	(long)(PL_stack_max-PL_stack_base));
+    PerlIO_printf(Perl_debug_log, "%8lx %8lx %8ld %8ld %8ld\n",
+	(unsigned long)PL_mainstack, (unsigned long)AvARRAY(PL_curstack),
+	(long)PL_mainstack, (long)AvFILLp(PL_curstack), (long)AvMAX(PL_curstack));
+#endif /* DEBUGGING */
+    return 0;
+}
+
+I32
+debstack(void)
+{
+#ifdef DEBUGGING
+    dTHR;
+    I32 top = PL_stack_sp - PL_stack_base;
+    register I32 i = top - 30;
+    I32 *markscan = PL_curstackinfo->si_markbase;
+
+    if (i < 0)
+	i = 0;
+    
+    while (++markscan <= PL_markstack_ptr)
+	if (*markscan >= i)
+	    break;
+
+#ifdef USE_THREADS
+    PerlIO_printf(Perl_debug_log, i ? "0x%lx    =>  ...  " : "0x%lx    =>  ",
+		  (unsigned long) thr);
+#else
+    PerlIO_printf(Perl_debug_log, i ? "    =>  ...  " : "    =>  ");
+#endif /* USE_THREADS */
+    if (PL_stack_base[0] != &PL_sv_undef || PL_stack_sp < PL_stack_base)
+	PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
+    do {
+	++i;
+	if (markscan <= PL_markstack_ptr && *markscan < i) {
+	    do {
+		++markscan;
+		PerlIO_putc(Perl_debug_log, '*');
+	    }
+	    while (markscan <= PL_markstack_ptr && *markscan < i);
+	    PerlIO_printf(Perl_debug_log, "  ");
+	}
+	if (i > top)
+	    break;
+	PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(PL_stack_base[i]));
+    }
+    while (1);
+    PerlIO_printf(Perl_debug_log, "\n");
+#endif /* DEBUGGING */
+    return 0;
+}

contrib/perl5/doop.c

@@ -0,0 +1,528 @@
+/*    doop.c
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "'So that was the job I felt I had to do when I started,' thought Sam."
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+I32
+do_trans(SV *sv, OP *arg)
+{
+    dTHR;
+    register short *tbl;
+    register U8 *s;
+    register U8 *send;
+    register U8 *d;
+    register I32 ch;
+    register I32 matches = 0;
+    register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
+    register U8 *p;
+    STRLEN len;
+
+    if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
+	croak(no_modify);
+    tbl = (short*)cPVOP->op_pv;
+    s = (U8*)SvPV(sv, len);
+    if (!len)
+	return 0;
+    if (!SvPOKp(sv))
+	s = (U8*)SvPV_force(sv, len);
+    (void)SvPOK_only(sv);
+    send = s + len;
+    if (!tbl || !s)
+	croak("panic: do_trans");
+    DEBUG_t( deb("2.TBL\n"));
+    if (!PL_op->op_private) {
+	while (s < send) {
+	    if ((ch = tbl[*s]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+	SvSETMAGIC(sv);
+    }
+    else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
+	while (s < send) {
+	    if (tbl[*s] >= 0)
+		matches++;
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	p = send;
+	while (s < send) {
+	    if ((ch = tbl[*s]) >= 0) {
+		*d = ch;
+		matches++;
+		if (squash) {
+		    if (p == d - 1 && *p == *d)
+			matches--;
+		    else
+		        p = d++;
+		}
+		else
+		    d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
+	    s++;
+	}
+	matches += send - d;	/* account for disappeared chars */
+	*d = '\0';
+	SvCUR_set(sv, d - (U8*)SvPVX(sv));
+	SvSETMAGIC(sv);
+    }
+    return matches;
+}
+
+void
+do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
+{
+    SV **oldmark = mark;
+    register I32 items = sp - mark;
+    register STRLEN len;
+    STRLEN delimlen;
+    register char *delim = SvPV(del, delimlen);
+    STRLEN tmplen;
+
+    mark++;
+    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
+    if (SvTYPE(sv) < SVt_PV)
+	sv_upgrade(sv, SVt_PV);
+    if (SvLEN(sv) < len + items) {	/* current length is way too short */
+	while (items-- > 0) {
+	    if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
+		SvPV(*mark, tmplen);
+		len += tmplen;
+	    }
+	    mark++;
+	}
+	SvGROW(sv, len + 1);		/* so try to pre-extend */
+
+	mark = oldmark;
+	items = sp - mark;;
+	++mark;
+    }
+
+    if (items-- > 0) {
+	char *s;
+
+	if (*mark) {
+	    s = SvPV(*mark, tmplen);
+	    sv_setpvn(sv, s, tmplen);
+	}
+	else
+	    sv_setpv(sv, "");
+	mark++;
+    }
+    else
+	sv_setpv(sv,"");
+    len = delimlen;
+    if (len) {
+	for (; items > 0; items--,mark++) {
+	    sv_catpvn(sv,delim,len);
+	    sv_catsv(sv,*mark);
+	}
+    }
+    else {
+	for (; items > 0; items--,mark++)
+	    sv_catsv(sv,*mark);
+    }
+    SvSETMAGIC(sv);
+}
+
+void
+do_sprintf(SV *sv, I32 len, SV **sarg)
+{
+    STRLEN patlen;
+    char *pat = SvPV(*sarg, patlen);
+    bool do_taint = FALSE;
+
+    sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
+    SvSETMAGIC(sv);
+    if (do_taint)
+	SvTAINTED_on(sv);
+}
+
+void
+do_vecset(SV *sv)
+{
+    SV *targ = LvTARG(sv);
+    register I32 offset;
+    register I32 size;
+    register unsigned char *s;
+    register unsigned long lval;
+    I32 mask;
+    STRLEN targlen;
+    STRLEN len;
+
+    if (!targ)
+	return;
+    s = (unsigned char*)SvPV_force(targ, targlen);
+    lval = U_L(SvNV(sv));
+    offset = LvTARGOFF(sv);
+    size = LvTARGLEN(sv);
+    
+    len = (offset + size + 7) / 8;
+    if (len > targlen) {
+	s = (unsigned char*)SvGROW(targ, len + 1);
+	(void)memzero(s + targlen, len - targlen + 1);
+	SvCUR_set(targ, len);
+    }
+    
+    if (size < 8) {
+	mask = (1 << size) - 1;
+	size = offset & 7;
+	lval &= mask;
+	offset >>= 3;
+	s[offset] &= ~(mask << size);
+	s[offset] |= lval << size;
+    }
+    else {
+	offset >>= 3;
+	if (size == 8)
+	    s[offset] = lval & 255;
+	else if (size == 16) {
+	    s[offset] = (lval >> 8) & 255;
+	    s[offset+1] = lval & 255;
+	}
+	else if (size == 32) {
+	    s[offset] = (lval >> 24) & 255;
+	    s[offset+1] = (lval >> 16) & 255;
+	    s[offset+2] = (lval >> 8) & 255;
+	    s[offset+3] = lval & 255;
+	}
+    }
+}
+
+void
+do_chop(register SV *astr, register SV *sv)
+{
+    STRLEN len;
+    char *s;
+    
+    if (SvTYPE(sv) == SVt_PVAV) {
+	register I32 i;
+        I32 max;
+	AV* av = (AV*)sv;
+        max = AvFILL(av);
+        for (i = 0; i <= max; i++) {
+	    sv = (SV*)av_fetch(av, i, FALSE);
+	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
+		do_chop(astr, sv);
+	}
+        return;
+    }
+    if (SvTYPE(sv) == SVt_PVHV) {
+        HV* hv = (HV*)sv;
+	HE* entry;
+        (void)hv_iterinit(hv);
+        /*SUPPRESS 560*/
+        while (entry = hv_iternext(hv))
+            do_chop(astr,hv_iterval(hv,entry));
+        return;
+    }
+    s = SvPV(sv, len);
+    if (len && !SvPOK(sv))
+	s = SvPV_force(sv, len);
+    if (s && len) {
+	s += --len;
+	sv_setpvn(astr, s, 1);
+	*s = '\0';
+	SvCUR_set(sv, len);
+	SvNIOK_off(sv);
+    }
+    else
+	sv_setpvn(astr, "", 0);
+    SvSETMAGIC(sv);
+} 
+
+I32
+do_chomp(register SV *sv)
+{
+    dTHR;
+    register I32 count;
+    STRLEN len;
+    char *s;
+
+    if (RsSNARF(PL_rs))
+	return 0;
+    count = 0;
+    if (SvTYPE(sv) == SVt_PVAV) {
+	register I32 i;
+        I32 max;
+	AV* av = (AV*)sv;
+        max = AvFILL(av);
+        for (i = 0; i <= max; i++) {
+	    sv = (SV*)av_fetch(av, i, FALSE);
+	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
+		count += do_chomp(sv);
+	}
+        return count;
+    }
+    if (SvTYPE(sv) == SVt_PVHV) {
+        HV* hv = (HV*)sv;
+	HE* entry;
+        (void)hv_iterinit(hv);
+        /*SUPPRESS 560*/
+        while (entry = hv_iternext(hv))
+            count += do_chomp(hv_iterval(hv,entry));
+        return count;
+    }
+    s = SvPV(sv, len);
+    if (len && !SvPOKp(sv))
+	s = SvPV_force(sv, len);
+    if (s && len) {
+	s += --len;
+	if (RsPARA(PL_rs)) {
+	    if (*s != '\n')
+		goto nope;
+	    ++count;
+	    while (len && s[-1] == '\n') {
+		--len;
+		--s;
+		++count;
+	    }
+	}
+	else {
+	    STRLEN rslen;
+	    char *rsptr = SvPV(PL_rs, rslen);
+	    if (rslen == 1) {
+		if (*s != *rsptr)
+		    goto nope;
+		++count;
+	    }
+	    else {
+		if (len < rslen - 1)
+		    goto nope;
+		len -= rslen - 1;
+		s -= rslen - 1;
+		if (memNE(s, rsptr, rslen))
+		    goto nope;
+		count += rslen;
+	    }
+	}
+	*s = '\0';
+	SvCUR_set(sv, len);
+	SvNIOK_off(sv);
+    }
+  nope:
+    SvSETMAGIC(sv);
+    return count;
+} 
+
+void
+do_vop(I32 optype, SV *sv, SV *left, SV *right)
+{
+    dTHR;	/* just for taint */
+#ifdef LIBERAL
+    register long *dl;
+    register long *ll;
+    register long *rl;
+#endif
+    register char *dc;
+    STRLEN leftlen;
+    STRLEN rightlen;
+    register char *lc;
+    register char *rc;
+    register I32 len;
+    I32 lensave;
+    char *lsave;
+    char *rsave;
+
+    if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
+	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
+    lsave = lc = SvPV(left, leftlen);
+    rsave = rc = SvPV(right, rightlen);
+    len = leftlen < rightlen ? leftlen : rightlen;
+    lensave = len;
+    if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
+	dc = SvPV_force(sv, PL_na);
+	if (SvCUR(sv) < len) {
+	    dc = SvGROW(sv, len + 1);
+	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+	}
+    }
+    else {
+	I32 needlen = ((optype == OP_BIT_AND)
+			? len : (leftlen > rightlen ? leftlen : rightlen));
+	Newz(801, dc, needlen + 1, char);
+	(void)sv_usepvn(sv, dc, needlen);
+	dc = SvPVX(sv);		/* sv_usepvn() calls Renew() */
+    }
+    SvCUR_set(sv, len);
+    (void)SvPOK_only(sv);
+#ifdef LIBERAL
+    if (len >= sizeof(long)*4 &&
+	!((long)dc % sizeof(long)) &&
+	!((long)lc % sizeof(long)) &&
+	!((long)rc % sizeof(long)))	/* It's almost always aligned... */
+    {
+	I32 remainder = len % (sizeof(long)*4);
+	len /= (sizeof(long)*4);
+
+	dl = (long*)dc;
+	ll = (long*)lc;
+	rl = (long*)rc;
+
+	switch (optype) {
+	case OP_BIT_AND:
+	    while (len--) {
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+	    }
+	    break;
+	case OP_BIT_XOR:
+	    while (len--) {
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+	    }
+	    break;
+	case OP_BIT_OR:
+	    while (len--) {
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+	    }
+	}
+
+	dc = (char*)dl;
+	lc = (char*)ll;
+	rc = (char*)rl;
+
+	len = remainder;
+    }
+#endif
+    {
+	switch (optype) {
+	case OP_BIT_AND:
+	    while (len--)
+		*dc++ = *lc++ & *rc++;
+	    break;
+	case OP_BIT_XOR:
+	    while (len--)
+		*dc++ = *lc++ ^ *rc++;
+	    goto mop_up;
+	case OP_BIT_OR:
+	    while (len--)
+		*dc++ = *lc++ | *rc++;
+	  mop_up:
+	    len = lensave;
+	    if (rightlen > len)
+		sv_catpvn(sv, rsave + len, rightlen - len);
+	    else if (leftlen > len)
+		sv_catpvn(sv, lsave + len, leftlen - len);
+	    else
+		*SvEND(sv) = '\0';
+	    break;
+	}
+    }
+    SvTAINT(sv);
+}
+
+OP *
+do_kv(ARGSproto)
+{
+    djSP;
+    HV *hv = (HV*)POPs;
+    HV *keys;
+    register HE *entry;
+    SV *tmpstr;
+    I32 gimme = GIMME_V;
+    I32 dokeys =   (PL_op->op_type == OP_KEYS);
+    I32 dovalues = (PL_op->op_type == OP_VALUES);
+    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    
+    if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
+	dokeys = dovalues = TRUE;
+
+    if (!hv) {
+	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
+	    dTARGET;		/* make sure to clear its target here */
+	    if (SvTYPE(TARG) == SVt_PVLV)
+		LvTARG(TARG) = Nullsv;
+	    PUSHs(TARG);
+	}
+	RETURN;
+    }
+
+    keys = realhv ? hv : avhv_keys((AV*)hv);
+    (void)hv_iterinit(keys);	/* always reset iterator regardless */
+
+    if (gimme == G_VOID)
+	RETURN;
+
+    if (gimme == G_SCALAR) {
+	IV i;
+	dTARGET;
+
+	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
+	    if (SvTYPE(TARG) < SVt_PVLV) {
+		sv_upgrade(TARG, SVt_PVLV);
+		sv_magic(TARG, Nullsv, 'k', Nullch, 0);
+	    }
+	    LvTYPE(TARG) = 'k';
+	    if (LvTARG(TARG) != (SV*)keys) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(keys);
+	    }
+	    PUSHs(TARG);
+	    RETURN;
+	}
+
+	if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
+	    i = HvKEYS(keys);
+	else {
+	    i = 0;
+	    /*SUPPRESS 560*/
+	    while (hv_iternext(keys)) i++;
+	}
+	PUSHi( i );
+	RETURN;
+    }
+
+    EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
+
+    PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
+    while (entry = hv_iternext(keys)) {
+	SPAGAIN;
+	if (dokeys)
+	    XPUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
+	if (dovalues) {
+	    tmpstr = sv_newmortal();
+	    PUTBACK;
+	    sv_setsv(tmpstr,realhv ?
+		     hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
+	    DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
+			    (unsigned long)HeHASH(entry),
+			    HvMAX(keys)+1,
+			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
+	    SPAGAIN;
+	    XPUSHs(tmpstr);
+	}
+	PUTBACK;
+    }
+    return NORMAL;
+}
+

contrib/perl5/dosish.h

@@ -0,0 +1,135 @@
+#define ABORT() abort();
+
+#ifndef SH_PATH
+#define SH_PATH "/bin/sh"
+#endif
+
+#ifdef DJGPP
+#  define BIT_BUCKET "nul"
+#  define OP_BINARY O_BINARY
+#  define PERL_SYS_INIT(c,v) Perl_DJGPP_init(c,v)
+#  include <signal.h>
+#  define HAS_UTIME
+#  define HAS_KILL
+   char *djgpp_pathexp (const char*);
+#  if (DJGPP==2 && DJGPP_MINOR < 2)
+#    define NO_LOCALECONV_MON_THOUSANDS_SEP
+#  endif
+#  ifdef USE_THREADS
+#    define NEED_PTHREAD_INIT
+#    define OLD_PTHREADS_API
+#    define YIELD pthread_yield(NULL)
+#    define DETACH(t)				\
+       STMT_START {				\
+         if (pthread_detach(&(t)->self)) {	\
+             MUTEX_UNLOCK(&(t)->mutex);		\
+             croak("panic: DETACH");		\
+         }					\
+       } STMT_END
+#    define pthread_mutexattr_default NULL
+#    define pthread_condattr_default NULL
+#    define pthread_addr_t any_t
+#    define PTHREAD_CREATE_JOINABLE (&err)
+#  endif
+#else	/* DJGPP */
+#  ifdef WIN32
+#    define PERL_SYS_INIT(c,v)	Perl_win32_init(c,v)
+#    define BIT_BUCKET "nul"
+#  else
+#    define PERL_SYS_INIT(c,v)
+#    define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
+#  endif
+#endif	/* DJGPP */
+
+#define PERL_SYS_TERM() MALLOC_TERM
+#define dXSUB_SYS
+#define TMPPATH "plXXXXXX"
+
+/*
+ * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were 
+ * running on DOS, *and* if we had to cope with 16 bit memory addressing 
+ * constraints, *and* we need to have memory allocated as unsigned long.
+ *
+ * with the advent of *real* compilers for DOS, they are not locked together.
+ * MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have 
+ * 16 bit memory addressing constraints".
+ *
+ * if you need the last, try #DEFINE MEM_SIZE unsigned long.
+ */
+#ifdef MSDOS
+ #ifndef DJGPP
+  #define HAS_64K_LIMIT
+ #endif
+#endif
+
+/* USEMYBINMODE
+ *	This symbol, if defined, indicates that the program should
+ *	use the routine my_binmode(FILE *fp, char iotype) to insure
+ *	that a file is in "binary" mode -- that is, that no translation
+ *	of bytes occurs on read or write operations.
+ */
+#undef USEMYBINMODE
+
+/* Stat_t:
+ *	This symbol holds the type used to declare buffers for information
+ *	returned by stat().  It's usually just struct stat.  It may be necessary
+ *	to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ *	information.
+ */
+#define Stat_t struct stat
+
+/* USE_STAT_RDEV:
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_rdev
+ */
+#define USE_STAT_RDEV 	/**/
+
+/* ACME_MESS:
+ *	This symbol, if defined, indicates that error messages should be 
+ *	should be generated in a format that allows the use of the Acme
+ *	GUI/editor's autofind feature.
+ */
+#undef ACME_MESS	/**/
+
+/* ALTERNATE_SHEBANG:
+ *	This symbol, if defined, contains a "magic" string which may be used
+ *	as the first line of a Perl program designed to be executed directly
+ *	by name, instead of the standard Unix #!.  If ALTERNATE_SHEBANG
+ *	begins with a character other then #, then Perl will only treat
+ *	it as a command line if if finds the string "perl" in the first
+ *	word; otherwise it's treated as the first line of code in the script.
+ *	(IOW, Perl won't hand off to another interpreter via an alternate
+ *	shebang sequence that might be legal Perl code.)
+ */
+/* #define ALTERNATE_SHEBANG "#!" / **/
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
+#define Mkdir(path,mode)   mkdir((path),(mode))
+
+#ifndef WIN32
+#  define Stat(fname,bufptr) stat((fname),(bufptr))
+#else
+#  define HAS_IOCTL
+#  define HAS_UTIME
+#  define HAS_KILL
+#  define HAS_WAIT
+#  define HAS_CHOWN
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ */
+#  ifndef HASATTRIBUTE
+#    ifndef PERL_OBJECT
+#      include <win32iop.h>
+#    endif
+#  endif
+#endif	/* WIN32 */

contrib/perl5/dump.c

@@ -0,0 +1,422 @@
+/*    dump.c
+ *
+ *    Copyright (c) 1991-1997, Larry Wall
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
+ * it has not been hard for me to read your mind and memory.'"
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifndef PERL_OBJECT
+static void dump(char *pat, ...);
+#endif /* PERL_OBJECT */
+
+void
+dump_all(void)
+{
+#ifdef DEBUGGING
+    dTHR;
+    PerlIO_setlinebuf(Perl_debug_log);
+    if (PL_main_root)
+	dump_op(PL_main_root);
+    dump_packsubs(PL_defstash);
+#endif	/* DEBUGGING */
+}
+
+void
+dump_packsubs(HV *stash)
+{
+#ifdef DEBUGGING
+    dTHR;
+    I32	i;
+    HE	*entry;
+
+    if (!HvARRAY(stash))
+	return;
+    for (i = 0; i <= (I32) HvMAX(stash); i++) {
+	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
+	    GV *gv = (GV*)HeVAL(entry);
+	    HV *hv;
+	    if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
+		continue;
+	    if (GvCVu(gv))
+		dump_sub(gv);
+	    if (GvFORM(gv))
+		dump_form(gv);
+	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
+	      (hv = GvHV(gv)) && HvNAME(hv) && hv != PL_defstash)
+		dump_packsubs(hv);		/* nested package */
+	}
+    }
+#endif	/* DEBUGGING */
+}
+
+void
+dump_sub(GV *gv)
+{
+#ifdef DEBUGGING
+    SV *sv = sv_newmortal();
+
+    gv_fullname3(sv, gv, Nullch);
+    dump("\nSUB %s = ", SvPVX(sv));
+    if (CvXSUB(GvCV(gv)))
+	dump("(xsub 0x%x %d)\n",
+	    (long)CvXSUB(GvCV(gv)),
+	    CvXSUBANY(GvCV(gv)).any_i32);
+    else if (CvROOT(GvCV(gv)))
+	dump_op(CvROOT(GvCV(gv)));
+    else
+	dump("<undef>\n");
+#endif	/* DEBUGGING */
+}
+
+void
+dump_form(GV *gv)
+{
+#ifdef DEBUGGING
+    SV *sv = sv_newmortal();
+
+    gv_fullname3(sv, gv, Nullch);
+    dump("\nFORMAT %s = ", SvPVX(sv));
+    if (CvROOT(GvFORM(gv)))
+	dump_op(CvROOT(GvFORM(gv)));
+    else
+	dump("<undef>\n");
+#endif	/* DEBUGGING */
+}
+
+void
+dump_eval(void)
+{
+#ifdef DEBUGGING
+    dump_op(PL_eval_root);
+#endif	/* DEBUGGING */
+}
+
+void
+dump_op(OP *o)
+{
+#ifdef DEBUGGING
+    dump("{\n");
+    if (o->op_seq)
+	PerlIO_printf(Perl_debug_log, "%-4d", o->op_seq);
+    else
+	PerlIO_printf(Perl_debug_log, "    ");
+    dump("TYPE = %s  ===> ", op_name[o->op_type]);
+    if (o->op_next) {
+	if (o->op_seq)
+	    PerlIO_printf(Perl_debug_log, "%d\n", o->op_next->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "(%d)\n", o->op_next->op_seq);
+    }
+    else
+	PerlIO_printf(Perl_debug_log, "DONE\n");
+    PL_dumplvl++;
+    if (o->op_targ) {
+	if (o->op_type == OP_NULL)
+	    dump("  (was %s)\n", op_name[o->op_targ]);
+	else
+	    dump("TARG = %d\n", o->op_targ);
+    }
+#ifdef DUMPADDR
+    dump("ADDR = 0x%lx => 0x%lx\n",o, o->op_next);
+#endif
+    if (o->op_flags) {
+	SV *tmpsv = newSVpv("", 0);
+	switch (o->op_flags & OPf_WANT) {
+	case OPf_WANT_VOID:
+	    sv_catpv(tmpsv, ",VOID");
+	    break;
+	case OPf_WANT_SCALAR:
+	    sv_catpv(tmpsv, ",SCALAR");
+	    break;
+	case OPf_WANT_LIST:
+	    sv_catpv(tmpsv, ",LIST");
+	    break;
+	default:
+	    sv_catpv(tmpsv, ",UNKNOWN");
+	    break;
+	}
+	if (o->op_flags & OPf_KIDS)
+	    sv_catpv(tmpsv, ",KIDS");
+	if (o->op_flags & OPf_PARENS)
+	    sv_catpv(tmpsv, ",PARENS");
+	if (o->op_flags & OPf_STACKED)
+	    sv_catpv(tmpsv, ",STACKED");
+	if (o->op_flags & OPf_REF)
+	    sv_catpv(tmpsv, ",REF");
+	if (o->op_flags & OPf_MOD)
+	    sv_catpv(tmpsv, ",MOD");
+	if (o->op_flags & OPf_SPECIAL)
+	    sv_catpv(tmpsv, ",SPECIAL");
+	dump("FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
+	SvREFCNT_dec(tmpsv);
+    }
+    if (o->op_private) {
+	SV *tmpsv = newSVpv("", 0);
+	if (o->op_type == OP_AASSIGN) {
+	    if (o->op_private & OPpASSIGN_COMMON)
+		sv_catpv(tmpsv, ",COMMON");
+	}
+	else if (o->op_type == OP_SASSIGN) {
+	    if (o->op_private & OPpASSIGN_BACKWARDS)
+		sv_catpv(tmpsv, ",BACKWARDS");
+	}
+	else if (o->op_type == OP_TRANS) {
+	    if (o->op_private & OPpTRANS_SQUASH)
+		sv_catpv(tmpsv, ",SQUASH");
+	    if (o->op_private & OPpTRANS_DELETE)
+		sv_catpv(tmpsv, ",DELETE");
+	    if (o->op_private & OPpTRANS_COMPLEMENT)
+		sv_catpv(tmpsv, ",COMPLEMENT");
+	}
+	else if (o->op_type == OP_REPEAT) {
+	    if (o->op_private & OPpREPEAT_DOLIST)
+		sv_catpv(tmpsv, ",DOLIST");
+	}
+	else if (o->op_type == OP_ENTERSUB ||
+		 o->op_type == OP_RV2SV ||
+		 o->op_type == OP_RV2AV ||
+		 o->op_type == OP_RV2HV ||
+		 o->op_type == OP_RV2GV ||
+		 o->op_type == OP_AELEM ||
+		 o->op_type == OP_HELEM )
+	{
+	    if (o->op_type == OP_ENTERSUB) {
+		if (o->op_private & OPpENTERSUB_AMPER)
+		    sv_catpv(tmpsv, ",AMPER");
+		if (o->op_private & OPpENTERSUB_DB)
+		    sv_catpv(tmpsv, ",DB");
+	    }
+	    switch (o->op_private & OPpDEREF) {
+	    case OPpDEREF_SV:
+		sv_catpv(tmpsv, ",SV");
+		break;
+	    case OPpDEREF_AV:
+		sv_catpv(tmpsv, ",AV");
+		break;
+	    case OPpDEREF_HV:
+		sv_catpv(tmpsv, ",HV");
+		break;
+	    }
+	    if (o->op_type == OP_AELEM || o->op_type == OP_HELEM) {
+		if (o->op_private & OPpLVAL_DEFER)
+		    sv_catpv(tmpsv, ",LVAL_DEFER");
+	    }
+	    else {
+		if (o->op_private & HINT_STRICT_REFS)
+		    sv_catpv(tmpsv, ",STRICT_REFS");
+	    }
+	}
+	else if (o->op_type == OP_CONST) {
+	    if (o->op_private & OPpCONST_BARE)
+		sv_catpv(tmpsv, ",BARE");
+	}
+	else if (o->op_type == OP_FLIP) {
+	    if (o->op_private & OPpFLIP_LINENUM)
+		sv_catpv(tmpsv, ",LINENUM");
+	}
+	else if (o->op_type == OP_FLOP) {
+	    if (o->op_private & OPpFLIP_LINENUM)
+		sv_catpv(tmpsv, ",LINENUM");
+	}
+	if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
+	    sv_catpv(tmpsv, ",INTRO");
+	if (SvCUR(tmpsv))
+	    dump("PRIVATE = (%s)\n", SvPVX(tmpsv) + 1);
+	SvREFCNT_dec(tmpsv);
+    }
+
+    switch (o->op_type) {
+    case OP_GVSV:
+    case OP_GV:
+	if (cGVOPo->op_gv) {
+	    SV *tmpsv = NEWSV(0,0);
+	    ENTER;
+	    SAVEFREESV(tmpsv);
+	    gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
+	    dump("GV = %s\n", SvPV(tmpsv, PL_na));
+	    LEAVE;
+	}
+	else
+	    dump("GV = NULL\n");
+	break;
+    case OP_CONST:
+	dump("SV = %s\n", SvPEEK(cSVOPo->op_sv));
+	break;
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+	if (cCOPo->cop_line)
+	    dump("LINE = %d\n",cCOPo->cop_line);
+	if (cCOPo->cop_label)
+	    dump("LABEL = \"%s\"\n",cCOPo->cop_label);
+	break;
+    case OP_ENTERLOOP:
+	dump("REDO ===> ");
+	if (cLOOPo->op_redoop)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_redoop->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	dump("NEXT ===> ");
+	if (cLOOPo->op_nextop)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_nextop->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	dump("LAST ===> ");
+	if (cLOOPo->op_lastop)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cLOOPo->op_lastop->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	break;
+    case OP_COND_EXPR:
+	dump("TRUE ===> ");
+	if (cCONDOPo->op_true)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_true->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	dump("FALSE ===> ");
+	if (cCONDOPo->op_false)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cCONDOPo->op_false->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	break;
+    case OP_MAPWHILE:
+    case OP_GREPWHILE:
+    case OP_OR:
+    case OP_AND:
+	dump("OTHER ===> ");
+	if (cLOGOPo->op_other)
+	    PerlIO_printf(Perl_debug_log, "%d\n", cLOGOPo->op_other->op_seq);
+	else
+	    PerlIO_printf(Perl_debug_log, "DONE\n");
+	break;
+    case OP_PUSHRE:
+    case OP_MATCH:
+    case OP_QR:
+    case OP_SUBST:
+	dump_pm(cPMOPo);
+	break;
+    default:
+	break;
+    }
+    if (o->op_flags & OPf_KIDS) {
+	OP *kid;
+	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
+	    dump_op(kid);
+    }
+    PL_dumplvl--;
+    dump("}\n");
+#endif	/* DEBUGGING */
+}
+
+void
+dump_gv(GV *gv)
+{
+#ifdef DEBUGGING
+    SV *sv;
+
+    if (!gv) {
+	PerlIO_printf(Perl_debug_log, "{}\n");
+	return;
+    }
+    sv = sv_newmortal();
+    PL_dumplvl++;
+    PerlIO_printf(Perl_debug_log, "{\n");
+    gv_fullname3(sv, gv, Nullch);
+    dump("GV_NAME = %s", SvPVX(sv));
+    if (gv != GvEGV(gv)) {
+	gv_efullname3(sv, GvEGV(gv), Nullch);
+	dump("-> %s", SvPVX(sv));
+    }
+    dump("\n");
+    PL_dumplvl--;
+    dump("}\n");
+#endif	/* DEBUGGING */
+}
+
+void
+dump_pm(PMOP *pm)
+{
+#ifdef DEBUGGING
+    char ch;
+
+    if (!pm) {
+	dump("{}\n");
+	return;
+    }
+    dump("{\n");
+    PL_dumplvl++;
+    if (pm->op_pmflags & PMf_ONCE)
+	ch = '?';
+    else
+	ch = '/';
+    if (pm->op_pmregexp)
+	dump("PMf_PRE %c%s%c%s\n",
+	     ch, pm->op_pmregexp->precomp, ch,
+	     (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
+    else
+	dump("PMf_PRE (RUNTIME)\n");
+    if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+	dump("PMf_REPL = ");
+	dump_op(pm->op_pmreplroot);
+    }
+    if (pm->op_pmflags || (pm->op_pmregexp && pm->op_pmregexp->check_substr)) {
+	SV *tmpsv = newSVpv("", 0);
+	if (pm->op_pmdynflags & PMdf_USED)
+	    sv_catpv(tmpsv, ",USED");
+	if (pm->op_pmdynflags & PMdf_TAINTED)
+	    sv_catpv(tmpsv, ",TAINTED");
+	if (pm->op_pmflags & PMf_ONCE)
+	    sv_catpv(tmpsv, ",ONCE");
+	if (pm->op_pmregexp && pm->op_pmregexp->check_substr
+	    && !(pm->op_pmregexp->reganch & ROPT_NOSCAN))
+	    sv_catpv(tmpsv, ",SCANFIRST");
+	if (pm->op_pmregexp && pm->op_pmregexp->check_substr
+	    && pm->op_pmregexp->reganch & ROPT_CHECK_ALL)
+	    sv_catpv(tmpsv, ",ALL");
+	if (pm->op_pmflags & PMf_SKIPWHITE)
+	    sv_catpv(tmpsv, ",SKIPWHITE");
+	if (pm->op_pmflags & PMf_CONST)
+	    sv_catpv(tmpsv, ",CONST");
+	if (pm->op_pmflags & PMf_KEEP)
+	    sv_catpv(tmpsv, ",KEEP");
+	if (pm->op_pmflags & PMf_GLOBAL)
+	    sv_catpv(tmpsv, ",GLOBAL");
+	if (pm->op_pmflags & PMf_CONTINUE)
+	    sv_catpv(tmpsv, ",CONTINUE");
+	if (pm->op_pmflags & PMf_RETAINT)
+	    sv_catpv(tmpsv, ",RETAINT");
+	if (pm->op_pmflags & PMf_EVAL)
+	    sv_catpv(tmpsv, ",EVAL");
+	dump("PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
+	SvREFCNT_dec(tmpsv);
+    }
+
+    PL_dumplvl--;
+    dump("}\n");
+#endif	/* DEBUGGING */
+}
+
+
+STATIC void
+dump(char *pat,...)
+{
+#ifdef DEBUGGING
+    I32 i;
+    va_list args;
+
+    va_start(args, pat);
+    for (i = PL_dumplvl*4; i; i--)
+	(void)PerlIO_putc(Perl_debug_log,' ');
+    PerlIO_vprintf(Perl_debug_log,pat,args);
+    va_end(args);
+#endif	/* DEBUGGING */
+}

contrib/perl5/ebcdic.c

@@ -0,0 +1,32 @@
+#include "EXTERN.h"
+#include "perl.h"
+
+/* in ASCII order, not that it matters */
+static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+ 
+int
+ebcdic_control(int ch)
+{
+    	if (ch > 'a') {
+	        char *ctlp;
+ 
+ 	       if (islower(ch))
+  	              ch = toupper(ch);
+ 
+ 	       if ((ctlp = strchr(controllablechars, ch)) == 0) {
+  	              die("unrecognised control character '%c'\n", ch);
+     	       }
+ 
+        	if (ctlp == controllablechars)
+         	       return('\177'); /* DEL */
+        	else
+         	       return((unsigned char)(ctlp - controllablechars - 1));
+	} else { /* Want uncontrol */
+        	if (ch == '\177' || ch == -1)
+                	return('?');
+        	else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                	return(controllablechars[ch+1]);
+        	else
+                	die("invalid control request: '\\%03o'\n", ch & 0xFF);
+	}
+}

contrib/perl5/embed.pl

@@ -0,0 +1,323 @@
+#!/usr/bin/perl -w
+
+require 5.003;
+
+# XXX others that may need adding
+#       warnhook
+#       hints
+#       copline
+my @extvars = qw(sv_undef sv_yes sv_no na dowarn
+                 curcop compiling 
+                 tainting tainted stack_base stack_sp sv_arenaroot
+                 curstash DBsub DBsingle debstash
+                 rsfp 
+                 stdingv
+		 defgv
+		 errgv
+		 rsfp_filters
+		 perldb
+		 diehook
+		 dirty
+		 perl_destruct_level
+                );
+
+sub readsyms (\%$) {
+    my ($syms, $file) = @_;
+    %$syms = ();
+    local (*FILE, $_);
+    open(FILE, "< $file")
+	or die "embed.pl: Can't open $file: $!\n";
+    while (<FILE>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	if (/^\s*(\S+)\s*$/) {
+	    $$syms{$1} = 1;
+	}
+    }
+    close(FILE);
+}
+
+readsyms %global, 'global.sym';
+readsyms %interp, 'interp.sym';
+
+sub readvars(\%$$) {
+    my ($syms, $file,$pre) = @_;
+    %$syms = ();
+    local (*FILE, $_);
+    open(FILE, "< $file")
+	or die "embed.pl: Can't open $file: $!\n";
+    while (<FILE>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	if (/PERLVARI?C?\($pre(\w+)/) {
+	    $$syms{$1} = 1;
+	}
+    }
+    close(FILE);
+}
+
+my %intrp;
+my %thread;
+
+readvars %intrp,  'intrpvar.h','I';
+readvars %thread, 'thrdvar.h','T';
+readvars %globvar, 'perlvars.h','G';
+
+foreach my $sym (sort keys %intrp)
+ {
+  warn "$sym not in interp.sym\n" unless exists $interp{$sym};
+  if (exists $global{$sym})
+   {
+    delete $global{$sym};
+    warn "$sym in global.sym as well as interp\n";
+   }
+ }
+
+foreach my $sym (sort keys %globvar)
+ {
+  if (exists $global{$sym})
+   {
+    delete $global{$sym};
+    warn "$sym in global.sym as well as perlvars.h\n";
+   }
+ }
+
+foreach my $sym (keys %interp)
+ {
+  warn "extra $sym in interp.sym\n" 
+   unless exists $intrp{$sym} || exists $thread{$sym};
+ }
+
+foreach my $sym (sort keys %thread)
+ {
+  warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
+  if (exists $global{$sym})
+   {
+    delete $global{$sym};
+    warn "$sym in global.sym as well as thread\n";
+   }
+ }
+
+sub hide ($$) {
+    my ($from, $to) = @_;
+    my $t = int(length($from) / 8);
+    "#define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
+}
+sub embed ($) {
+    my ($sym) = @_;
+    hide($sym, "Perl_$sym");
+}
+sub embedvar ($) {
+    my ($sym) = @_;
+#   hide($sym, "Perl_$sym");
+    return '';
+}
+
+sub multon ($$$) {
+    my ($sym,$pre,$ptr) = @_;
+    hide("PL_$sym", "($ptr$pre$sym)");
+}
+sub multoff ($$) {
+    my ($sym,$pre) = @_;
+    return hide("PL_$pre$sym", "PL_$sym");
+}
+
+unlink 'embed.h';
+open(EM, '> embed.h')
+    or die "Can't create embed.h: $!\n";
+
+print EM <<'END';
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+   This file is built by embed.pl from global.sym, intrpvar.h,
+   and thrdvar.h.  Any changes made here will be lost!
+*/
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+#ifndef NO_EMBED
+#  define EMBED 1 
+#endif
+
+/* Hide global symbols? */
+
+#ifdef EMBED
+
+END
+
+for $sym (sort keys %global) {
+    print EM embed($sym);
+}
+
+print EM <<'END';
+
+#endif /* EMBED */
+
+END
+
+close(EM);
+
+unlink 'embedvar.h';
+open(EM, '> embedvar.h')
+    or die "Can't create embedvar.h: $!\n";
+
+print EM <<'END';
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+   This file is built by embed.pl from global.sym, intrpvar.h,
+   and thrdvar.h.  Any changes made here will be lost!
+*/
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+
+
+/* Put interpreter-specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+#ifndef USE_THREADS
+/* If we do not have threads then per-thread vars are per-interpreter */
+
+END
+
+for $sym (sort keys %thread) {
+    print EM multon($sym,'T','PL_curinterp->');
+}
+
+print EM <<'END';
+
+#endif /* !USE_THREADS */
+
+/* These are always per-interpreter if there is more than one */
+
+END
+
+for $sym (sort keys %intrp) {
+    print EM multon($sym,'I','PL_curinterp->');
+}
+
+print EM <<'END';
+
+#else	/* !MULTIPLICITY */
+
+END
+
+for $sym (sort keys %intrp) {
+    print EM multoff($sym,'I');
+}
+
+print EM <<'END';
+
+#ifndef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+    print EM multoff($sym,'T');
+}
+
+print EM <<'END';
+
+#endif /* USE_THREADS */
+
+/* Hide what would have been interpreter-specific symbols? */
+
+#ifdef EMBED
+
+END
+
+for $sym (sort keys %intrp) {
+    print EM embedvar($sym);
+}
+
+print EM <<'END';
+
+#ifndef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+    print EM embedvar($sym);
+}
+
+print EM <<'END';
+
+#endif /* USE_THREADS */
+#endif /* EMBED */
+#endif /* MULTIPLICITY */
+
+/* Now same trickey for per-thread variables */
+
+#ifdef USE_THREADS
+
+END
+
+for $sym (sort keys %thread) {
+    print EM multon($sym,'T','thr->');
+}
+
+print EM <<'END';
+
+#endif /* USE_THREADS */
+
+#ifdef PERL_GLOBAL_STRUCT
+
+END
+
+for $sym (sort keys %globvar) {
+    print EM multon($sym,'G','PL_Vars.');
+}
+
+print EM <<'END';
+
+#else /* !PERL_GLOBAL_STRUCT */
+
+END
+
+for $sym (sort keys %globvar) {
+    print EM multoff($sym,'G');
+}
+
+print EM <<'END';
+
+#ifdef EMBED
+
+END
+
+for $sym (sort keys %globvar) {
+    print EM embedvar($sym);
+}
+
+print EM <<'END';
+
+#endif /* EMBED */
+#endif /* PERL_GLOBAL_STRUCT */
+
+END
+
+print EM <<'END';
+
+#ifndef MIN_PERL_DEFINE  
+
+END
+
+for $sym (sort @extvars) {
+    print EM hide($sym,"PL_$sym");
+}
+
+print EM <<'END';
+
+#endif /* MIN_PERL_DEFINE */
+END
+
+
+close(EM);

contrib/perl5/embedvar.h

@@ -0,0 +1,891 @@
+/* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+   This file is built by embed.pl from global.sym, intrpvar.h,
+   and thrdvar.h.  Any changes made here will be lost!
+*/
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+
+
+/* Put interpreter-specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+#ifndef USE_THREADS
+/* If we do not have threads then per-thread vars are per-interpreter */
+
+#define PL_Sv			(PL_curinterp->TSv)
+#define PL_Xpv			(PL_curinterp->TXpv)
+#define PL_av_fetch_sv		(PL_curinterp->Tav_fetch_sv)
+#define PL_bodytarget		(PL_curinterp->Tbodytarget)
+#define PL_bostr		(PL_curinterp->Tbostr)
+#define PL_chopset		(PL_curinterp->Tchopset)
+#define PL_colors		(PL_curinterp->Tcolors)
+#define PL_colorset		(PL_curinterp->Tcolorset)
+#define PL_curcop		(PL_curinterp->Tcurcop)
+#define PL_curpad		(PL_curinterp->Tcurpad)
+#define PL_curpm		(PL_curinterp->Tcurpm)
+#define PL_curstack		(PL_curinterp->Tcurstack)
+#define PL_curstackinfo		(PL_curinterp->Tcurstackinfo)
+#define PL_curstash		(PL_curinterp->Tcurstash)
+#define PL_defoutgv		(PL_curinterp->Tdefoutgv)
+#define PL_defstash		(PL_curinterp->Tdefstash)
+#define PL_delaymagic		(PL_curinterp->Tdelaymagic)
+#define PL_dirty		(PL_curinterp->Tdirty)
+#define PL_extralen		(PL_curinterp->Textralen)
+#define PL_firstgv		(PL_curinterp->Tfirstgv)
+#define PL_formtarget		(PL_curinterp->Tformtarget)
+#define PL_hv_fetch_ent_mh	(PL_curinterp->Thv_fetch_ent_mh)
+#define PL_hv_fetch_sv		(PL_curinterp->Thv_fetch_sv)
+#define PL_in_eval		(PL_curinterp->Tin_eval)
+#define PL_last_in_gv		(PL_curinterp->Tlast_in_gv)
+#define PL_lastgotoprobe	(PL_curinterp->Tlastgotoprobe)
+#define PL_lastscream		(PL_curinterp->Tlastscream)
+#define PL_localizing		(PL_curinterp->Tlocalizing)
+#define PL_mainstack		(PL_curinterp->Tmainstack)
+#define PL_markstack		(PL_curinterp->Tmarkstack)
+#define PL_markstack_max	(PL_curinterp->Tmarkstack_max)
+#define PL_markstack_ptr	(PL_curinterp->Tmarkstack_ptr)
+#define PL_maxscream		(PL_curinterp->Tmaxscream)
+#define PL_modcount		(PL_curinterp->Tmodcount)
+#define PL_nrs			(PL_curinterp->Tnrs)
+#define PL_ofs			(PL_curinterp->Tofs)
+#define PL_ofslen		(PL_curinterp->Tofslen)
+#define PL_op			(PL_curinterp->Top)
+#define PL_opsave		(PL_curinterp->Topsave)
+#define PL_reg_eval_set		(PL_curinterp->Treg_eval_set)
+#define PL_reg_flags		(PL_curinterp->Treg_flags)
+#define PL_reg_start_tmp	(PL_curinterp->Treg_start_tmp)
+#define PL_reg_start_tmpl	(PL_curinterp->Treg_start_tmpl)
+#define PL_regbol		(PL_curinterp->Tregbol)
+#define PL_regcc		(PL_curinterp->Tregcc)
+#define PL_regcode		(PL_curinterp->Tregcode)
+#define PL_regcomp_parse	(PL_curinterp->Tregcomp_parse)
+#define PL_regcomp_rx		(PL_curinterp->Tregcomp_rx)
+#define PL_regcompp		(PL_curinterp->Tregcompp)
+#define PL_regdata		(PL_curinterp->Tregdata)
+#define PL_regdummy		(PL_curinterp->Tregdummy)
+#define PL_regendp		(PL_curinterp->Tregendp)
+#define PL_regeol		(PL_curinterp->Tregeol)
+#define PL_regexecp		(PL_curinterp->Tregexecp)
+#define PL_regflags		(PL_curinterp->Tregflags)
+#define PL_regindent		(PL_curinterp->Tregindent)
+#define PL_reginput		(PL_curinterp->Treginput)
+#define PL_reginterp_cnt	(PL_curinterp->Treginterp_cnt)
+#define PL_reglastparen		(PL_curinterp->Treglastparen)
+#define PL_regnarrate		(PL_curinterp->Tregnarrate)
+#define PL_regnaughty		(PL_curinterp->Tregnaughty)
+#define PL_regnpar		(PL_curinterp->Tregnpar)
+#define PL_regprecomp		(PL_curinterp->Tregprecomp)
+#define PL_regprev		(PL_curinterp->Tregprev)
+#define PL_regprogram		(PL_curinterp->Tregprogram)
+#define PL_regsawback		(PL_curinterp->Tregsawback)
+#define PL_regseen		(PL_curinterp->Tregseen)
+#define PL_regsize		(PL_curinterp->Tregsize)
+#define PL_regstartp		(PL_curinterp->Tregstartp)
+#define PL_regtill		(PL_curinterp->Tregtill)
+#define PL_regxend		(PL_curinterp->Tregxend)
+#define PL_restartop		(PL_curinterp->Trestartop)
+#define PL_retstack		(PL_curinterp->Tretstack)
+#define PL_retstack_ix		(PL_curinterp->Tretstack_ix)
+#define PL_retstack_max		(PL_curinterp->Tretstack_max)
+#define PL_rs			(PL_curinterp->Trs)
+#define PL_savestack		(PL_curinterp->Tsavestack)
+#define PL_savestack_ix		(PL_curinterp->Tsavestack_ix)
+#define PL_savestack_max	(PL_curinterp->Tsavestack_max)
+#define PL_scopestack		(PL_curinterp->Tscopestack)
+#define PL_scopestack_ix	(PL_curinterp->Tscopestack_ix)
+#define PL_scopestack_max	(PL_curinterp->Tscopestack_max)
+#define PL_screamfirst		(PL_curinterp->Tscreamfirst)
+#define PL_screamnext		(PL_curinterp->Tscreamnext)
+#define PL_secondgv		(PL_curinterp->Tsecondgv)
+#define PL_seen_evals		(PL_curinterp->Tseen_evals)
+#define PL_seen_zerolen		(PL_curinterp->Tseen_zerolen)
+#define PL_sortcop		(PL_curinterp->Tsortcop)
+#define PL_sortcxix		(PL_curinterp->Tsortcxix)
+#define PL_sortstash		(PL_curinterp->Tsortstash)
+#define PL_stack_base		(PL_curinterp->Tstack_base)
+#define PL_stack_max		(PL_curinterp->Tstack_max)
+#define PL_stack_sp		(PL_curinterp->Tstack_sp)
+#define PL_start_env		(PL_curinterp->Tstart_env)
+#define PL_statbuf		(PL_curinterp->Tstatbuf)
+#define PL_statcache		(PL_curinterp->Tstatcache)
+#define PL_statgv		(PL_curinterp->Tstatgv)
+#define PL_statname		(PL_curinterp->Tstatname)
+#define PL_tainted		(PL_curinterp->Ttainted)
+#define PL_timesbuf		(PL_curinterp->Ttimesbuf)
+#define PL_tmps_floor		(PL_curinterp->Ttmps_floor)
+#define PL_tmps_ix		(PL_curinterp->Ttmps_ix)
+#define PL_tmps_max		(PL_curinterp->Ttmps_max)
+#define PL_tmps_stack		(PL_curinterp->Ttmps_stack)
+#define PL_top_env		(PL_curinterp->Ttop_env)
+#define PL_toptarget		(PL_curinterp->Ttoptarget)
+
+#endif /* !USE_THREADS */
+
+/* These are always per-interpreter if there is more than one */
+
+#define PL_Argv			(PL_curinterp->IArgv)
+#define PL_Cmd			(PL_curinterp->ICmd)
+#define PL_DBcv			(PL_curinterp->IDBcv)
+#define PL_DBgv			(PL_curinterp->IDBgv)
+#define PL_DBline		(PL_curinterp->IDBline)
+#define PL_DBsignal		(PL_curinterp->IDBsignal)
+#define PL_DBsingle		(PL_curinterp->IDBsingle)
+#define PL_DBsub		(PL_curinterp->IDBsub)
+#define PL_DBtrace		(PL_curinterp->IDBtrace)
+#define PL_ampergv		(PL_curinterp->Iampergv)
+#define PL_archpat_auto		(PL_curinterp->Iarchpat_auto)
+#define PL_argvgv		(PL_curinterp->Iargvgv)
+#define PL_argvoutgv		(PL_curinterp->Iargvoutgv)
+#define PL_basetime		(PL_curinterp->Ibasetime)
+#define PL_beginav		(PL_curinterp->Ibeginav)
+#define PL_bytecode_iv_overflows	(PL_curinterp->Ibytecode_iv_overflows)
+#define PL_bytecode_obj_list	(PL_curinterp->Ibytecode_obj_list)
+#define PL_bytecode_obj_list_fill	(PL_curinterp->Ibytecode_obj_list_fill)
+#define PL_bytecode_pv		(PL_curinterp->Ibytecode_pv)
+#define PL_bytecode_sv		(PL_curinterp->Ibytecode_sv)
+#define PL_cddir		(PL_curinterp->Icddir)
+#define PL_compcv		(PL_curinterp->Icompcv)
+#define PL_compiling		(PL_curinterp->Icompiling)
+#define PL_comppad		(PL_curinterp->Icomppad)
+#define PL_comppad_name		(PL_curinterp->Icomppad_name)
+#define PL_comppad_name_fill	(PL_curinterp->Icomppad_name_fill)
+#define PL_comppad_name_floor	(PL_curinterp->Icomppad_name_floor)
+#define PL_copline		(PL_curinterp->Icopline)
+#define PL_curcopdb		(PL_curinterp->Icurcopdb)
+#define PL_curstname		(PL_curinterp->Icurstname)
+#define PL_dbargs		(PL_curinterp->Idbargs)
+#define PL_debdelim		(PL_curinterp->Idebdelim)
+#define PL_debname		(PL_curinterp->Idebname)
+#define PL_debstash		(PL_curinterp->Idebstash)
+#define PL_defgv		(PL_curinterp->Idefgv)
+#define PL_diehook		(PL_curinterp->Idiehook)
+#define PL_dlevel		(PL_curinterp->Idlevel)
+#define PL_dlmax		(PL_curinterp->Idlmax)
+#define PL_doextract		(PL_curinterp->Idoextract)
+#define PL_doswitches		(PL_curinterp->Idoswitches)
+#define PL_dowarn		(PL_curinterp->Idowarn)
+#define PL_dumplvl		(PL_curinterp->Idumplvl)
+#define PL_e_script		(PL_curinterp->Ie_script)
+#define PL_endav		(PL_curinterp->Iendav)
+#define PL_envgv		(PL_curinterp->Ienvgv)
+#define PL_errgv		(PL_curinterp->Ierrgv)
+#define PL_eval_root		(PL_curinterp->Ieval_root)
+#define PL_eval_start		(PL_curinterp->Ieval_start)
+#define PL_exitlist		(PL_curinterp->Iexitlist)
+#define PL_exitlistlen		(PL_curinterp->Iexitlistlen)
+#define PL_fdpid		(PL_curinterp->Ifdpid)
+#define PL_filemode		(PL_curinterp->Ifilemode)
+#define PL_forkprocess		(PL_curinterp->Iforkprocess)
+#define PL_formfeed		(PL_curinterp->Iformfeed)
+#define PL_generation		(PL_curinterp->Igeneration)
+#define PL_gensym		(PL_curinterp->Igensym)
+#define PL_globalstash		(PL_curinterp->Iglobalstash)
+#define PL_hintgv		(PL_curinterp->Ihintgv)
+#define PL_in_clean_all		(PL_curinterp->Iin_clean_all)
+#define PL_in_clean_objs	(PL_curinterp->Iin_clean_objs)
+#define PL_incgv		(PL_curinterp->Iincgv)
+#define PL_initav		(PL_curinterp->Iinitav)
+#define PL_inplace		(PL_curinterp->Iinplace)
+#define PL_last_proto		(PL_curinterp->Ilast_proto)
+#define PL_lastfd		(PL_curinterp->Ilastfd)
+#define PL_lastsize		(PL_curinterp->Ilastsize)
+#define PL_lastspbase		(PL_curinterp->Ilastspbase)
+#define PL_laststatval		(PL_curinterp->Ilaststatval)
+#define PL_laststype		(PL_curinterp->Ilaststype)
+#define PL_leftgv		(PL_curinterp->Ileftgv)
+#define PL_lineary		(PL_curinterp->Ilineary)
+#define PL_linestart		(PL_curinterp->Ilinestart)
+#define PL_localpatches		(PL_curinterp->Ilocalpatches)
+#define PL_main_cv		(PL_curinterp->Imain_cv)
+#define PL_main_root		(PL_curinterp->Imain_root)
+#define PL_main_start		(PL_curinterp->Imain_start)
+#define PL_maxsysfd		(PL_curinterp->Imaxsysfd)
+#define PL_mess_sv		(PL_curinterp->Imess_sv)
+#define PL_minus_F		(PL_curinterp->Iminus_F)
+#define PL_minus_a		(PL_curinterp->Iminus_a)
+#define PL_minus_c		(PL_curinterp->Iminus_c)
+#define PL_minus_l		(PL_curinterp->Iminus_l)
+#define PL_minus_n		(PL_curinterp->Iminus_n)
+#define PL_minus_p		(PL_curinterp->Iminus_p)
+#define PL_modglobal		(PL_curinterp->Imodglobal)
+#define PL_multiline		(PL_curinterp->Imultiline)
+#define PL_mystrk		(PL_curinterp->Imystrk)
+#define PL_ofmt			(PL_curinterp->Iofmt)
+#define PL_oldlastpm		(PL_curinterp->Ioldlastpm)
+#define PL_oldname		(PL_curinterp->Ioldname)
+#define PL_op_mask		(PL_curinterp->Iop_mask)
+#define PL_origargc		(PL_curinterp->Iorigargc)
+#define PL_origargv		(PL_curinterp->Iorigargv)
+#define PL_origfilename		(PL_curinterp->Iorigfilename)
+#define PL_ors			(PL_curinterp->Iors)
+#define PL_orslen		(PL_curinterp->Iorslen)
+#define PL_parsehook		(PL_curinterp->Iparsehook)
+#define PL_patchlevel		(PL_curinterp->Ipatchlevel)
+#define PL_pending_ident	(PL_curinterp->Ipending_ident)
+#define PL_perl_destruct_level	(PL_curinterp->Iperl_destruct_level)
+#define PL_perldb		(PL_curinterp->Iperldb)
+#define PL_preambleav		(PL_curinterp->Ipreambleav)
+#define PL_preambled		(PL_curinterp->Ipreambled)
+#define PL_preprocess		(PL_curinterp->Ipreprocess)
+#define PL_profiledata		(PL_curinterp->Iprofiledata)
+#define PL_replgv		(PL_curinterp->Ireplgv)
+#define PL_rightgv		(PL_curinterp->Irightgv)
+#define PL_rsfp			(PL_curinterp->Irsfp)
+#define PL_rsfp_filters		(PL_curinterp->Irsfp_filters)
+#define PL_sawampersand		(PL_curinterp->Isawampersand)
+#define PL_sawstudy		(PL_curinterp->Isawstudy)
+#define PL_sawvec		(PL_curinterp->Isawvec)
+#define PL_siggv		(PL_curinterp->Isiggv)
+#define PL_splitstr		(PL_curinterp->Isplitstr)
+#define PL_statusvalue		(PL_curinterp->Istatusvalue)
+#define PL_statusvalue_vms	(PL_curinterp->Istatusvalue_vms)
+#define PL_stdingv		(PL_curinterp->Istdingv)
+#define PL_strchop		(PL_curinterp->Istrchop)
+#define PL_strtab		(PL_curinterp->Istrtab)
+#define PL_sub_generation	(PL_curinterp->Isub_generation)
+#define PL_sublex_info		(PL_curinterp->Isublex_info)
+#define PL_sv_arenaroot		(PL_curinterp->Isv_arenaroot)
+#define PL_sv_count		(PL_curinterp->Isv_count)
+#define PL_sv_objcount		(PL_curinterp->Isv_objcount)
+#define PL_sv_root		(PL_curinterp->Isv_root)
+#define PL_sys_intern		(PL_curinterp->Isys_intern)
+#define PL_tainting		(PL_curinterp->Itainting)
+#define PL_threadnum		(PL_curinterp->Ithreadnum)
+#define PL_thrsv		(PL_curinterp->Ithrsv)
+#define PL_unsafe		(PL_curinterp->Iunsafe)
+#define PL_warnhook		(PL_curinterp->Iwarnhook)
+
+#else	/* !MULTIPLICITY */
+
+#define PL_IArgv		PL_Argv
+#define PL_ICmd			PL_Cmd
+#define PL_IDBcv		PL_DBcv
+#define PL_IDBgv		PL_DBgv
+#define PL_IDBline		PL_DBline
+#define PL_IDBsignal		PL_DBsignal
+#define PL_IDBsingle		PL_DBsingle
+#define PL_IDBsub		PL_DBsub
+#define PL_IDBtrace		PL_DBtrace
+#define PL_Iampergv		PL_ampergv
+#define PL_Iarchpat_auto	PL_archpat_auto
+#define PL_Iargvgv		PL_argvgv
+#define PL_Iargvoutgv		PL_argvoutgv
+#define PL_Ibasetime		PL_basetime
+#define PL_Ibeginav		PL_beginav
+#define PL_Ibytecode_iv_overflows	PL_bytecode_iv_overflows
+#define PL_Ibytecode_obj_list	PL_bytecode_obj_list
+#define PL_Ibytecode_obj_list_fill	PL_bytecode_obj_list_fill
+#define PL_Ibytecode_pv		PL_bytecode_pv
+#define PL_Ibytecode_sv		PL_bytecode_sv
+#define PL_Icddir		PL_cddir
+#define PL_Icompcv		PL_compcv
+#define PL_Icompiling		PL_compiling
+#define PL_Icomppad		PL_comppad
+#define PL_Icomppad_name	PL_comppad_name
+#define PL_Icomppad_name_fill	PL_comppad_name_fill
+#define PL_Icomppad_name_floor	PL_comppad_name_floor
+#define PL_Icopline		PL_copline
+#define PL_Icurcopdb		PL_curcopdb
+#define PL_Icurstname		PL_curstname
+#define PL_Idbargs		PL_dbargs
+#define PL_Idebdelim		PL_debdelim
+#define PL_Idebname		PL_debname
+#define PL_Idebstash		PL_debstash
+#define PL_Idefgv		PL_defgv
+#define PL_Idiehook		PL_diehook
+#define PL_Idlevel		PL_dlevel
+#define PL_Idlmax		PL_dlmax
+#define PL_Idoextract		PL_doextract
+#define PL_Idoswitches		PL_doswitches
+#define PL_Idowarn		PL_dowarn
+#define PL_Idumplvl		PL_dumplvl
+#define PL_Ie_script		PL_e_script
+#define PL_Iendav		PL_endav
+#define PL_Ienvgv		PL_envgv
+#define PL_Ierrgv		PL_errgv
+#define PL_Ieval_root		PL_eval_root
+#define PL_Ieval_start		PL_eval_start
+#define PL_Iexitlist		PL_exitlist
+#define PL_Iexitlistlen		PL_exitlistlen
+#define PL_Ifdpid		PL_fdpid
+#define PL_Ifilemode		PL_filemode
+#define PL_Iforkprocess		PL_forkprocess
+#define PL_Iformfeed		PL_formfeed
+#define PL_Igeneration		PL_generation
+#define PL_Igensym		PL_gensym
+#define PL_Iglobalstash		PL_globalstash
+#define PL_Ihintgv		PL_hintgv
+#define PL_Iin_clean_all	PL_in_clean_all
+#define PL_Iin_clean_objs	PL_in_clean_objs
+#define PL_Iincgv		PL_incgv
+#define PL_Iinitav		PL_initav
+#define PL_Iinplace		PL_inplace
+#define PL_Ilast_proto		PL_last_proto
+#define PL_Ilastfd		PL_lastfd
+#define PL_Ilastsize		PL_lastsize
+#define PL_Ilastspbase		PL_lastspbase
+#define PL_Ilaststatval		PL_laststatval
+#define PL_Ilaststype		PL_laststype
+#define PL_Ileftgv		PL_leftgv
+#define PL_Ilineary		PL_lineary
+#define PL_Ilinestart		PL_linestart
+#define PL_Ilocalpatches	PL_localpatches
+#define PL_Imain_cv		PL_main_cv
+#define PL_Imain_root		PL_main_root
+#define PL_Imain_start		PL_main_start
+#define PL_Imaxsysfd		PL_maxsysfd
+#define PL_Imess_sv		PL_mess_sv
+#define PL_Iminus_F		PL_minus_F
+#define PL_Iminus_a		PL_minus_a
+#define PL_Iminus_c		PL_minus_c
+#define PL_Iminus_l		PL_minus_l
+#define PL_Iminus_n		PL_minus_n
+#define PL_Iminus_p		PL_minus_p
+#define PL_Imodglobal		PL_modglobal
+#define PL_Imultiline		PL_multiline
+#define PL_Imystrk		PL_mystrk
+#define PL_Iofmt		PL_ofmt
+#define PL_Ioldlastpm		PL_oldlastpm
+#define PL_Ioldname		PL_oldname
+#define PL_Iop_mask		PL_op_mask
+#define PL_Iorigargc		PL_origargc
+#define PL_Iorigargv		PL_origargv
+#define PL_Iorigfilename	PL_origfilename
+#define PL_Iors			PL_ors
+#define PL_Iorslen		PL_orslen
+#define PL_Iparsehook		PL_parsehook
+#define PL_Ipatchlevel		PL_patchlevel
+#define PL_Ipending_ident	PL_pending_ident
+#define PL_Iperl_destruct_level	PL_perl_destruct_level
+#define PL_Iperldb		PL_perldb
+#define PL_Ipreambleav		PL_preambleav
+#define PL_Ipreambled		PL_preambled
+#define PL_Ipreprocess		PL_preprocess
+#define PL_Iprofiledata		PL_profiledata
+#define PL_Ireplgv		PL_replgv
+#define PL_Irightgv		PL_rightgv
+#define PL_Irsfp		PL_rsfp
+#define PL_Irsfp_filters	PL_rsfp_filters
+#define PL_Isawampersand	PL_sawampersand
+#define PL_Isawstudy		PL_sawstudy
+#define PL_Isawvec		PL_sawvec
+#define PL_Isiggv		PL_siggv
+#define PL_Isplitstr		PL_splitstr
+#define PL_Istatusvalue		PL_statusvalue
+#define PL_Istatusvalue_vms	PL_statusvalue_vms
+#define PL_Istdingv		PL_stdingv
+#define PL_Istrchop		PL_strchop
+#define PL_Istrtab		PL_strtab
+#define PL_Isub_generation	PL_sub_generation
+#define PL_Isublex_info		PL_sublex_info
+#define PL_Isv_arenaroot	PL_sv_arenaroot
+#define PL_Isv_count		PL_sv_count
+#define PL_Isv_objcount		PL_sv_objcount
+#define PL_Isv_root		PL_sv_root
+#define PL_Isys_intern		PL_sys_intern
+#define PL_Itainting		PL_tainting
+#define PL_Ithreadnum		PL_threadnum
+#define PL_Ithrsv		PL_thrsv
+#define PL_Iunsafe		PL_unsafe
+#define PL_Iwarnhook		PL_warnhook
+
+#ifndef USE_THREADS
+
+#define PL_TSv			PL_Sv
+#define PL_TXpv			PL_Xpv
+#define PL_Tav_fetch_sv		PL_av_fetch_sv
+#define PL_Tbodytarget		PL_bodytarget
+#define PL_Tbostr		PL_bostr
+#define PL_Tchopset		PL_chopset
+#define PL_Tcolors		PL_colors
+#define PL_Tcolorset		PL_colorset
+#define PL_Tcurcop		PL_curcop
+#define PL_Tcurpad		PL_curpad
+#define PL_Tcurpm		PL_curpm
+#define PL_Tcurstack		PL_curstack
+#define PL_Tcurstackinfo	PL_curstackinfo
+#define PL_Tcurstash		PL_curstash
+#define PL_Tdefoutgv		PL_defoutgv
+#define PL_Tdefstash		PL_defstash
+#define PL_Tdelaymagic		PL_delaymagic
+#define PL_Tdirty		PL_dirty
+#define PL_Textralen		PL_extralen
+#define PL_Tfirstgv		PL_firstgv
+#define PL_Tformtarget		PL_formtarget
+#define PL_Thv_fetch_ent_mh	PL_hv_fetch_ent_mh
+#define PL_Thv_fetch_sv		PL_hv_fetch_sv
+#define PL_Tin_eval		PL_in_eval
+#define PL_Tlast_in_gv		PL_last_in_gv
+#define PL_Tlastgotoprobe	PL_lastgotoprobe
+#define PL_Tlastscream		PL_lastscream
+#define PL_Tlocalizing		PL_localizing
+#define PL_Tmainstack		PL_mainstack
+#define PL_Tmarkstack		PL_markstack
+#define PL_Tmarkstack_max	PL_markstack_max
+#define PL_Tmarkstack_ptr	PL_markstack_ptr
+#define PL_Tmaxscream		PL_maxscream
+#define PL_Tmodcount		PL_modcount
+#define PL_Tnrs			PL_nrs
+#define PL_Tofs			PL_ofs
+#define PL_Tofslen		PL_ofslen
+#define PL_Top			PL_op
+#define PL_Topsave		PL_opsave
+#define PL_Treg_eval_set	PL_reg_eval_set
+#define PL_Treg_flags		PL_reg_flags
+#define PL_Treg_start_tmp	PL_reg_start_tmp
+#define PL_Treg_start_tmpl	PL_reg_start_tmpl
+#define PL_Tregbol		PL_regbol
+#define PL_Tregcc		PL_regcc
+#define PL_Tregcode		PL_regcode
+#define PL_Tregcomp_parse	PL_regcomp_parse
+#define PL_Tregcomp_rx		PL_regcomp_rx
+#define PL_Tregcompp		PL_regcompp
+#define PL_Tregdata		PL_regdata
+#define PL_Tregdummy		PL_regdummy
+#define PL_Tregendp		PL_regendp
+#define PL_Tregeol		PL_regeol
+#define PL_Tregexecp		PL_regexecp
+#define PL_Tregflags		PL_regflags
+#define PL_Tregindent		PL_regindent
+#define PL_Treginput		PL_reginput
+#define PL_Treginterp_cnt	PL_reginterp_cnt
+#define PL_Treglastparen	PL_reglastparen
+#define PL_Tregnarrate		PL_regnarrate
+#define PL_Tregnaughty		PL_regnaughty
+#define PL_Tregnpar		PL_regnpar
+#define PL_Tregprecomp		PL_regprecomp
+#define PL_Tregprev		PL_regprev
+#define PL_Tregprogram		PL_regprogram
+#define PL_Tregsawback		PL_regsawback
+#define PL_Tregseen		PL_regseen
+#define PL_Tregsize		PL_regsize
+#define PL_Tregstartp		PL_regstartp
+#define PL_Tregtill		PL_regtill
+#define PL_Tregxend		PL_regxend
+#define PL_Trestartop		PL_restartop
+#define PL_Tretstack		PL_retstack
+#define PL_Tretstack_ix		PL_retstack_ix
+#define PL_Tretstack_max	PL_retstack_max
+#define PL_Trs			PL_rs
+#define PL_Tsavestack		PL_savestack
+#define PL_Tsavestack_ix	PL_savestack_ix
+#define PL_Tsavestack_max	PL_savestack_max
+#define PL_Tscopestack		PL_scopestack
+#define PL_Tscopestack_ix	PL_scopestack_ix
+#define PL_Tscopestack_max	PL_scopestack_max
+#define PL_Tscreamfirst		PL_screamfirst
+#define PL_Tscreamnext		PL_screamnext
+#define PL_Tsecondgv		PL_secondgv
+#define PL_Tseen_evals		PL_seen_evals
+#define PL_Tseen_zerolen	PL_seen_zerolen
+#define PL_Tsortcop		PL_sortcop
+#define PL_Tsortcxix		PL_sortcxix
+#define PL_Tsortstash		PL_sortstash
+#define PL_Tstack_base		PL_stack_base
+#define PL_Tstack_max		PL_stack_max
+#define PL_Tstack_sp		PL_stack_sp
+#define PL_Tstart_env		PL_start_env
+#define PL_Tstatbuf		PL_statbuf
+#define PL_Tstatcache		PL_statcache
+#define PL_Tstatgv		PL_statgv
+#define PL_Tstatname		PL_statname
+#define PL_Ttainted		PL_tainted
+#define PL_Ttimesbuf		PL_timesbuf
+#define PL_Ttmps_floor		PL_tmps_floor
+#define PL_Ttmps_ix		PL_tmps_ix
+#define PL_Ttmps_max		PL_tmps_max
+#define PL_Ttmps_stack		PL_tmps_stack
+#define PL_Ttop_env		PL_top_env
+#define PL_Ttoptarget		PL_toptarget
+
+#endif /* USE_THREADS */
+
+/* Hide what would have been interpreter-specific symbols? */
+
+#ifdef EMBED
+
+
+#ifndef USE_THREADS
+
+
+#endif /* USE_THREADS */
+#endif /* EMBED */
+#endif /* MULTIPLICITY */
+
+/* Now same trickey for per-thread variables */
+
+#ifdef USE_THREADS
+
+#define PL_Sv			(thr->TSv)
+#define PL_Xpv			(thr->TXpv)
+#define PL_av_fetch_sv		(thr->Tav_fetch_sv)
+#define PL_bodytarget		(thr->Tbodytarget)
+#define PL_bostr		(thr->Tbostr)
+#define PL_chopset		(thr->Tchopset)
+#define PL_colors		(thr->Tcolors)
+#define PL_colorset		(thr->Tcolorset)
+#define PL_curcop		(thr->Tcurcop)
+#define PL_curpad		(thr->Tcurpad)
+#define PL_curpm		(thr->Tcurpm)
+#define PL_curstack		(thr->Tcurstack)
+#define PL_curstackinfo		(thr->Tcurstackinfo)
+#define PL_curstash		(thr->Tcurstash)
+#define PL_defoutgv		(thr->Tdefoutgv)
+#define PL_defstash		(thr->Tdefstash)
+#define PL_delaymagic		(thr->Tdelaymagic)
+#define PL_dirty		(thr->Tdirty)
+#define PL_extralen		(thr->Textralen)
+#define PL_firstgv		(thr->Tfirstgv)
+#define PL_formtarget		(thr->Tformtarget)
+#define PL_hv_fetch_ent_mh	(thr->Thv_fetch_ent_mh)
+#define PL_hv_fetch_sv		(thr->Thv_fetch_sv)
+#define PL_in_eval		(thr->Tin_eval)
+#define PL_last_in_gv		(thr->Tlast_in_gv)
+#define PL_lastgotoprobe	(thr->Tlastgotoprobe)
+#define PL_lastscream		(thr->Tlastscream)
+#define PL_localizing		(thr->Tlocalizing)
+#define PL_mainstack		(thr->Tmainstack)
+#define PL_markstack		(thr->Tmarkstack)
+#define PL_markstack_max	(thr->Tmarkstack_max)
+#define PL_markstack_ptr	(thr->Tmarkstack_ptr)
+#define PL_maxscream		(thr->Tmaxscream)
+#define PL_modcount		(thr->Tmodcount)
+#define PL_nrs			(thr->Tnrs)
+#define PL_ofs			(thr->Tofs)
+#define PL_ofslen		(thr->Tofslen)
+#define PL_op			(thr->Top)
+#define PL_opsave		(thr->Topsave)
+#define PL_reg_eval_set		(thr->Treg_eval_set)
+#define PL_reg_flags		(thr->Treg_flags)
+#define PL_reg_start_tmp	(thr->Treg_start_tmp)
+#define PL_reg_start_tmpl	(thr->Treg_start_tmpl)
+#define PL_regbol		(thr->Tregbol)
+#define PL_regcc		(thr->Tregcc)
+#define PL_regcode		(thr->Tregcode)
+#define PL_regcomp_parse	(thr->Tregcomp_parse)
+#define PL_regcomp_rx		(thr->Tregcomp_rx)
+#define PL_regcompp		(thr->Tregcompp)
+#define PL_regdata		(thr->Tregdata)
+#define PL_regdummy		(thr->Tregdummy)
+#define PL_regendp		(thr->Tregendp)
+#define PL_regeol		(thr->Tregeol)
+#define PL_regexecp		(thr->Tregexecp)
+#define PL_regflags		(thr->Tregflags)
+#define PL_regindent		(thr->Tregindent)
+#define PL_reginput		(thr->Treginput)
+#define PL_reginterp_cnt	(thr->Treginterp_cnt)
+#define PL_reglastparen		(thr->Treglastparen)
+#define PL_regnarrate		(thr->Tregnarrate)
+#define PL_regnaughty		(thr->Tregnaughty)
+#define PL_regnpar		(thr->Tregnpar)
+#define PL_regprecomp		(thr->Tregprecomp)
+#define PL_regprev		(thr->Tregprev)
+#define PL_regprogram		(thr->Tregprogram)
+#define PL_regsawback		(thr->Tregsawback)
+#define PL_regseen		(thr->Tregseen)
+#define PL_regsize		(thr->Tregsize)
+#define PL_regstartp		(thr->Tregstartp)
+#define PL_regtill		(thr->Tregtill)
+#define PL_regxend		(thr->Tregxend)
+#define PL_restartop		(thr->Trestartop)
+#define PL_retstack		(thr->Tretstack)
+#define PL_retstack_ix		(thr->Tretstack_ix)
+#define PL_retstack_max		(thr->Tretstack_max)
+#define PL_rs			(thr->Trs)
+#define PL_savestack		(thr->Tsavestack)
+#define PL_savestack_ix		(thr->Tsavestack_ix)
+#define PL_savestack_max	(thr->Tsavestack_max)
+#define PL_scopestack		(thr->Tscopestack)
+#define PL_scopestack_ix	(thr->Tscopestack_ix)
+#define PL_scopestack_max	(thr->Tscopestack_max)
+#define PL_screamfirst		(thr->Tscreamfirst)
+#define PL_screamnext		(thr->Tscreamnext)
+#define PL_secondgv		(thr->Tsecondgv)
+#define PL_seen_evals		(thr->Tseen_evals)
+#define PL_seen_zerolen		(thr->Tseen_zerolen)
+#define PL_sortcop		(thr->Tsortcop)
+#define PL_sortcxix		(thr->Tsortcxix)
+#define PL_sortstash		(thr->Tsortstash)
+#define PL_stack_base		(thr->Tstack_base)
+#define PL_stack_max		(thr->Tstack_max)
+#define PL_stack_sp		(thr->Tstack_sp)
+#define PL_start_env		(thr->Tstart_env)
+#define PL_statbuf		(thr->Tstatbuf)
+#define PL_statcache		(thr->Tstatcache)
+#define PL_statgv		(thr->Tstatgv)
+#define PL_statname		(thr->Tstatname)
+#define PL_tainted		(thr->Ttainted)
+#define PL_timesbuf		(thr->Ttimesbuf)
+#define PL_tmps_floor		(thr->Ttmps_floor)
+#define PL_tmps_ix		(thr->Ttmps_ix)
+#define PL_tmps_max		(thr->Ttmps_max)
+#define PL_tmps_stack		(thr->Ttmps_stack)
+#define PL_top_env		(thr->Ttop_env)
+#define PL_toptarget		(thr->Ttoptarget)
+
+#endif /* USE_THREADS */
+
+#ifdef PERL_GLOBAL_STRUCT
+
+#define PL_No			(PL_Vars.GNo)
+#define PL_Yes			(PL_Vars.GYes)
+#define PL_amagic_generation	(PL_Vars.Gamagic_generation)
+#define PL_an			(PL_Vars.Gan)
+#define PL_bufend		(PL_Vars.Gbufend)
+#define PL_bufptr		(PL_Vars.Gbufptr)
+#define PL_collation_ix		(PL_Vars.Gcollation_ix)
+#define PL_collation_name	(PL_Vars.Gcollation_name)
+#define PL_collation_standard	(PL_Vars.Gcollation_standard)
+#define PL_collxfrm_base	(PL_Vars.Gcollxfrm_base)
+#define PL_collxfrm_mult	(PL_Vars.Gcollxfrm_mult)
+#define PL_cop_seqmax		(PL_Vars.Gcop_seqmax)
+#define PL_cryptseen		(PL_Vars.Gcryptseen)
+#define PL_cshlen		(PL_Vars.Gcshlen)
+#define PL_cshname		(PL_Vars.Gcshname)
+#define PL_curinterp		(PL_Vars.Gcurinterp)
+#define PL_curthr		(PL_Vars.Gcurthr)
+#define PL_debug		(PL_Vars.Gdebug)
+#define PL_do_undump		(PL_Vars.Gdo_undump)
+#define PL_egid			(PL_Vars.Gegid)
+#define PL_error_count		(PL_Vars.Gerror_count)
+#define PL_euid			(PL_Vars.Geuid)
+#define PL_eval_cond		(PL_Vars.Geval_cond)
+#define PL_eval_mutex		(PL_Vars.Geval_mutex)
+#define PL_eval_owner		(PL_Vars.Geval_owner)
+#define PL_evalseq		(PL_Vars.Gevalseq)
+#define PL_expect		(PL_Vars.Gexpect)
+#define PL_gid			(PL_Vars.Ggid)
+#define PL_he_root		(PL_Vars.Ghe_root)
+#define PL_hexdigit		(PL_Vars.Ghexdigit)
+#define PL_hints		(PL_Vars.Ghints)
+#define PL_in_my		(PL_Vars.Gin_my)
+#define PL_in_my_stash		(PL_Vars.Gin_my_stash)
+#define PL_last_lop		(PL_Vars.Glast_lop)
+#define PL_last_lop_op		(PL_Vars.Glast_lop_op)
+#define PL_last_uni		(PL_Vars.Glast_uni)
+#define PL_lex_brackets		(PL_Vars.Glex_brackets)
+#define PL_lex_brackstack	(PL_Vars.Glex_brackstack)
+#define PL_lex_casemods		(PL_Vars.Glex_casemods)
+#define PL_lex_casestack	(PL_Vars.Glex_casestack)
+#define PL_lex_defer		(PL_Vars.Glex_defer)
+#define PL_lex_dojoin		(PL_Vars.Glex_dojoin)
+#define PL_lex_expect		(PL_Vars.Glex_expect)
+#define PL_lex_fakebrack	(PL_Vars.Glex_fakebrack)
+#define PL_lex_formbrack	(PL_Vars.Glex_formbrack)
+#define PL_lex_inpat		(PL_Vars.Glex_inpat)
+#define PL_lex_inwhat		(PL_Vars.Glex_inwhat)
+#define PL_lex_op		(PL_Vars.Glex_op)
+#define PL_lex_repl		(PL_Vars.Glex_repl)
+#define PL_lex_starts		(PL_Vars.Glex_starts)
+#define PL_lex_state		(PL_Vars.Glex_state)
+#define PL_lex_stuff		(PL_Vars.Glex_stuff)
+#define PL_linestr		(PL_Vars.Glinestr)
+#define PL_malloc_mutex		(PL_Vars.Gmalloc_mutex)
+#define PL_max_intro_pending	(PL_Vars.Gmax_intro_pending)
+#define PL_maxo			(PL_Vars.Gmaxo)
+#define PL_min_intro_pending	(PL_Vars.Gmin_intro_pending)
+#define PL_multi_close		(PL_Vars.Gmulti_close)
+#define PL_multi_end		(PL_Vars.Gmulti_end)
+#define PL_multi_open		(PL_Vars.Gmulti_open)
+#define PL_multi_start		(PL_Vars.Gmulti_start)
+#define PL_na			(PL_Vars.Gna)
+#define PL_nexttoke		(PL_Vars.Gnexttoke)
+#define PL_nexttype		(PL_Vars.Gnexttype)
+#define PL_nextval		(PL_Vars.Gnextval)
+#define PL_nice_chunk		(PL_Vars.Gnice_chunk)
+#define PL_nice_chunk_size	(PL_Vars.Gnice_chunk_size)
+#define PL_ninterps		(PL_Vars.Gninterps)
+#define PL_nomemok		(PL_Vars.Gnomemok)
+#define PL_nthreads		(PL_Vars.Gnthreads)
+#define PL_nthreads_cond	(PL_Vars.Gnthreads_cond)
+#define PL_numeric_local	(PL_Vars.Gnumeric_local)
+#define PL_numeric_name		(PL_Vars.Gnumeric_name)
+#define PL_numeric_standard	(PL_Vars.Gnumeric_standard)
+#define PL_oldbufptr		(PL_Vars.Goldbufptr)
+#define PL_oldoldbufptr		(PL_Vars.Goldoldbufptr)
+#define PL_op_seqmax		(PL_Vars.Gop_seqmax)
+#define PL_origalen		(PL_Vars.Gorigalen)
+#define PL_origenviron		(PL_Vars.Gorigenviron)
+#define PL_osname		(PL_Vars.Gosname)
+#define PL_pad_reset_pending	(PL_Vars.Gpad_reset_pending)
+#define PL_padix		(PL_Vars.Gpadix)
+#define PL_padix_floor		(PL_Vars.Gpadix_floor)
+#define PL_patleave		(PL_Vars.Gpatleave)
+#define PL_pidstatus		(PL_Vars.Gpidstatus)
+#define PL_runops		(PL_Vars.Grunops)
+#define PL_sh_path		(PL_Vars.Gsh_path)
+#define PL_sighandlerp		(PL_Vars.Gsighandlerp)
+#define PL_specialsv_list	(PL_Vars.Gspecialsv_list)
+#define PL_subline		(PL_Vars.Gsubline)
+#define PL_subname		(PL_Vars.Gsubname)
+#define PL_sv_mutex		(PL_Vars.Gsv_mutex)
+#define PL_sv_no		(PL_Vars.Gsv_no)
+#define PL_sv_undef		(PL_Vars.Gsv_undef)
+#define PL_sv_yes		(PL_Vars.Gsv_yes)
+#define PL_svref_mutex		(PL_Vars.Gsvref_mutex)
+#define PL_thisexpr		(PL_Vars.Gthisexpr)
+#define PL_thr_key		(PL_Vars.Gthr_key)
+#define PL_threads_mutex	(PL_Vars.Gthreads_mutex)
+#define PL_threadsv_names	(PL_Vars.Gthreadsv_names)
+#define PL_tokenbuf		(PL_Vars.Gtokenbuf)
+#define PL_uid			(PL_Vars.Guid)
+#define PL_xiv_arenaroot	(PL_Vars.Gxiv_arenaroot)
+#define PL_xiv_root		(PL_Vars.Gxiv_root)
+#define PL_xnv_root		(PL_Vars.Gxnv_root)
+#define PL_xpv_root		(PL_Vars.Gxpv_root)
+#define PL_xrv_root		(PL_Vars.Gxrv_root)
+
+#else /* !PERL_GLOBAL_STRUCT */
+
+#define PL_GNo			PL_No
+#define PL_GYes			PL_Yes
+#define PL_Gamagic_generation	PL_amagic_generation
+#define PL_Gan			PL_an
+#define PL_Gbufend		PL_bufend
+#define PL_Gbufptr		PL_bufptr
+#define PL_Gcollation_ix	PL_collation_ix
+#define PL_Gcollation_name	PL_collation_name
+#define PL_Gcollation_standard	PL_collation_standard
+#define PL_Gcollxfrm_base	PL_collxfrm_base
+#define PL_Gcollxfrm_mult	PL_collxfrm_mult
+#define PL_Gcop_seqmax		PL_cop_seqmax
+#define PL_Gcryptseen		PL_cryptseen
+#define PL_Gcshlen		PL_cshlen
+#define PL_Gcshname		PL_cshname
+#define PL_Gcurinterp		PL_curinterp
+#define PL_Gcurthr		PL_curthr
+#define PL_Gdebug		PL_debug
+#define PL_Gdo_undump		PL_do_undump
+#define PL_Gegid		PL_egid
+#define PL_Gerror_count		PL_error_count
+#define PL_Geuid		PL_euid
+#define PL_Geval_cond		PL_eval_cond
+#define PL_Geval_mutex		PL_eval_mutex
+#define PL_Geval_owner		PL_eval_owner
+#define PL_Gevalseq		PL_evalseq
+#define PL_Gexpect		PL_expect
+#define PL_Ggid			PL_gid
+#define PL_Ghe_root		PL_he_root
+#define PL_Ghexdigit		PL_hexdigit
+#define PL_Ghints		PL_hints
+#define PL_Gin_my		PL_in_my
+#define PL_Gin_my_stash		PL_in_my_stash
+#define PL_Glast_lop		PL_last_lop
+#define PL_Glast_lop_op		PL_last_lop_op
+#define PL_Glast_uni		PL_last_uni
+#define PL_Glex_brackets	PL_lex_brackets
+#define PL_Glex_brackstack	PL_lex_brackstack
+#define PL_Glex_casemods	PL_lex_casemods
+#define PL_Glex_casestack	PL_lex_casestack
+#define PL_Glex_defer		PL_lex_defer
+#define PL_Glex_dojoin		PL_lex_dojoin
+#define PL_Glex_expect		PL_lex_expect
+#define PL_Glex_fakebrack	PL_lex_fakebrack
+#define PL_Glex_formbrack	PL_lex_formbrack
+#define PL_Glex_inpat		PL_lex_inpat
+#define PL_Glex_inwhat		PL_lex_inwhat
+#define PL_Glex_op		PL_lex_op
+#define PL_Glex_repl		PL_lex_repl
+#define PL_Glex_starts		PL_lex_starts
+#define PL_Glex_state		PL_lex_state
+#define PL_Glex_stuff		PL_lex_stuff
+#define PL_Glinestr		PL_linestr
+#define PL_Gmalloc_mutex	PL_malloc_mutex
+#define PL_Gmax_intro_pending	PL_max_intro_pending
+#define PL_Gmaxo		PL_maxo
+#define PL_Gmin_intro_pending	PL_min_intro_pending
+#define PL_Gmulti_close		PL_multi_close
+#define PL_Gmulti_end		PL_multi_end
+#define PL_Gmulti_open		PL_multi_open
+#define PL_Gmulti_start		PL_multi_start
+#define PL_Gna			PL_na
+#define PL_Gnexttoke		PL_nexttoke
+#define PL_Gnexttype		PL_nexttype
+#define PL_Gnextval		PL_nextval
+#define PL_Gnice_chunk		PL_nice_chunk
+#define PL_Gnice_chunk_size	PL_nice_chunk_size
+#define PL_Gninterps		PL_ninterps
+#define PL_Gnomemok		PL_nomemok
+#define PL_Gnthreads		PL_nthreads
+#define PL_Gnthreads_cond	PL_nthreads_cond
+#define PL_Gnumeric_local	PL_numeric_local
+#define PL_Gnumeric_name	PL_numeric_name
+#define PL_Gnumeric_standard	PL_numeric_standard
+#define PL_Goldbufptr		PL_oldbufptr
+#define PL_Goldoldbufptr	PL_oldoldbufptr
+#define PL_Gop_seqmax		PL_op_seqmax
+#define PL_Gorigalen		PL_origalen
+#define PL_Gorigenviron		PL_origenviron
+#define PL_Gosname		PL_osname
+#define PL_Gpad_reset_pending	PL_pad_reset_pending
+#define PL_Gpadix		PL_padix
+#define PL_Gpadix_floor		PL_padix_floor
+#define PL_Gpatleave		PL_patleave
+#define PL_Gpidstatus		PL_pidstatus
+#define PL_Grunops		PL_runops
+#define PL_Gsh_path		PL_sh_path
+#define PL_Gsighandlerp		PL_sighandlerp
+#define PL_Gspecialsv_list	PL_specialsv_list
+#define PL_Gsubline		PL_subline
+#define PL_Gsubname		PL_subname
+#define PL_Gsv_mutex		PL_sv_mutex
+#define PL_Gsv_no		PL_sv_no
+#define PL_Gsv_undef		PL_sv_undef
+#define PL_Gsv_yes		PL_sv_yes
+#define PL_Gsvref_mutex		PL_svref_mutex
+#define PL_Gthisexpr		PL_thisexpr
+#define PL_Gthr_key		PL_thr_key
+#define PL_Gthreads_mutex	PL_threads_mutex
+#define PL_Gthreadsv_names	PL_threadsv_names
+#define PL_Gtokenbuf		PL_tokenbuf
+#define PL_Guid			PL_uid
+#define PL_Gxiv_arenaroot	PL_xiv_arenaroot
+#define PL_Gxiv_root		PL_xiv_root
+#define PL_Gxnv_root		PL_xnv_root
+#define PL_Gxpv_root		PL_xpv_root
+#define PL_Gxrv_root		PL_xrv_root
+
+#ifdef EMBED
+
+
+#endif /* EMBED */
+#endif /* PERL_GLOBAL_STRUCT */
+
+
+#ifndef MIN_PERL_DEFINE  
+
+#define DBsingle		PL_DBsingle
+#define DBsub			PL_DBsub
+#define compiling		PL_compiling
+#define curcop			PL_curcop
+#define curstash		PL_curstash
+#define debstash		PL_debstash
+#define defgv			PL_defgv
+#define diehook			PL_diehook
+#define dirty			PL_dirty
+#define dowarn			PL_dowarn
+#define errgv			PL_errgv
+#define na			PL_na
+#define perl_destruct_level	PL_perl_destruct_level
+#define perldb			PL_perldb
+#define rsfp			PL_rsfp
+#define rsfp_filters		PL_rsfp_filters
+#define stack_base		PL_stack_base
+#define stack_sp		PL_stack_sp
+#define stdingv			PL_stdingv
+#define sv_arenaroot		PL_sv_arenaroot
+#define sv_no			PL_sv_no
+#define sv_undef		PL_sv_undef
+#define sv_yes			PL_sv_yes
+#define tainted			PL_tainted
+#define tainting		PL_tainting
+
+#endif /* MIN_PERL_DEFINE */

contrib/perl5/ext/B/B.pm

@@ -0,0 +1,825 @@
+#      B.pm
+#
+#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B;
+require DynaLoader;
+require Exporter;
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
+		class peekop cast_I32 cstring cchar hash threadsv_names
+		main_root main_start main_cv svref_2object
+		walkoptree walkoptree_slow walkoptree_exec walksymtable
+		parents comppadlist sv_undef compile_stats timing_info);
+
+use strict;
+@B::SV::ISA = 'B::OBJECT';
+@B::NULL::ISA = 'B::SV';
+@B::PV::ISA = 'B::SV';
+@B::IV::ISA = 'B::SV';
+@B::NV::ISA = 'B::IV';
+@B::RV::ISA = 'B::SV';
+@B::PVIV::ISA = qw(B::PV B::IV);
+@B::PVNV::ISA = qw(B::PV B::NV);
+@B::PVMG::ISA = 'B::PVNV';
+@B::PVLV::ISA = 'B::PVMG';
+@B::BM::ISA = 'B::PVMG';
+@B::AV::ISA = 'B::PVMG';
+@B::GV::ISA = 'B::PVMG';
+@B::HV::ISA = 'B::PVMG';
+@B::CV::ISA = 'B::PVMG';
+@B::IO::ISA = 'B::PVMG';
+@B::FM::ISA = 'B::CV';
+
+@B::OP::ISA = 'B::OBJECT';
+@B::UNOP::ISA = 'B::OP';
+@B::BINOP::ISA = 'B::UNOP';
+@B::LOGOP::ISA = 'B::UNOP';
+@B::CONDOP::ISA = 'B::UNOP';
+@B::LISTOP::ISA = 'B::BINOP';
+@B::SVOP::ISA = 'B::OP';
+@B::GVOP::ISA = 'B::OP';
+@B::PVOP::ISA = 'B::OP';
+@B::CVOP::ISA = 'B::OP';
+@B::LOOP::ISA = 'B::LISTOP';
+@B::PMOP::ISA = 'B::LISTOP';
+@B::COP::ISA = 'B::OP';
+
+@B::SPECIAL::ISA = 'B::OBJECT';
+
+{
+    # Stop "-w" from complaining about the lack of a real B::OBJECT class
+    package B::OBJECT;
+}
+
+my $debug;
+my $op_count = 0;
+my @parents = ();
+
+sub debug {
+    my ($class, $value) = @_;
+    $debug = $value;
+    walkoptree_debug($value);
+}
+
+# sub OPf_KIDS;
+# add to .xs for perl5.002
+sub OPf_KIDS () { 4 }
+
+sub class {
+    my $obj = shift;
+    my $name = ref $obj;
+    $name =~ s/^.*:://;
+    return $name;
+}
+
+sub parents { \@parents }
+
+# For debugging
+sub peekop {
+    my $op = shift;
+    return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
+}
+
+sub walkoptree_slow {
+    my($op, $method, $level) = @_;
+    $op_count++; # just for statistics
+    $level ||= 0;
+    warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
+    $op->$method($level);
+    if ($$op && ($op->flags & OPf_KIDS)) {
+	my $kid;
+	unshift(@parents, $op);
+	for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
+	    walkoptree_slow($kid, $method, $level + 1);
+	}
+	shift @parents;
+    }
+}
+
+sub compile_stats {
+    return "Total number of OPs processed: $op_count\n";
+}
+
+sub timing_info {
+    my ($sec, $min, $hr) = localtime;
+    my ($user, $sys) = times;
+    sprintf("%02d:%02d:%02d user=$user sys=$sys",
+	    $hr, $min, $sec, $user, $sys);
+}
+
+my %symtable;
+sub savesym {
+    my ($obj, $value) = @_;
+#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+    $symtable{sprintf("sym_%x", $$obj)} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("sym_%x", $$obj)};
+}
+
+sub walkoptree_exec {
+    my ($op, $method, $level) = @_;
+    my ($sym, $ppname);
+    my $prefix = "    " x $level;
+    for (; $$op; $op = $op->next) {
+	$sym = objsym($op);
+	if (defined($sym)) {
+	    print $prefix, "goto $sym\n";
+	    return;
+	}
+	savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
+	$op->$method($level);
+	$ppname = $op->ppaddr;
+	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
+	    print $prefix, uc($1), " => {\n";
+	    walkoptree_exec($op->other, $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+	    my $pmreplstart = $op->pmreplstart;
+	    if ($$pmreplstart) {
+		print $prefix, "PMREPLSTART => {\n";
+		walkoptree_exec($pmreplstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	} elsif ($ppname eq "pp_substcont") {
+	    print $prefix, "SUBSTCONT => {\n";
+	    walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
+	    print $prefix, "}\n";
+	    $op = $op->other;
+	} elsif ($ppname eq "pp_cond_expr") {
+	    # pp_cond_expr never returns op_next
+	    print $prefix, "TRUE => {\n";
+	    walkoptree_exec($op->true, $method, $level + 1);
+	    print $prefix, "}\n";
+	    $op = $op->false;
+	    redo;
+	} elsif ($ppname eq "pp_range") {
+	    print $prefix, "TRUE => {\n";
+	    walkoptree_exec($op->true, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "FALSE => {\n";
+	    walkoptree_exec($op->false, $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_enterloop") {
+	    print $prefix, "REDO => {\n";
+	    walkoptree_exec($op->redoop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "NEXT => {\n";
+	    walkoptree_exec($op->nextop, $method, $level + 1);
+	    print $prefix, "}\n", $prefix, "LAST => {\n";
+	    walkoptree_exec($op->lastop,  $method, $level + 1);
+	    print $prefix, "}\n";
+	} elsif ($ppname eq "pp_subst") {
+	    my $replstart = $op->pmreplstart;
+	    if ($$replstart) {
+		print $prefix, "SUBST => {\n";
+		walkoptree_exec($replstart, $method, $level + 1);
+		print $prefix, "}\n";
+	    }
+	}
+    }
+}
+
+sub walksymtable {
+    my ($symref, $method, $recurse, $prefix) = @_;
+    my $sym;
+    no strict 'vars';
+    local(*glob);
+    while (($sym, *glob) = each %$symref) {
+	if ($sym =~ /::$/) {
+	    $sym = $prefix . $sym;
+	    if ($sym ne "main::" && &$recurse($sym)) {
+		walksymtable(\%glob, $method, $recurse, $sym);
+	    }
+	} else {
+	    svref_2object(\*glob)->EGV->$method();
+	}
+    }
+}
+
+{
+    package B::Section;
+    my $output_fh;
+    my %sections;
+    
+    sub new {
+	my ($class, $section, $symtable, $default) = @_;
+	$output_fh ||= FileHandle->new_tmpfile;
+	my $obj = bless [-1, $section, $symtable, $default], $class;
+	$sections{$section} = $obj;
+	return $obj;
+    }
+    
+    sub get {
+	my ($class, $section) = @_;
+	return $sections{$section};
+    }
+
+    sub add {
+	my $section = shift;
+	while (defined($_ = shift)) {
+	    print $output_fh "$section->[1]\t$_\n";
+	    $section->[0]++;
+	}
+    }
+
+    sub index {
+	my $section = shift;
+	return $section->[0];
+    }
+
+    sub name {
+	my $section = shift;
+	return $section->[1];
+    }
+
+    sub symtable {
+	my $section = shift;
+	return $section->[2];
+    }
+	
+    sub default {
+	my $section = shift;
+	return $section->[3];
+    }
+	
+    sub output {
+	my ($section, $fh, $format) = @_;
+	my $name = $section->name;
+	my $sym = $section->symtable || {};
+	my $default = $section->default;
+
+	seek($output_fh, 0, 0);
+	while (<$output_fh>) {
+	    chomp;
+	    s/^(.*?)\t//;
+	    if ($1 eq $name) {
+		s{(s\\_[0-9a-f]+)} {
+		    exists($sym->{$1}) ? $sym->{$1} : $default;
+		}ge;
+		printf $fh $format, $_;
+	    }
+	}
+    }
+}
+
+bootstrap B;
+
+1;
+
+__END__
+
+=head1 NAME
+
+B - The Perl Compiler
+
+=head1 SYNOPSIS
+
+	use B;
+
+=head1 DESCRIPTION
+
+The C<B> module supplies classes which allow a Perl program to delve
+into its own innards. It is the module used to implement the
+"backends" of the Perl compiler. Usage of the compiler does not
+require knowledge of this module: see the F<O> module for the
+user-visible part. The C<B> module is of use to those who want to
+write new compiler backends. This documentation assumes that the
+reader knows a fair amount about perl's internals including such
+things as SVs, OPs and the internal symbol table and syntax tree
+of a program.
+
+=head1 OVERVIEW OF CLASSES
+
+The C structures used by Perl's internals to hold SV and OP
+information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
+class hierarchy and the C<B> module gives access to them via a true
+object hierarchy. Structure fields which point to other objects
+(whether types of SV or types of OP) are represented by the C<B>
+module as Perl objects of the appropriate class. The bulk of the C<B>
+module is the methods for accessing fields of these structures. Note
+that all access is read-only: you cannot modify the internals by
+using this module.
+
+=head2 SV-RELATED CLASSES
+
+B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
+B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C macros for field access,
+usually with the leading "class indication" prefix removed (Sv, Av,
+Hv, ...). The leading prefix is only left in cases where its removal
+would cause a clash in method name. For example, C<GvREFCNT> stays
+as-is since its abbreviation would clash with the "superclass" method
+C<REFCNT> (corresponding to the C function C<SvREFCNT>).
+
+=head2 B::SV METHODS
+
+=over 4
+
+=item REFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IV METHODS
+
+=over 4
+
+=item IV
+
+=item IVX
+
+=item needs64bits
+
+=item packiv
+
+=back
+
+=head2 B::NV METHODS
+
+=over 4
+
+=item NV
+
+=item NVX
+
+=back
+
+=head2 B::RV METHODS
+
+=over 4
+
+=item RV
+
+=back
+
+=head2 B::PV METHODS
+
+=over 4
+
+=item PV
+
+=back
+
+=head2 B::PVMG METHODS
+
+=over 4
+
+=item MAGIC
+
+=item SvSTASH
+
+=back
+
+=head2 B::MAGIC METHODS
+
+=over 4
+
+=item MOREMAGIC
+
+=item PRIVATE
+
+=item TYPE
+
+=item FLAGS
+
+=item OBJ
+
+=item PTR
+
+=back
+
+=head2 B::PVLV METHODS
+
+=over 4
+
+=item TARGOFF
+
+=item TARGLEN
+
+=item TYPE
+
+=item TARG
+
+=back
+
+=head2 B::BM METHODS
+
+=over 4
+
+=item USEFUL
+
+=item PREVIOUS
+
+=item RARE
+
+=item TABLE
+
+=back
+
+=head2 B::GV METHODS
+
+=over 4
+
+=item NAME
+
+=item STASH
+
+=item SV
+
+=item IO
+
+=item FORM
+
+=item AV
+
+=item HV
+
+=item EGV
+
+=item CV
+
+=item CVGEN
+
+=item LINE
+
+=item FILEGV
+
+=item GvREFCNT
+
+=item FLAGS
+
+=back
+
+=head2 B::IO METHODS
+
+=over 4
+
+=item LINES
+
+=item PAGE
+
+=item PAGE_LEN
+
+=item LINES_LEFT
+
+=item TOP_NAME
+
+=item TOP_GV
+
+=item FMT_NAME
+
+=item FMT_GV
+
+=item BOTTOM_NAME
+
+=item BOTTOM_GV
+
+=item SUBPROCESS
+
+=item IoTYPE
+
+=item IoFLAGS
+
+=back
+
+=head2 B::AV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item OFF
+
+=item ARRAY
+
+=item AvFLAGS
+
+=back
+
+=head2 B::CV METHODS
+
+=over 4
+
+=item STASH
+
+=item START
+
+=item ROOT
+
+=item GV
+
+=item FILEGV
+
+=item DEPTH
+
+=item PADLIST
+
+=item OUTSIDE
+
+=item XSUB
+
+=item XSUBANY
+
+=back
+
+=head2 B::HV METHODS
+
+=over 4
+
+=item FILL
+
+=item MAX
+
+=item KEYS
+
+=item RITER
+
+=item NAME
+
+=item PMROOT
+
+=item ARRAY
+
+=back
+
+=head2 OP-RELATED CLASSES
+
+B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP,
+B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
+These classes correspond in
+the obvious way to the underlying C structures of similar names. The
+inheritance hierarchy mimics the underlying C "inheritance". Access
+methods correspond to the underlying C structre field names, with the
+leading "class indication" prefix removed (op_).
+
+=head2 B::OP METHODS
+
+=over 4
+
+=item next
+
+=item sibling
+
+=item ppaddr
+
+This returns the function name as a string (e.g. pp_add, pp_rv2av).
+
+=item desc
+
+This returns the op description from the global C op_desc array
+(e.g. "addition" "array deref").
+
+=item targ
+
+=item type
+
+=item seq
+
+=item flags
+
+=item private
+
+=back
+
+=head2 B::UNOP METHOD
+
+=over 4
+
+=item first
+
+=back
+
+=head2 B::BINOP METHOD
+
+=over 4
+
+=item last
+
+=back
+
+=head2 B::LOGOP METHOD
+
+=over 4
+
+=item other
+
+=back
+
+=head2 B::CONDOP METHODS
+
+=over 4
+
+=item true
+
+=item false
+
+=back
+
+=head2 B::LISTOP METHOD
+
+=over 4
+
+=item children
+
+=back
+
+=head2 B::PMOP METHODS
+
+=over 4
+
+=item pmreplroot
+
+=item pmreplstart
+
+=item pmnext
+
+=item pmregexp
+
+=item pmflags
+
+=item pmpermflags
+
+=item precomp
+
+=back
+
+=head2 B::SVOP METHOD
+
+=over 4
+
+=item sv
+
+=back
+
+=head2 B::GVOP METHOD
+
+=over 4
+
+=item gv
+
+=back
+
+=head2 B::PVOP METHOD
+
+=over 4
+
+=item pv
+
+=back
+
+=head2 B::LOOP METHODS
+
+=over 4
+
+=item redoop
+
+=item nextop
+
+=item lastop
+
+=back
+
+=head2 B::COP METHODS
+
+=over 4
+
+=item label
+
+=item stash
+
+=item filegv
+
+=item cop_seq
+
+=item arybase
+
+=item line
+
+=back
+
+=head1 FUNCTIONS EXPORTED BY C<B>
+
+The C<B> module exports a variety of functions: some are simple
+utility functions, others provide a Perl program with a way to
+get an initial "handle" on an internal object.
+
+=over 4
+
+=item main_cv
+
+Return the (faked) CV corresponding to the main part of the Perl
+program.
+
+=item main_root
+
+Returns the root op (i.e. an object in the appropriate B::OP-derived
+class) of the main part of the Perl program.
+
+=item main_start
+
+Returns the starting op of the main part of the Perl program.
+
+=item comppadlist
+
+Returns the AV object (i.e. in class B::AV) of the global comppadlist.
+
+=item sv_undef
+
+Returns the SV object corresponding to the C variable C<sv_undef>.
+
+=item sv_yes
+
+Returns the SV object corresponding to the C variable C<sv_yes>.
+
+=item sv_no
+
+Returns the SV object corresponding to the C variable C<sv_no>.
+
+=item walkoptree(OP, METHOD)
+
+Does a tree-walk of the syntax tree based at OP and calls METHOD on
+each op it visits. Each node is visited before its children. If
+C<walkoptree_debug> (q.v.) has been called to turn debugging on then
+the method C<walkoptree_debug> is called on each op before METHOD is
+called.
+
+=item walkoptree_debug(DEBUG)
+
+Returns the current debugging flag for C<walkoptree>. If the optional
+DEBUG argument is non-zero, it sets the debugging flag to that. See
+the description of C<walkoptree> above for what the debugging flag
+does.
+
+=item walksymtable(SYMREF, METHOD, RECURSE)
+
+Walk the symbol table starting at SYMREF and call METHOD on each
+symbol visited. When the walk reached package symbols "Foo::" it
+invokes RECURSE and only recurses into the package if that sub
+returns true.
+
+=item svref_2object(SV)
+
+Takes any Perl variable and turns it into an object in the
+appropriate B::OP-derived or B::SV-derived class. Apart from functions
+such as C<main_root>, this is the primary way to get an initial
+"handle" on a internal perl data structure which can then be followed
+with the other access methods.
+
+=item ppname(OPNUM)
+
+Return the PP function name (e.g. "pp_add") of op number OPNUM.
+
+=item hash(STR)
+
+Returns a string in the form "0x..." representing the value of the
+internal hash function used by perl on string STR.
+
+=item cast_I32(I)
+
+Casts I to the internal I32 type used by that perl.
+
+
+=item minus_c
+
+Does the equivalent of the C<-c> command-line option. Obviously, this
+is only useful in a BEGIN block or else the flag is set too late.
+
+
+=item cstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in C source code.
+
+=item class(OBJ)
+
+Returns the class of an object without the part of the classname
+preceding the first "::". This is used to turn "B::UNOP" into
+"UNOP" for example.
+
+=item threadsv_names
+
+In a perl compiled for threads, this returns a list of the special
+per-thread threadsv variables.
+
+=item byteload_fh(FILEHANDLE)
+
+Load the contents of FILEHANDLE as bytecode. See documentation for
+the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
+
+=back
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Asmdata.pm

@@ -0,0 +1,170 @@
+#
+#      Copyright (c) 1996-1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+#
+#
+# This file is autogenerated from bytecode.pl. Changes made here will be lost.
+#
+package B::Asmdata;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
+use vars qw(%insn_data @insn_name @optype @specialsv_name);
+
+@optype = qw(OP UNOP BINOP LOGOP CONDOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
+@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
+
+# XXX insn_data is initialised this way because with a large
+# %insn_data = (foo => [...], bar => [...], ...) initialiser
+# I get a hard-to-track-down stack underflow and segfault.
+$insn_data{comment} = [35, \&PUT_comment_t, "GET_comment_t"];
+$insn_data{nop} = [10, \&PUT_none, "GET_none"];
+$insn_data{ret} = [0, \&PUT_none, "GET_none"];
+$insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
+$insn_data{ldop} = [2, \&PUT_opindex, "GET_opindex"];
+$insn_data{stsv} = [3, \&PUT_U32, "GET_U32"];
+$insn_data{stop} = [4, \&PUT_U32, "GET_U32"];
+$insn_data{ldspecsv} = [5, \&PUT_U8, "GET_U8"];
+$insn_data{newsv} = [6, \&PUT_U8, "GET_U8"];
+$insn_data{newop} = [7, \&PUT_U8, "GET_U8"];
+$insn_data{newopn} = [8, \&PUT_U8, "GET_U8"];
+$insn_data{newpv} = [9, \&PUT_PV, "GET_PV"];
+$insn_data{pv_cur} = [11, \&PUT_U32, "GET_U32"];
+$insn_data{pv_free} = [12, \&PUT_none, "GET_none"];
+$insn_data{sv_upgrade} = [13, \&PUT_U8, "GET_U8"];
+$insn_data{sv_refcnt} = [14, \&PUT_U32, "GET_U32"];
+$insn_data{sv_refcnt_add} = [15, \&PUT_I32, "GET_I32"];
+$insn_data{sv_flags} = [16, \&PUT_U32, "GET_U32"];
+$insn_data{xrv} = [17, \&PUT_svindex, "GET_svindex"];
+$insn_data{xpv} = [18, \&PUT_none, "GET_none"];
+$insn_data{xiv32} = [19, \&PUT_I32, "GET_I32"];
+$insn_data{xiv64} = [20, \&PUT_IV64, "GET_IV64"];
+$insn_data{xnv} = [21, \&PUT_double, "GET_double"];
+$insn_data{xlv_targoff} = [22, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targlen} = [23, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targ} = [24, \&PUT_svindex, "GET_svindex"];
+$insn_data{xlv_type} = [25, \&PUT_U8, "GET_U8"];
+$insn_data{xbm_useful} = [26, \&PUT_I32, "GET_I32"];
+$insn_data{xbm_previous} = [27, \&PUT_U16, "GET_U16"];
+$insn_data{xbm_rare} = [28, \&PUT_U8, "GET_U8"];
+$insn_data{xfm_lines} = [29, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines} = [30, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page} = [31, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page_len} = [32, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines_left} = [33, \&PUT_I32, "GET_I32"];
+$insn_data{xio_top_name} = [34, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_top_gv} = [36, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_fmt_name} = [37, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_fmt_gv} = [38, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_bottom_name} = [39, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_bottom_gv} = [40, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_subprocess} = [41, \&PUT_U16, "GET_U16"];
+$insn_data{xio_type} = [42, \&PUT_U8, "GET_U8"];
+$insn_data{xio_flags} = [43, \&PUT_U8, "GET_U8"];
+$insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_filegv} = [48, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"];
+$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"];
+$insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"];
+$insn_data{xav_max} = [56, \&PUT_I32, "GET_I32"];
+$insn_data{xav_flags} = [57, \&PUT_U8, "GET_U8"];
+$insn_data{xhv_riter} = [58, \&PUT_I32, "GET_I32"];
+$insn_data{xhv_name} = [59, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{hv_store} = [60, \&PUT_svindex, "GET_svindex"];
+$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [62, \&PUT_svindex, "GET_svindex"];
+$insn_data{mg_private} = [63, \&PUT_U16, "GET_U16"];
+$insn_data{mg_flags} = [64, \&PUT_U8, "GET_U8"];
+$insn_data{mg_pv} = [65, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xmg_stash} = [66, \&PUT_svindex, "GET_svindex"];
+$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [69, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_refcnt} = [70, \&PUT_U32, "GET_U32"];
+$insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"];
+$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_filegv} = [75, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [80, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [82, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_sibling} = [83, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_ppaddr} = [84, \&PUT_strconst, "GET_strconst"];
+$insn_data{op_targ} = [85, \&PUT_U32, "GET_U32"];
+$insn_data{op_type} = [86, \&PUT_U16, "GET_U16"];
+$insn_data{op_seq} = [87, \&PUT_U16, "GET_U16"];
+$insn_data{op_flags} = [88, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [89, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [90, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [91, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [92, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_true} = [93, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_false} = [94, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_children} = [95, \&PUT_U32, "GET_U32"];
+$insn_data{op_pmreplroot} = [96, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [97, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [98, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [99, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [100, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [101, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [102, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [103, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_gv} = [104, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pv} = [105, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [106, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [108, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [109, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [110, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_stash} = [111, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_filegv} = [112, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_seq} = [113, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [114, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [115, \&PUT_U16, "GET_U16"];
+$insn_data{main_start} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [117, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [118, \&PUT_svindex, "GET_svindex"];
+
+my ($insn_name, $insn_data);
+while (($insn_name, $insn_data) = each %insn_data) {
+    $insn_name[$insn_data->[0]] = $insn_name;
+}
+# Fill in any gaps
+@insn_name = map($_ || "unused", @insn_name);
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
+
+=head1 SYNOPSIS
+
+	use Asmdata;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Asmdata.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Assembler.pm

@@ -0,0 +1,227 @@
+#      Assembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+package B::Assembler;
+use Exporter;
+use B qw(ppname);
+use B::Asmdata qw(%insn_data @insn_name);
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(assemble_fh assemble_insn strip_comments
+		parse_statement uncstring);
+
+use strict;
+my %opnumber;
+my ($i, $opname);
+for ($i = 0; defined($opname = ppname($i)); $i++) {
+    $opnumber{$opname} = $i;
+}
+
+my ($linenum, $errors);
+
+sub error {
+    my $str = shift;
+    warn "$linenum: $str\n";
+    $errors++;
+}
+
+my $debug = 0;
+sub debug { $debug = shift }
+
+#
+# First define all the data conversion subs to which Asmdata will refer
+#
+
+sub B::Asmdata::PUT_U8 {
+    my $arg = shift;
+    my $c = uncstring($arg);
+    if (defined($c)) {
+	if (length($c) != 1) {
+	    error "argument for U8 is too long: $c";
+	    $c = substr($c, 0, 1);
+	}
+    } else {
+	$c = chr($arg);
+    }
+    return $c;
+}
+
+sub B::Asmdata::PUT_U16 { pack("n", $_[0]) }
+sub B::Asmdata::PUT_U32 { pack("N", $_[0]) }
+sub B::Asmdata::PUT_I32 { pack("N", $_[0]) }
+sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here
+
+sub B::Asmdata::PUT_strconst {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    if (!defined($arg)) {
+	error "bad string constant: $arg";
+	return "";
+    }
+    if ($arg =~ s/\0//g) {
+	error "string constant argument contains NUL: $arg";
+    }
+    return $arg . "\0";
+}
+
+sub B::Asmdata::PUT_pvcontents {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_PV {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    return pack("N", length($arg)) . $arg;
+}
+sub B::Asmdata::PUT_comment {
+    my $arg = shift;
+    $arg = uncstring($arg);
+    error "bad string argument: $arg" unless defined($arg);
+    if ($arg =~ s/\n//g) {
+	error "comment argument contains linefeed: $arg";
+    }
+    return $arg . "\n";
+}
+sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) }
+sub B::Asmdata::PUT_none {
+    my $arg = shift;
+    error "extraneous argument: $arg" if defined $arg;
+    return "";
+}
+sub B::Asmdata::PUT_op_tr_array {
+    my $arg = shift;
+    my @ary = split(/\s*,\s*/, $arg);
+    if (@ary != 256) {
+	error "wrong number of arguments to op_tr_array";
+	@ary = (0) x 256;
+    }
+    return pack("n256", @ary);
+}
+# XXX Check this works
+sub B::Asmdata::PUT_IV64 {
+    my $arg = shift;
+    return pack("NN", $arg >> 32, $arg & 0xffffffff);
+}
+
+my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
+	     b => "\b", f => "\f", v => "\013");
+
+sub uncstring {
+    my $s = shift;
+    $s =~ s/^"// and $s =~ s/"$// or return undef;
+    $s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
+    return $s;
+}
+
+sub strip_comments {
+    my $stmt = shift;
+    # Comments only allowed in instructions which don't take string arguments
+    $stmt =~ s{
+	(?sx)	# Snazzy extended regexp coming up. Also, treat
+		# string as a single line so .* eats \n characters.
+	^\s*	# Ignore leading whitespace
+	(
+	  [^"]*	# A double quote '"' indicates a string argument. If we
+		# find a double quote, the match fails and we strip nothing.
+	)
+	\s*\#	# Any amount of whitespace plus the comment marker...
+	.*$	# ...which carries on to end-of-string.
+    }{$1};	# Keep only the instruction and optional argument.
+    return $stmt;
+}
+
+sub parse_statement {
+    my $stmt = shift;
+    my ($insn, $arg) = $stmt =~ m{
+	(?sx)
+	^\s*	# allow (but ignore) leading whitespace
+	(.*?)	# Instruction continues up until...
+	(?:	# ...an optional whitespace+argument group
+	    \s+		# first whitespace.
+	    (.*)	# The argument is all the rest (newlines included).
+	)?$	# anchor at end-of-line
+    };	
+    if (defined($arg)) {
+	if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
+	    $arg = hex($arg);
+	} elsif ($arg =~ s/^0(?=[0-7]+$)//) {
+	    $arg = oct($arg);
+	} elsif ($arg =~ /^pp_/) {
+	    $arg =~ s/\s*$//; # strip trailing whitespace
+	    my $opnum = $opnumber{$arg};
+	    if (defined($opnum)) {
+		$arg = $opnum;
+	    } else {
+		error qq(No such op type "$arg");
+		$arg = 0;
+	    }
+	}
+    }
+    return ($insn, $arg);
+}
+
+sub assemble_insn {
+    my ($insn, $arg) = @_;
+    my $data = $insn_data{$insn};
+    if (defined($data)) {
+	my ($bytecode, $putsub) = @{$data}[0, 1];
+	my $argcode = &$putsub($arg);
+	return chr($bytecode).$argcode;
+    } else {
+	error qq(no such instruction "$insn");
+	return "";
+    }
+}
+
+sub assemble_fh {
+    my ($fh, $out) = @_;
+    my ($line, $insn, $arg);
+    $linenum = 0;
+    $errors = 0;
+    while ($line = <$fh>) {
+	$linenum++;
+	chomp $line;
+	if ($debug) {
+	    my $quotedline = $line;
+	    $quotedline =~ s/\\/\\\\/g;
+	    $quotedline =~ s/"/\\"/g;
+	    &$out(assemble_insn("comment", qq("$quotedline")));
+	}
+	$line = strip_comments($line) or next;
+	($insn, $arg) = parse_statement($line);
+	&$out(assemble_insn($insn, $arg));
+	if ($debug) {
+	    &$out(assemble_insn("nop", undef));
+	}
+    }
+    if ($errors) {
+	die "Assembly failed with $errors error(s)\n";
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Assembler - Assemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use Assembler;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Assembler.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Bblock.pm

@@ -0,0 +1,162 @@
+package B::Bblock;
+use Exporter ();
+@ISA = "Exporter";
+@EXPORT_OK = qw(find_leaders);
+
+use B qw(peekop walkoptree walkoptree_exec
+	 main_root main_start svref_2object);
+use B::Terse;
+use strict;
+
+my $bblock;
+my @bblock_ends;
+
+sub mark_leader {
+    my $op = shift;
+    if ($$op) {
+	$bblock->{$$op} = $op;
+    }
+}
+
+sub find_leaders {
+    my ($root, $start) = @_;
+    $bblock = {};
+    mark_leader($start);
+    walkoptree($root, "mark_if_leader");
+    return $bblock;
+}
+
+# Debugging
+sub walk_bblocks {
+    my ($root, $start) = @_;
+    my ($op, $lastop, $leader, $bb);
+    $bblock = {};
+    mark_leader($start);
+    walkoptree($root, "mark_if_leader");
+    my @leaders = values %$bblock;
+    while ($leader = shift @leaders) {
+	$lastop = $leader;
+	$op = $leader->next;
+	while ($$op && !exists($bblock->{$$op})) {
+	    $bblock->{$$op} = $leader;
+	    $lastop = $op;
+	    $op = $op->next;
+	}
+	push(@bblock_ends, [$leader, $lastop]);
+    }
+    foreach $bb (@bblock_ends) {
+	($leader, $lastop) = @$bb;
+	printf "%s .. %s\n", peekop($leader), peekop($lastop);
+	for ($op = $leader; $$op != $$lastop; $op = $op->next) {
+	    printf "    %s\n", peekop($op);
+	}
+	printf "    %s\n", peekop($lastop);
+    }
+    print "-------\n";
+    walkoptree_exec($start, "terse");
+}
+
+sub walk_bblocks_obj {
+    my $cvref = shift;
+    my $cv = svref_2object($cvref);
+    walk_bblocks($cv->ROOT, $cv->START);
+}
+
+sub B::OP::mark_if_leader {}
+
+sub B::COP::mark_if_leader {
+    my $op = shift;
+    if ($op->label) {
+	mark_leader($op);
+    }
+}
+
+sub B::LOOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->next);
+    mark_leader($op->nextop);
+    mark_leader($op->redoop);
+    mark_leader($op->lastop->next);
+}
+
+sub B::LOGOP::mark_if_leader {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    mark_leader($op->next);
+    if ($ppaddr eq "pp_entertry") {
+	mark_leader($op->other->next);
+    } else {
+	mark_leader($op->other);
+    }
+}
+
+sub B::CONDOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->next);
+    mark_leader($op->true);
+    mark_leader($op->false);
+}
+
+sub B::PMOP::mark_if_leader {
+    my $op = shift;
+    if ($op->ppaddr ne "pp_pushre") {
+	my $replroot = $op->pmreplroot;
+	if ($$replroot) {
+	    mark_leader($replroot);
+	    mark_leader($op->next);
+	    mark_leader($op->pmreplstart);
+	}
+    }
+}
+
+# PMOP stuff omitted
+
+sub compile {
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "walk_bblocks_obj(\\&$objname)";
+		die "walk_bblocks_obj(\\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	return sub { walk_bblocks(main_root, main_start) };
+    }
+}
+
+# Basic block leaders:
+#     Any COP (pp_nextstate) with a non-NULL label
+#     [The op after a pp_enter] Omit
+#     [The op after a pp_entersub. Don't count this one.]
+#     The ops pointed at by nextop, redoop and lastop->op_next of a LOOP
+#     The ops pointed at by op_next and op_other of a LOGOP, except
+#     for pp_entertry which has op_next and op_other->op_next
+#     The ops pointed at by op_true and op_false of a CONDOP
+#     The op pointed at by op_pmreplstart of a PMOP
+#     The op pointed at by op_other->op_pmreplstart of pp_substcont?
+#     [The op after a pp_return] Omit
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bblock - Walk basic blocks
+
+=head1 SYNOPSIS
+
+	perl -MO=Bblock[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Bytecode.pm

@@ -0,0 +1,908 @@
+#      Bytecode.pm
+#
+#      Copyright (c) 1996-1998 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Bytecode;
+use strict;
+use Carp;
+use IO::File;
+
+use B qw(minus_c main_cv main_root main_start comppadlist
+	 class peekop walkoptree svref_2object cstring walksymtable);
+use B::Asmdata qw(@optype @specialsv_name);
+use B::Assembler qw(assemble_fh);
+
+my %optype_enum;
+my $i;
+for ($i = 0; $i < @optype; $i++) {
+    $optype_enum{$optype[$i]} = $i;
+}
+
+# Following is SVf_POK|SVp_POK
+# XXX Shouldn't be hardwired
+sub POK () { 0x04040000 }
+
+# Following is SVf_IOK|SVp_OK
+# XXX Shouldn't be hardwired
+sub IOK () { 0x01010000 }
+
+my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv);
+my $assembler_pid;
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($strip_syntree, $compress_nullops, $omit_seq, $bypass_nullops);
+my %optimise = (strip_syntax_tree	=> \$strip_syntree,
+		compress_nullops	=> \$compress_nullops,
+		omit_sequence_numbers	=> \$omit_seq,
+		bypass_nullops		=> \$bypass_nullops);
+
+my $nextix = 0;
+my %symtable;	# maps object addresses to object indices.
+		# Filled in at allocation (newsv/newop) time.
+my %saved;	# maps object addresses (for SVish classes) to "saved yet?"
+		# flag. Set at FOO::bytecode time usually by SV::bytecode.
+		# Manipulated via saved(), mark_saved(), unmark_saved().
+
+my $svix = -1;	# we keep track of when the sv register contains an element
+		# of the object table to avoid unnecessary repeated
+		# consecutive ldsv instructions.
+my $opix = -1;	# Ditto for the op register.
+
+sub ldsv {
+    my $ix = shift;
+    if ($ix != $svix) {
+	print "ldsv $ix\n";
+	$svix = $ix;
+    }
+}
+
+sub stsv {
+    my $ix = shift;
+    print "stsv $ix\n";
+    $svix = $ix;
+}
+
+sub set_svix {
+    $svix = shift;
+}
+
+sub ldop {
+    my $ix = shift;
+    if ($ix != $opix) {
+	print "ldop $ix\n";
+	$opix = $ix;
+    }
+}
+
+sub stop {
+    my $ix = shift;
+    print "stop $ix\n";
+    $opix = $ix;
+}
+
+sub set_opix {
+    $opix = shift;
+}
+
+sub pvstring {
+    my $str = shift;
+    if (defined($str)) {
+	return cstring($str . "\0");
+    } else {
+	return '""';
+    }
+}
+
+sub saved { $saved{${$_[0]}} }
+sub mark_saved { $saved{${$_[0]}} = 1 }
+sub unmark_saved { $saved{${$_[0]}} = 0 }
+
+sub debug { $debug_bc = shift }
+
+sub B::OBJECT::nyi {
+    my $obj = shift;
+    warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
+		 class($obj), $$obj);
+}
+
+#
+# objix may stomp on the op register (for op objects)
+# or the sv register (for SV objects)
+#
+sub B::OBJECT::objix {
+    my $obj = shift;
+    my $ix = $symtable{$$obj};
+    if (defined($ix)) {
+	return $ix;
+    } else {
+	$obj->newix($nextix);
+	return $symtable{$$obj} = $nextix++;
+    }
+}
+
+sub B::SV::newix {
+    my ($sv, $ix) = @_;
+    printf "newsv %d\t# %s\n", $sv->FLAGS & 0xf, class($sv);
+    stsv($ix);    
+}
+
+sub B::GV::newix {
+    my ($gv, $ix) = @_;
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    print "gv_fetchpv $name\n";
+    stsv($ix);
+}
+
+sub B::HV::newix {
+    my ($hv, $ix) = @_;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+	printf "gv_stashpv %s\n", cstring($name);
+	stsv($ix);
+    } else {
+	# It's an ordinary HV. Fall back to ordinary newix method
+	$hv->B::SV::newix($ix);
+    }
+}
+
+sub B::SPECIAL::newix {
+    my ($sv, $ix) = @_;
+    # Special case. $$sv is not the address of the SV but an
+    # index into svspecialsv_list.
+    printf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
+    stsv($ix);
+}
+
+sub B::OP::newix {
+    my ($op, $ix) = @_;
+    my $class = class($op);
+    my $typenum = $optype_enum{$class};
+    croak "OP::newix: can't understand class $class" unless defined($typenum);
+    print "newop $typenum\t# $class\n";
+    stop($ix);
+}
+
+sub B::OP::walkoptree_debug {
+    my $op = shift;
+    warn(sprintf("walkoptree: %s\n", peekop($op)));
+}
+
+sub B::OP::bytecode {
+    my $op = shift;
+    my $next = $op->next;
+    my $nextix;
+    my $sibix = $op->sibling->objix;
+    my $ix = $op->objix;
+    my $type = $op->type;
+
+    if ($bypass_nullops) {
+	$next = $next->next while $$next && $next->type == 0;
+    }
+    $nextix = $next->objix;
+
+    printf "# %s\n", peekop($op) if $debug_bc;
+    ldop($ix);
+    print "op_next $nextix\n";
+    print "op_sibling $sibix\n" unless $strip_syntree;
+    printf "op_type %s\t# %d\n", $op->ppaddr, $type;
+    printf("op_seq %d\n", $op->seq) unless $omit_seq;
+    if ($type || !$compress_nullops) {
+	printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
+	    $op->targ, $op->flags, $op->private;
+    }
+}
+
+sub B::UNOP::bytecode {
+    my $op = shift;
+    my $firstix = $op->first->objix;
+    $op->B::OP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_first $firstix\n";
+    }
+}
+
+sub B::LOGOP::bytecode {
+    my $op = shift;
+    my $otherix = $op->other->objix;
+    $op->B::UNOP::bytecode;
+    print "op_other $otherix\n";
+}
+
+sub B::SVOP::bytecode {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $svix = $sv->objix;
+    $op->B::OP::bytecode;
+    print "op_sv $svix\n";
+    $sv->bytecode;
+}
+
+sub B::GVOP::bytecode {
+    my $op = shift;
+    my $gv = $op->gv;
+    my $gvix = $gv->objix;
+    $op->B::OP::bytecode;
+    print "op_gv $gvix\n";
+    $gv->bytecode;
+}
+
+sub B::PVOP::bytecode {
+    my $op = shift;
+    my $pv = $op->pv;
+    $op->B::OP::bytecode;
+    #
+    # This would be easy except that OP_TRANS uses a PVOP to store an
+    # endian-dependent array of 256 shorts instead of a plain string.
+    #
+    if ($op->ppaddr eq "pp_trans") {
+	my @shorts = unpack("s256", $pv); # assembler handles endianness
+	print "op_pv_tr ", join(",", @shorts), "\n";
+    } else {
+	printf "newpv %s\nop_pv\n", pvstring($pv);
+    }
+}
+
+sub B::BINOP::bytecode {
+    my $op = shift;
+    my $lastix = $op->last->objix;
+    $op->B::UNOP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_last $lastix\n";
+    }
+}
+
+sub B::CONDOP::bytecode {
+    my $op = shift;
+    my $trueix = $op->true->objix;
+    my $falseix = $op->false->objix;
+    $op->B::UNOP::bytecode;
+    print "op_true $trueix\nop_false $falseix\n";
+}
+
+sub B::LISTOP::bytecode {
+    my $op = shift;
+    my $children = $op->children;
+    $op->B::BINOP::bytecode;
+    if (($op->type || !$compress_nullops) && !$strip_syntree) {
+	print "op_children $children\n";
+    }
+}
+
+sub B::LOOP::bytecode {
+    my $op = shift;
+    my $redoopix = $op->redoop->objix;
+    my $nextopix = $op->nextop->objix;
+    my $lastopix = $op->lastop->objix;
+    $op->B::LISTOP::bytecode;
+    print "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
+}
+
+sub B::COP::bytecode {
+    my $op = shift;
+    my $stash = $op->stash;
+    my $stashix = $stash->objix;
+    my $filegv = $op->filegv;
+    my $filegvix = $filegv->objix;
+    my $line = $op->line;
+    if ($debug_bc) {
+	printf "# line %s:%d\n", $filegv->SV->PV, $line;
+    }
+    $op->B::OP::bytecode;
+    printf <<"EOT", pvstring($op->label), $op->cop_seq, $op->arybase;
+newpv %s
+cop_label
+cop_stash $stashix
+cop_seq %d
+cop_filegv $filegvix
+cop_arybase %d
+cop_line $line
+EOT
+    $filegv->bytecode;
+    $stash->bytecode;
+}
+
+sub B::PMOP::bytecode {
+    my $op = shift;
+    my $replroot = $op->pmreplroot;
+    my $replrootix = $replroot->objix;
+    my $replstartix = $op->pmreplstart->objix;
+    my $ppaddr = $op->ppaddr;
+    # pmnext is corrupt in some PMOPs (see misc.t for example)
+    #my $pmnextix = $op->pmnext->objix;
+
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($ppaddr eq "pp_pushre") {
+	    $replroot->bytecode;
+	} else {
+	    walkoptree($replroot, "bytecode");
+	}
+    }
+    $op->B::LISTOP::bytecode;
+    if ($ppaddr eq "pp_pushre") {
+	printf "op_pmreplrootgv $replrootix\n";
+    } else {
+	print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+    }
+    my $re = pvstring($op->precomp);
+    # op_pmnext omitted since a perl bug means it's sometime corrupt
+    printf <<"EOT", $op->pmflags, $op->pmpermflags;
+op_pmflags 0x%x
+op_pmpermflags 0x%x
+newpv $re
+pregcomp
+EOT
+}
+
+sub B::SV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $ix = $sv->objix;
+    my $refcnt = $sv->REFCNT;
+    my $flags = sprintf("0x%x", $sv->FLAGS);
+    ldsv($ix);
+    print "sv_refcnt $refcnt\nsv_flags $flags\n";
+    mark_saved($sv);
+}
+
+sub B::PV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    printf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
+}
+
+sub B::IV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::SV::bytecode;
+    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+}
+
+sub B::NV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::SV::bytecode;
+    printf "xnv %s\n", $sv->NVX;
+}
+
+sub B::RV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $rv = $sv->RV;
+    my $rvix = $rv->objix;
+    $rv->bytecode;
+    $sv->B::SV::bytecode;
+    print "xrv $rvix\n";
+}
+
+sub B::PVIV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    my $iv = $sv->IVX;
+    $sv->B::PV::bytecode;
+    printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+}
+
+sub B::PVNV::bytecode {
+    my ($sv, $flag) = @_;
+    # The $flag argument is passed through PVMG::bytecode by BM::bytecode
+    # and AV::bytecode and indicates special handling. $flag = 1 is used by
+    # BM::bytecode and means that we should ensure we save the whole B-M
+    # table. It consists of 257 bytes (256 char array plus a final \0)
+    # which follow the ordinary PV+\0 and the 257 bytes are *not* reflected
+    # in SvCUR. $flag = 2 is used by AV::bytecode and means that we only
+    # call SV::bytecode instead of saving PV and calling NV::bytecode since
+    # PV/NV/IV stuff is different for AVs.
+    return if saved($sv);
+    if ($flag == 2) {
+	$sv->B::SV::bytecode;
+    } else {
+	my $pv = $sv->PV;
+	$sv->B::IV::bytecode;
+	printf "xnv %s\n", $sv->NVX;
+	if ($flag == 1) {
+	    $pv .= "\0" . $sv->TABLE;
+	    printf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
+	} else {
+	    printf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
+	}
+    }
+}
+
+sub B::PVMG::bytecode {
+    my ($sv, $flag) = @_;
+    # See B::PVNV::bytecode for an explanation of $flag.
+    return if saved($sv);
+    # XXX We assume SvSTASH is already saved and don't save it later ourselves
+    my $stashix = $sv->SvSTASH->objix;
+    my @mgchain = $sv->MAGIC;
+    my (@mgobjix, $mg);
+    #
+    # We need to traverse the magic chain and get objix for each OBJ
+    # field *before* we do B::PVNV::bytecode since objix overwrites
+    # the sv register. However, we need to write the magic-saving
+    # bytecode *after* B::PVNV::bytecode since sv isn't initialised
+    # to refer to $sv until then.
+    #
+    @mgobjix = map($_->OBJ->objix, @mgchain);
+    $sv->B::PVNV::bytecode($flag);
+    print "xmg_stash $stashix\n";
+    foreach $mg (@mgchain) {
+	printf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
+	    cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
+    }
+}
+
+sub B::PVLV::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    $sv->B::PVMG::bytecode;
+    printf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
+xlv_targoff %d
+xlv_targlen %d
+xlv_type %s
+EOT
+}
+
+sub B::BM::bytecode {
+    my $sv = shift;
+    return if saved($sv);
+    # See PVNV::bytecode for an explanation of what the argument does
+    $sv->B::PVMG::bytecode(1);
+    printf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
+	$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
+}
+
+sub B::GV::bytecode {
+    my $gv = shift;
+    return if saved($gv);
+    my $ix = $gv->objix;
+    mark_saved($gv);
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    my $egv = $gv->EGV;
+    my $egvix = $egv->objix;
+    ldsv($ix);
+    printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE;
+sv_flags 0x%x
+xgv_flags 0x%x
+gp_line %d
+EOT
+    my $refcnt = $gv->REFCNT;
+    printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+    my $gvrefcnt = $gv->GvREFCNT;
+    printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
+    if ($gvrefcnt > 1 &&  $ix != $egvix) {
+	print "gp_share $egvix\n";
+    } else {
+	if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	    my $i;
+	    my @subfield_names = qw(SV AV HV CV FILEGV FORM IO);
+	    my @subfields = map($gv->$_(), @subfield_names);
+	    my @ixes = map($_->objix, @subfields);
+	    # Reset sv register for $gv
+	    ldsv($ix);
+	    for ($i = 0; $i < @ixes; $i++) {
+		printf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+	    }
+	    # Now save all the subfields
+	    my $sv;
+	    foreach $sv (@subfields) {
+		$sv->bytecode;
+	    }
+	}
+    }
+}
+
+sub B::HV::bytecode {
+    my $hv = shift;
+    return if saved($hv);
+    mark_saved($hv);
+    my $name = $hv->NAME;
+    my $ix = $hv->objix;
+    if (!$name) {
+	# It's an ordinary HV. Stashes have NAME set and need no further
+	# saving beyond the gv_stashpv that $hv->objix already ensures.
+	my @contents = $hv->ARRAY;
+	my ($i, @ixes);
+	for ($i = 1; $i < @contents; $i += 2) {
+	    push(@ixes, $contents[$i]->objix);
+	}
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i]->bytecode;
+	}
+	ldsv($ix);
+	for ($i = 0; $i < @contents; $i += 2) {
+	    printf("newpv %s\nhv_store %d\n",
+		   pvstring($contents[$i]), $ixes[$i / 2]);
+	}
+	printf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
+    }
+}
+
+sub B::AV::bytecode {
+    my $av = shift;
+    return if saved($av);
+    my $ix = $av->objix;
+    my $fill = $av->FILL;
+    my $max = $av->MAX;
+    my (@array, @ixes);
+    if ($fill > -1) {
+	@array = $av->ARRAY;
+	@ixes = map($_->objix, @array);
+	my $sv;
+	foreach $sv (@array) {
+	    $sv->bytecode;
+	}
+    }
+    # See PVNV::bytecode for the meaning of the flag argument of 2.
+    $av->B::PVMG::bytecode(2);
+    # Recover sv register and set AvMAX and AvFILL to -1 (since we
+    # create an AV with NEWSV and SvUPGRADE rather than doing newAV
+    # which is what sets AvMAX and AvFILL.
+    ldsv($ix);
+    printf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
+    if ($fill > -1) {
+	my $elix;
+	foreach $elix (@ixes) {
+	    print "av_push $elix\n";
+	}
+    } else {
+	if ($max > -1) {
+	    print "av_extend $max\n";
+	}
+    }
+}
+
+sub B::CV::bytecode {
+    my $cv = shift;
+    return if saved($cv);
+    my $ix = $cv->objix;
+    $cv->B::PVMG::bytecode;
+    my $i;
+    my @subfield_names = qw(ROOT START STASH GV FILEGV PADLIST OUTSIDE);
+    my @subfields = map($cv->$_(), @subfield_names);
+    my @ixes = map($_->objix, @subfields);
+    # Save OP tree from CvROOT (first element of @subfields)
+    my $root = shift @subfields;
+    if ($$root) {
+	walkoptree($root, "bytecode");
+    }
+    # Reset sv register for $cv (since above ->objix calls stomped on it)
+    ldsv($ix);
+    for ($i = 0; $i < @ixes; $i++) {
+	printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+    }
+    printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS;
+    # Now save all the subfields (except for CvROOT which was handled
+    # above) and CvSTART (now the initial element of @subfields).
+    shift @subfields; # bye-bye CvSTART
+    my $sv;
+    foreach $sv (@subfields) {
+	$sv->bytecode;
+    }
+}
+
+sub B::IO::bytecode {
+    my $io = shift;
+    return if saved($io);
+    my $ix = $io->objix;
+    my $top_gv = $io->TOP_GV;
+    my $top_gvix = $top_gv->objix;
+    my $fmt_gv = $io->FMT_GV;
+    my $fmt_gvix = $fmt_gv->objix;
+    my $bottom_gv = $io->BOTTOM_GV;
+    my $bottom_gvix = $bottom_gv->objix;
+
+    $io->B::PVMG::bytecode;
+    ldsv($ix);
+    print "xio_top_gv $top_gvix\n";
+    print "xio_fmt_gv $fmt_gvix\n";
+    print "xio_bottom_gv $bottom_gvix\n";
+    my $field;
+    foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) {
+	printf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
+    }
+    foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
+	printf "xio_%s %d\n", lc($field), $io->$field();
+    }
+    printf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
+    $top_gv->bytecode;
+    $fmt_gv->bytecode;
+    $bottom_gv->bytecode;
+}
+
+sub B::SPECIAL::bytecode {
+    # nothing extra needs doing
+}
+
+sub bytecompile_object {
+    my $sv;
+    foreach $sv (@_) {
+	svref_2object($sv)->bytecode;
+    }
+}
+
+sub B::GV::bytecodecv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv && !saved($cv)) {
+	if ($debug_cv) {
+	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+			 $gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
+	}
+	$gv->bytecode;
+    }
+}
+
+sub bytecompile_main {
+    my $curpad = (comppadlist->ARRAY)[1];
+    my $curpadix = $curpad->objix;
+    $curpad->bytecode;
+    walkoptree(main_root, "bytecode");
+    warn "done main program, now walking symbol table\n" if $debug_bc;
+    my ($pack, %exclude);
+    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS strict vars
+		      FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol
+		      SelectSaver blib Cwd))
+    {
+	$exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "bytecodecv", sub {
+	warn "considering $_[0]\n" if $debug_bc;
+	return !defined($exclude{$_[0]});
+    });
+    if (!$module_only) {
+	printf "main_root %d\n", main_root->objix;
+	printf "main_start %d\n", main_start->objix;
+	printf "curpad $curpadix\n";
+	# XXX Do min_intro_pending and max_intro_pending matter?
+    }
+}
+
+sub prepare_assemble {
+    my $newfh = IO::File->new_tmpfile;
+    select($newfh);
+    binmode $newfh;
+    return $newfh;
+}
+
+sub do_assemble {
+    my $fh = shift;
+    seek($fh, 0, 0); # rewind the temporary file
+    assemble_fh($fh, sub { print OUT @_ });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    open(OUT, ">&STDOUT");
+    binmode OUT;
+    select(OUT);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(OUT, ">$arg") or return "$arg: $!\n";
+	    binmode OUT;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "b") {
+		    $| = 1;
+		    debug(1);
+		} elsif ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "a") {
+		    B::Assembler::debug(1);
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		}
+	    }
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "m") {
+	    $module_only = 1;
+	} elsif ($opt eq "S") {
+	    $no_assemble = 1;
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 6) {
+		$strip_syntree = 1;
+	    }
+	    if ($arg >= 2) {
+		$bypass_nullops = 1;
+	    }
+	    if ($arg >= 1) {
+		$compress_nullops = 1;
+		$omit_seq = 1;
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    my $newfh; 
+	    $newfh = prepare_assemble() unless $no_assemble;
+	    foreach $objname (@options) {
+		eval "bytecompile_object(\\$objname)";
+	    }
+	    do_assemble($newfh) unless $no_assemble;
+	}
+    } else {
+	return sub {
+	    my $newfh; 
+	    $newfh = prepare_assemble() unless $no_assemble;
+	    bytecompile_main();
+	    do_assemble($newfh) unless $no_assemble;
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Bytecode - Perl compiler's bytecode backend
+
+=head1 SYNOPSIS
+
+	perl -MO=Bytecode[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This compiler backend takes Perl source and generates a
+platform-independent bytecode encapsulating code to load the
+internal structures perl uses to run your program. When the
+generated bytecode is loaded in, your program is ready to run,
+reducing the time which perl would have taken to load and parse
+your program into its internal semi-compiled form. That means that
+compiling with this backend will not help improve the runtime
+execution speed of your program but may improve the start-up time.
+Depending on the environment in which your program runs this may
+or may not be a help.
+
+The resulting bytecode can be run with a special byteperl executable
+or (for non-main programs) be loaded via the C<byteload_fh> function
+in the F<B> module.
+
+=head1 OPTIONS
+
+If there are any non-option arguments, they are taken to be names of
+objects to be saved (probably doesn't work properly yet).  Without
+extra arguments, it saves the main program.
+
+=over 4
+
+=item B<-ofilename>
+
+Output to filename instead of STDOUT.
+
+=item B<-->
+
+Force end of options.
+
+=item B<-f>
+
+Force optimisations on or off one at a time. Each can be preceded
+by B<no-> to turn the option off (e.g. B<-fno-compress-nullops>).
+
+=item B<-fcompress-nullops>
+
+Only fills in the necessary fields of ops which have
+been optimised away by perl's internal compiler.
+
+=item B<-fomit-sequence-numbers>
+
+Leaves out code to fill in the op_seq field of all ops
+which is only used by perl's internal compiler.
+
+=item B<-fbypass-nullops>
+
+If op->op_next ever points to a NULLOP, replaces the op_next field
+with the first non-NULLOP in the path of execution.
+
+=item B<-fstrip-syntax-tree>
+
+Leaves out code to fill in the pointers which link the internal syntax
+tree together. They're not needed at run-time but leaving them out
+will make it impossible to recompile or disassemble the resulting
+program.  It will also stop C<goto label> statements from working.
+
+=item B<-On>
+
+Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
+B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
+B<-O6> adds B<-fstrip-syntax-tree>.
+
+=item B<-D>
+
+Debug options (concatenated or separate flags like C<perl -D>).
+
+=item B<-Do>
+
+Prints each OP as it's processed.
+
+=item B<-Db>
+
+Print debugging information about bytecompiler progress.
+
+=item B<-Da>
+
+Tells the (bytecode) assembler to include source assembler lines
+in its output as bytecode comments.
+
+=item B<-DC>
+
+Prints each CV taken from the final symbol tree walk.
+
+=item B<-S>
+
+Output (bytecode) assembler source rather than piping it
+through the assembler and outputting bytecode.
+
+=item B<-m>
+
+Compile as a module rather than a standalone program. Currently this
+just means that the bytecodes for initialising C<main_start>,
+C<main_root> and C<curpad> are omitted.
+
+=back
+
+=head1 EXAMPLES
+
+        perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+        perl -MO=Bytecode,-S foo.pl > foo.S
+        assemble foo.S > foo.plc
+        byteperl foo.plc
+
+        perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+
+=head1 BUGS
+
+Plenty. Current status: experimental.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Debug.pm

@@ -0,0 +1,283 @@
+package B::Debug;
+use strict;
+use B qw(peekop class walkoptree walkoptree_exec
+         main_start main_root cstring sv_undef);
+use B::Asmdata qw(@specialsv_name);
+
+my %done_gv;
+
+sub B::OP::debug {
+    my ($op) = @_;
+    printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
+%s (0x%lx)
+	op_next		0x%x
+	op_sibling	0x%x
+	op_ppaddr	%s
+	op_targ		%d
+	op_type		%d
+	op_seq		%d
+	op_flags	%d
+	op_private	%d
+EOT
+}
+
+sub B::UNOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_first\t0x%x\n", ${$op->first};
+}
+
+sub B::BINOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_last\t\t0x%x\n", ${$op->last};
+}
+
+sub B::LOGOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_other\t0x%x\n", ${$op->other};
+}
+
+sub B::CONDOP::debug {
+    my ($op) = @_;
+    $op->B::UNOP::debug();
+    printf "\top_true\t0x%x\n", ${$op->true};
+    printf "\top_false\t0x%x\n", ${$op->false};
+}
+
+sub B::LISTOP::debug {
+    my ($op) = @_;
+    $op->B::BINOP::debug();
+    printf "\top_children\t%d\n", $op->children;
+}
+
+sub B::PMOP::debug {
+    my ($op) = @_;
+    $op->B::LISTOP::debug();
+    printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot};
+    printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart};
+    printf "\top_pmnext\t0x%x\n", ${$op->pmnext};
+    printf "\top_pmregexp->precomp\t%s\n", cstring($op->precomp);
+    printf "\top_pmflags\t0x%x\n", $op->pmflags;
+    $op->pmshort->debug;
+    $op->pmreplroot->debug;
+}
+
+sub B::COP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    my ($filegv) = $op->filegv;
+    printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line;
+	cop_label	%s
+	cop_stash	0x%x
+	cop_filegv	0x%x
+	cop_seq		%d
+	cop_arybase	%d
+	cop_line	%d
+EOT
+    $filegv->debug;
+}
+
+sub B::SVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_sv\t\t0x%x\n", ${$op->sv};
+    $op->sv->debug;
+}
+
+sub B::PVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_pv\t\t0x%x\n", $op->pv;
+}
+
+sub B::GVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_gv\t\t0x%x\n", ${$op->gv};
+    $op->gv->debug;
+}
+
+sub B::CVOP::debug {
+    my ($op) = @_;
+    $op->B::OP::debug();
+    printf "\top_cv\t\t0x%x\n", ${$op->cv};
+}
+
+sub B::NULL::debug {
+    my ($sv) = @_;
+    if ($$sv == ${sv_undef()}) {
+	print "&sv_undef\n";
+    } else {
+	printf "NULL (0x%x)\n", $$sv;
+    }
+}
+
+sub B::SV::debug {
+    my ($sv) = @_;
+    if (!$$sv) {
+	print class($sv), " = NULL\n";
+	return;
+    }
+    printf <<'EOT', class($sv), $$sv, $sv->REFCNT, $sv->FLAGS;
+%s (0x%x)
+	REFCNT		%d
+	FLAGS		0x%x
+EOT
+}
+
+sub B::PV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    my $pv = $sv->PV();
+    printf <<'EOT', cstring($pv), length($pv);
+	xpv_pv		%s
+	xpv_cur		%d
+EOT
+}
+
+sub B::IV::debug {
+    my ($sv) = @_;
+    $sv->B::SV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::NV::debug {
+    my ($sv) = @_;
+    $sv->B::IV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVIV::debug {
+    my ($sv) = @_;
+    $sv->B::PV::debug();
+    printf "\txiv_iv\t\t%d\n", $sv->IV;
+}
+
+sub B::PVNV::debug {
+    my ($sv) = @_;
+    $sv->B::PVIV::debug();
+    printf "\txnv_nv\t\t%s\n", $sv->NV;
+}
+
+sub B::PVLV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txlv_targoff\t%d\n", $sv->TARGOFF;
+    printf "\txlv_targlen\t%u\n", $sv->TARGLEN;
+    printf "\txlv_type\t%s\n", cstring(chr($sv->TYPE));
+}
+
+sub B::BM::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    printf "\txbm_useful\t%d\n", $sv->USEFUL;
+    printf "\txbm_previous\t%u\n", $sv->PREVIOUS;
+    printf "\txbm_rare\t%s\n", cstring(chr($sv->RARE));
+}
+
+sub B::CV::debug {
+    my ($sv) = @_;
+    $sv->B::PVNV::debug();
+    my ($stash) = $sv->STASH;
+    my ($start) = $sv->START;
+    my ($root) = $sv->ROOT;
+    my ($padlist) = $sv->PADLIST;
+    my ($gv) = $sv->GV;
+    my ($filegv) = $sv->FILEGV;
+    printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE};
+	STASH		0x%x
+	START		0x%x
+	ROOT		0x%x
+	GV		0x%x
+	FILEGV		0x%x
+	DEPTH		%d
+	PADLIST		0x%x			       
+	OUTSIDE		0x%x
+EOT
+    $start->debug if $start;
+    $root->debug if $root;
+    $gv->debug if $gv;
+    $filegv->debug if $filegv;
+    $padlist->debug if $padlist;
+}
+
+sub B::AV::debug {
+    my ($av) = @_;
+    $av->B::SV::debug;
+    my(@array) = $av->ARRAY;
+    print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
+    printf <<'EOT', scalar(@array), $av->MAX, $av->OFF, $av->AvFLAGS;
+	FILL		%d    
+	MAX		%d
+	OFF		%d
+	AvFLAGS		%d
+EOT
+}
+    
+sub B::GV::debug {
+    my ($gv) = @_;
+    if ($done_gv{$$gv}++) {
+	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME;
+	return;
+    }
+    my ($sv) = $gv->SV;
+    my ($av) = $gv->AV;
+    my ($cv) = $gv->CV;
+    $gv->B::SV::debug;
+    printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS;
+	NAME		%s
+	STASH		%s (0x%x)
+	SV		0x%x
+	GvREFCNT	%d
+	FORM		0x%x
+	AV		0x%x
+	HV		0x%x
+	EGV		0x%x
+	CV		0x%x
+	CVGEN		%d
+	LINE		%d
+	FILEGV		0x%x
+	GvFLAGS		0x%x
+EOT
+    $sv->debug if $sv;
+    $av->debug if $av;
+    $cv->debug if $cv;
+}
+
+sub B::SPECIAL::debug {
+    my $sv = shift;
+    print $specialsv_name[$$sv], "\n";
+}
+
+sub compile {
+    my $order = shift;
+    if ($order eq "exec") {
+        return sub { walkoptree_exec(main_start, "debug") }
+    } else {
+        return sub { walkoptree(main_root, "debug") }
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Debug - Walk Perl syntax tree, printing debug info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Debug[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Disassembler.pm

@@ -0,0 +1,164 @@
+#      Disassembler.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+package B::Disassembler::BytecodeStream;
+use FileHandle;
+use Carp;
+use B qw(cstring cast_I32);
+@ISA = qw(FileHandle);
+sub readn {
+    my ($fh, $len) = @_;
+    my $data;
+    read($fh, $data, $len);
+    croak "reached EOF while reading $len bytes" unless length($data) == $len;
+    return $data;
+}
+
+sub GET_U8 {
+    my $fh = shift;
+    my $c = $fh->getc;
+    croak "reached EOF while reading U8" unless defined($c);
+    return ord($c);
+}
+
+sub GET_U16 {
+    my $fh = shift;
+    my $str = $fh->readn(2);
+    croak "reached EOF while reading U16" unless length($str) == 2;
+    return unpack("n", $str);
+}
+
+sub GET_U32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading U32" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_I32 {
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading I32" unless length($str) == 4;
+    return cast_I32(unpack("N", $str));
+}
+
+sub GET_objindex { 
+    my $fh = shift;
+    my $str = $fh->readn(4);
+    croak "reached EOF while reading objindex" unless length($str) == 4;
+    return unpack("N", $str);
+}
+
+sub GET_strconst {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading strconst" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_pvcontents {}
+
+sub GET_PV {
+    my $fh = shift;
+    my $str;
+    my $len = $fh->GET_U32;
+    if ($len) {
+	read($fh, $str, $len);
+	croak "reached EOF while reading PV" unless length($str) == $len;
+	return cstring($str);
+    } else {
+	return '""';
+    }
+}
+
+sub GET_comment {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\n") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading comment" unless defined($c);
+    return cstring($str);
+}
+
+sub GET_double {
+    my $fh = shift;
+    my ($str, $c);
+    while (defined($c = $fh->getc) && $c ne "\0") {
+	$str .= $c;
+    }
+    croak "reached EOF while reading double" unless defined($c);
+    return $str;
+}
+
+sub GET_none {}
+
+sub GET_op_tr_array {
+    my $fh = shift;
+    my @ary = unpack("n256", $fh->readn(256 * 2));
+    return join(",", @ary);
+}
+
+sub GET_IV64 {
+    my $fh = shift;
+    my ($hi, $lo) = unpack("NN", $fh->readn(8));
+    return sprintf("0x%4x%04x", $hi, $lo); # cheat
+}
+
+package B::Disassembler;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(disassemble_fh);
+use Carp;
+use strict;
+
+use B::Asmdata qw(%insn_data @insn_name);
+
+sub disassemble_fh {
+    my ($fh, $out) = @_;
+    my ($c, $getmeth, $insn, $arg);
+    bless $fh, "B::Disassembler::BytecodeStream";
+    while (defined($c = $fh->getc)) {
+	$c = ord($c);
+	$insn = $insn_name[$c];
+	if (!defined($insn) || $insn eq "unused") {
+	    my $pos = $fh->tell - 1;
+	    die "Illegal instruction code $c at stream offset $pos\n";
+	}
+	$getmeth = $insn_data{$insn}->[2];
+	$arg = $fh->$getmeth();
+	if (defined($arg)) {
+	    &$out($insn, $arg);
+	} else {
+	    &$out($insn);
+	}
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Disassembler - Disassemble Perl bytecode
+
+=head1 SYNOPSIS
+
+	use Disassembler;
+
+=head1 DESCRIPTION
+
+See F<ext/B/B/Disassembler.pm>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Lint.pm

@@ -0,0 +1,367 @@
+package B::Lint;
+
+=head1 NAME
+
+B::Lint - Perl lint
+
+=head1 SYNOPSIS
+
+perl -MO=Lint[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Lint module is equivalent to an extended version of the B<-w>
+option of B<perl>. It is named after the program B<lint> which carries
+out a similar process for C programs.
+
+=head1 OPTIONS AND LINT CHECKS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options. Following any options
+(indicated by a leading B<->) come lint check arguments. Each such
+argument (apart from the special B<all> and B<none> options) is a
+word representing one possible lint check (turning on that check) or
+is B<no-foo> (turning off that check). Before processing the check
+arguments, a standard list of checks is turned on. Later options
+override earlier ones. Available options are:
+
+=over 8
+
+=item B<context>
+
+Produces a warning whenever an array is used in an implicit scalar
+context. For example, both of the lines
+
+    $foo = length(@bar);
+    $foo = @bar;
+will elicit a warning. Using an explicit B<scalar()> silences the
+warning. For example,
+
+    $foo = scalar(@bar);
+
+=item B<implicit-read> and B<implicit-write>
+
+These options produce a warning whenever an operation implicitly
+reads or (respectively) writes to one of Perl's special variables.
+For example, B<implicit-read> will warn about these:
+
+    /foo/;
+
+and B<implicit-write> will warn about these:
+
+    s/foo/bar/;
+
+Both B<implicit-read> and B<implicit-write> warn about this:
+
+    for (@a) { ... }
+
+=item B<dollar-underscore>
+
+This option warns whenever $_ is used either explicitly anywhere or
+as the implicit argument of a B<print> statement.
+
+=item B<private-names>
+
+This option warns on each use of any variable, subroutine or
+method name that lives in a non-current package but begins with
+an underscore ("_"). Warnings aren't issued for the special case
+of the single character name "_" by itself (e.g. $_ and @_).
+
+=item B<undefined-subs>
+
+This option warns whenever an undefined subroutine is invoked.
+This option will only catch explicitly invoked subroutines such
+as C<foo()> and not indirect invocations such as C<&$subref()>
+or C<$obj-E<gt>meth()>. Note that some programs or modules delay
+definition of subs until runtime by means of the AUTOLOAD
+mechanism.
+
+=item B<regexp-variables>
+
+This option warns whenever one of the regexp variables $', $& or
+$' is used. Any occurrence of any of these variables in your
+program can slow your whole program down. See L<perlre> for
+details.
+
+=item B<all>
+
+Turn all warnings on.
+
+=item B<none>
+
+Turn all warnings off.
+
+=back
+
+=head1 NON LINT-CHECK OPTIONS
+
+=over 8
+
+=item B<-u Package>
+
+Normally, Lint only checks the main code of the program together
+with all subs defined in package main. The B<-u> option lets you
+include other package names whose subs are then checked by Lint.
+
+=back
+
+=head1 BUGS
+
+This is only a very preliminary version.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(walkoptree_slow main_root walksymtable svref_2object parents);
+
+# Constants (should probably be elsewhere)
+sub G_ARRAY () { 1 }
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_STACKED () { 64 }
+
+my $file = "unknown";		# shadows current filename
+my $line = 0;			# shadows current line number
+my $curstash = "main";		# shadows current stash
+
+# Lint checks
+my %check;
+my %implies_ok_context;
+BEGIN {
+    map($implies_ok_context{$_}++,
+	qw(pp_scalar pp_av2arylen pp_aelem pp_aslice pp_helem pp_hslice
+	   pp_keys pp_values pp_hslice pp_defined pp_undef pp_delete));
+}
+
+# Lint checks turned on by default
+my @default_checks = qw(context);
+
+my %valid_check;
+# All valid checks
+BEGIN {
+    map($valid_check{$_}++,
+	qw(context implicit_read implicit_write dollar_underscore
+	   private_names undefined_subs regexp_variables));
+}
+
+# Debugging options
+my ($debug_op);
+
+my %done_cv;		# used to mark which subs have already been linted
+my @extra_packages;	# Lint checks mainline code and all subs which are
+			# in main:: or in one of these packages.
+
+sub warning {
+    my $format = (@_ < 2) ? "%s" : shift;
+    warn sprintf("$format at %s line %d\n", @_, $file, $line);
+}
+
+# This gimme can't cope with context that's only determined
+# at runtime via dowantarray().
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    if ($flags & OPf_KNOW) {
+	return(($flags & OPf_LIST) ? 1 : 0);
+    }
+    return undef;
+}
+
+sub B::OP::lint {}
+
+sub B::COP::lint {
+    my $op = shift;
+    if ($op->ppaddr eq "pp_nextstate") {
+	$file = $op->filegv->SV->PV;
+	$line = $op->line;
+	$curstash = $op->stash->NAME;
+    }
+}
+
+sub B::UNOP::lint {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    if ($check{context} && ($ppaddr eq "pp_rv2av" || $ppaddr eq "pp_rv2hv")) {
+	my $parent = parents->[0];
+	my $pname = $parent->ppaddr;
+	return if gimme($op) || $implies_ok_context{$pname};
+	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
+	# null out the parent so we have to check for a parent of pp_null and
+	# a grandparent of pp_enteriter or pp_delete
+	if ($pname eq "pp_null") {
+	    my $gpname = parents->[1]->ppaddr;
+	    return if $gpname eq "pp_enteriter" || $gpname eq "pp_delete";
+	}
+	warning("Implicit scalar context for %s in %s",
+		$ppaddr eq "pp_rv2av" ? "array" : "hash", $parent->desc);
+    }
+    if ($check{private_names} && $ppaddr eq "pp_method") {
+	my $methop = $op->first;
+	if ($methop->ppaddr eq "pp_const") {
+	    my $method = $methop->sv->PV;
+	    if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
+		warning("Illegal reference to private method name $method");
+	    }
+	}
+    }
+}
+
+sub B::PMOP::lint {
+    my $op = shift;
+    if ($check{implicit_read}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_match" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit match on $_');
+	}
+    }
+    if ($check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_subst" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit substitution on $_');
+	}
+    }
+}
+
+sub B::LOOP::lint {
+    my $op = shift;
+    if ($check{implicit_read} || $check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_enteriter") {
+	    my $last = $op->last;
+	    if ($last->ppaddr eq "pp_gv" && $last->gv->NAME eq "_") {
+		warning('Implicit use of $_ in foreach');
+	    }
+	}
+    }
+}
+
+sub B::GVOP::lint {
+    my $op = shift;
+    if ($check{dollar_underscore} && $op->ppaddr eq "pp_gvsv"
+	&& $op->gv->NAME eq "_")
+    {
+	warning('Use of $_');
+    }
+    if ($check{private_names}) {
+	my $ppaddr = $op->ppaddr;
+	my $gv = $op->gv;
+	if (($ppaddr eq "pp_gv" || $ppaddr eq "pp_gvsv")
+	    && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
+	{
+	    warning('Illegal reference to private name %s', $gv->NAME);
+	}
+    }
+    if ($check{undefined_subs}) {
+	if ($op->ppaddr eq "pp_gv" && $op->next->ppaddr eq "pp_entersub") {
+	    my $gv = $op->gv;
+	    my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
+	    no strict 'refs';
+	    if (!defined(&$subname)) {
+		$subname =~ s/^main:://;
+		warning('Undefined subroutine %s called', $subname);
+	    }
+	}
+    }
+    if ($check{regexp_variables} && $op->ppaddr eq "pp_gvsv") {
+	my $name = $op->gv->NAME;
+	if ($name =~ /^[&'`]$/) {
+	    warning('Use of regexp variable $%s', $name);
+	}
+    }
+}
+
+sub B::GV::lintcv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    #warn sprintf("lintcv: %s::%s (done=%d)\n",
+    #		 $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
+    return if !$$cv || $done_cv{$$cv}++;
+    my $root = $cv->ROOT;
+    #warn "    root = $root (0x$$root)\n";#debug
+    walkoptree_slow($root, "lint") if $$root;
+}
+
+sub do_lint {
+    my %search_pack;
+    walkoptree_slow(main_root, "lint") if ${main_root()};
+    
+    # Now do subs in main
+    no strict qw(vars refs);
+    my $sym;
+    local(*glob);
+    while (($sym, *glob) = each %{"main::"}) {
+	#warn "Trying $sym\n";#debug
+	svref_2object(\*glob)->EGV->lintcv unless $sym =~ /::$/;
+    }
+
+    # Now do subs in non-main packages given by -u options
+    map { $search_pack{$_} = 1 } @extra_packages;
+    walksymtable(\%{"main::"}, "lintcv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return exists $search_pack{$package};
+    });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    # Turn on default lint checks
+    for $opt (@default_checks) {
+	$check{$opt} = 1;
+    }
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		}
+	    }
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@extra_packages, $arg);
+	}
+    }
+    foreach $opt (@default_checks, @options) {
+	$opt =~ tr/-/_/;
+	if ($opt eq "all") {
+	    %check = %valid_check;
+	}
+	elsif ($opt eq "none") {
+	    %check = ();
+	}
+	else {
+	    if ($opt =~ s/^no-//) {
+		$check{$opt} = 0;
+	    }
+	    else {
+		$check{$opt} = 1;
+	    }
+	    warn "No such check: $opt\n" unless defined $valid_check{$opt};
+	}
+    }
+    # Remaining arguments are things to check
+    
+    return \&do_lint;
+}
+
+1;

contrib/perl5/ext/B/B/Showlex.pm

@@ -0,0 +1,80 @@
+package B::Showlex;
+use strict;
+use B qw(svref_2object comppadlist class);
+use B::Terse ();
+
+#
+# Invoke as
+#     perl -MO=Showlex,foo bar.pl
+# to see the names of lexical variables used by &foo
+# or as
+#     perl -MO=Showlex bar.pl
+# to see the names of file scope lexicals used by bar.pl
+#    
+
+sub showarray {
+    my ($name, $av) = @_;
+    my @els = $av->ARRAY;
+    my $count = @els;
+    my $i;
+    print "$name has $count entries\n";
+    for ($i = 0; $i < $count; $i++) {
+	print "$i: ";
+	$els[$i]->terse;
+    }
+}
+
+sub showlex {
+    my ($objname, $namesav, $valsav) = @_;
+    showarray("Pad of lexical names for $objname", $namesav);
+    showarray("Pad of lexical values for $objname", $valsav);
+}
+
+sub showlex_obj {
+    my ($objname, $obj) = @_;
+    $objname =~ s/^&main::/&/;
+    showlex($objname, svref_2object($obj)->PADLIST->ARRAY);
+}
+
+sub showlex_main {
+    showlex("comppadlist", comppadlist->ARRAY);
+}
+
+sub compile {
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "showlex_obj('&$objname', \\&$objname)";
+	    }
+	}
+    } else {
+	return \&showlex_main;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Showlex - Show lexical variables used in functions or files
+
+=head1 SYNOPSIS
+
+	perl -MO=Showlex[,SUBROUTINE] foo.pl
+
+=head1 DESCRIPTION
+
+When a subroutine name is provided in OPTIONS, prints the lexical
+variables used in that subroutine.  Otherwise, prints the file-scope
+lexicals in the file.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Stackobj.pm

@@ -0,0 +1,301 @@
+#      Stackobj.pm
+#
+#      Copyright (c) 1996 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::Stackobj;
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT
+		VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
+%EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
+		flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
+			     REGISTER TEMPORARY)]);
+
+use Carp qw(confess);
+use strict;
+use B qw(class);
+
+# Perl internal constants that I should probably define elsewhere.
+sub SVf_IOK () { 0x10000 }
+sub SVf_NOK () { 0x20000 }
+
+# Types
+sub T_UNKNOWN () { 0 }
+sub T_DOUBLE ()  { 1 }
+sub T_INT ()     { 2 }
+
+# Flags
+sub VALID_INT ()	{ 0x01 }
+sub VALID_DOUBLE ()	{ 0x02 }
+sub VALID_SV ()		{ 0x04 }
+sub REGISTER ()		{ 0x08 } # no implicit write-back when calling subs
+sub TEMPORARY ()	{ 0x10 } # no implicit write-back needed at all
+
+#
+# Callback for runtime code generation
+#
+my $runtime_callback = sub { confess "set_callback not yet called" };
+sub set_callback (&) { $runtime_callback = shift }
+sub runtime { &$runtime_callback(@_) }
+
+#
+# Methods
+#
+
+sub write_back { confess "stack object does not implement write_back" }
+
+sub invalidate { shift->{flags} &= ~(VALID_INT | VALID_DOUBLE) }
+
+sub as_sv {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_SV)) {
+	$obj->write_back;
+	$obj->{flags} |= VALID_SV;
+    }
+    return $obj->{sv};
+}
+
+sub as_int {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_INT)) {
+	$obj->load_int;
+	$obj->{flags} |= VALID_INT;
+    }
+    return $obj->{iv};
+}
+
+sub as_double {
+    my $obj = shift;
+    if (!($obj->{flags} & VALID_DOUBLE)) {
+	$obj->load_double;
+	$obj->{flags} |= VALID_DOUBLE;
+    }
+    return $obj->{nv};
+}
+
+sub as_numeric {
+    my $obj = shift;
+    return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
+}
+
+#
+# Debugging methods
+#
+sub peek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    my @flags;
+    if ($type == T_UNKNOWN) {
+	$type = "T_UNKNOWN";
+    } elsif ($type == T_INT) {
+	$type = "T_INT";
+    } elsif ($type == T_DOUBLE) {
+	$type = "T_DOUBLE";
+    } else {
+	$type = "(illegal type $type)";
+    }
+    push(@flags, "VALID_INT") if $flags & VALID_INT;
+    push(@flags, "VALID_DOUBLE") if $flags & VALID_DOUBLE;
+    push(@flags, "VALID_SV") if $flags & VALID_SV;
+    push(@flags, "REGISTER") if $flags & REGISTER;
+    push(@flags, "TEMPORARY") if $flags & TEMPORARY;
+    @flags = ("none") unless @flags;
+    return sprintf("%s type=$type flags=%s sv=$obj->{sv}",
+		   class($obj), join("|", @flags));
+}
+
+sub minipeek {
+    my $obj = shift;
+    my $type = $obj->{type};
+    my $flags = $obj->{flags};
+    if ($type == T_INT || $flags & VALID_INT) {
+	return $obj->{iv};
+    } elsif ($type == T_DOUBLE || $flags & VALID_DOUBLE) {
+	return $obj->{nv};
+    } else {
+	return $obj->{sv};
+    }
+}
+
+#
+# Caller needs to ensure that set_int, set_double,
+# set_numeric and set_sv are only invoked on legal lvalues.
+#
+sub set_int {
+    my ($obj, $expr) = @_;
+    runtime("$obj->{iv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
+    $obj->{flags} |= VALID_INT;
+}
+
+sub set_double {
+    my ($obj, $expr) = @_;
+    runtime("$obj->{nv} = $expr;");
+    $obj->{flags} &= ~(VALID_SV | VALID_INT);
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub set_numeric {
+    my ($obj, $expr) = @_;
+    if ($obj->{type} == T_INT) {
+	$obj->set_int($expr);
+    } else {
+	$obj->set_double($expr);
+    }
+}
+
+sub set_sv {
+    my ($obj, $expr) = @_;
+    runtime("SvSetSV($obj->{sv}, $expr);");
+    $obj->invalidate;
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Padsv
+#
+
+@B::Stackobj::Padsv::ISA = 'B::Stackobj';
+sub B::Stackobj::Padsv::new {
+    my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
+    bless {
+	type => $type,
+	flags => VALID_SV | $extra_flags,
+	sv => "PL_curpad[$ix]",
+	iv => "$iname",
+	nv => "$dname"
+    }, $class;
+}
+
+sub B::Stackobj::Padsv::load_int {
+    my $obj = shift;
+    if ($obj->{flags} & VALID_DOUBLE) {
+	runtime("$obj->{iv} = $obj->{nv};");
+    } else {
+	runtime("$obj->{iv} = SvIV($obj->{sv});");
+    }
+    $obj->{flags} |= VALID_INT;
+}
+
+sub B::Stackobj::Padsv::load_double {
+    my $obj = shift;
+    $obj->write_back;
+    runtime("$obj->{nv} = SvNV($obj->{sv});");
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub B::Stackobj::Padsv::write_back {
+    my $obj = shift;
+    my $flags = $obj->{flags};
+    return if $flags & VALID_SV;
+    if ($flags & VALID_INT) {
+	runtime("sv_setiv($obj->{sv}, $obj->{iv});");
+    } elsif ($flags & VALID_DOUBLE) {
+	runtime("sv_setnv($obj->{sv}, $obj->{nv});");
+    } else {
+	confess "write_back failed for lexical @{[$obj->peek]}\n";
+    }
+    $obj->{flags} |= VALID_SV;
+}
+
+#
+# Stackobj::Const
+#
+
+@B::Stackobj::Const::ISA = 'B::Stackobj';
+sub B::Stackobj::Const::new {
+    my ($class, $sv) = @_;
+    my $obj = bless {
+	flags => 0,
+	sv => $sv    # holds the SV object until write_back happens
+    }, $class;
+    my $svflags = $sv->FLAGS;
+    if ($svflags & SVf_IOK) {
+	$obj->{flags} = VALID_INT|VALID_DOUBLE;
+	$obj->{type} = T_INT;
+	$obj->{nv} = $obj->{iv} = $sv->IV;
+    } elsif ($svflags & SVf_NOK) {
+	$obj->{flags} = VALID_INT|VALID_DOUBLE;
+	$obj->{type} = T_DOUBLE;
+	$obj->{iv} = $obj->{nv} = $sv->NV;
+    } else {
+	$obj->{type} = T_UNKNOWN;
+    }
+    return $obj;
+}
+
+sub B::Stackobj::Const::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    # Save the SV object and replace $obj->{sv} by its C source code name
+    $obj->{sv} = $obj->{sv}->save;
+    $obj->{flags} |= VALID_SV|VALID_INT|VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::load_int {
+    my $obj = shift;
+    $obj->{iv} = int($obj->{sv}->PV);
+    $obj->{flags} |= VALID_INT;
+}
+
+sub B::Stackobj::Const::load_double {
+    my $obj = shift;
+    $obj->{nv} = $obj->{sv}->PV + 0.0;
+    $obj->{flags} |= VALID_DOUBLE;
+}
+
+sub B::Stackobj::Const::invalidate {}
+
+#
+# Stackobj::Bool
+#
+
+@B::Stackobj::Bool::ISA = 'B::Stackobj';
+sub B::Stackobj::Bool::new {
+    my ($class, $preg) = @_;
+    my $obj = bless {
+	type => T_INT,
+	flags => VALID_INT|VALID_DOUBLE,
+	iv => $$preg,
+	nv => $$preg,
+	preg => $preg		# this holds our ref to the pseudo-reg
+    }, $class;
+    return $obj;
+}
+
+sub B::Stackobj::Bool::write_back {
+    my $obj = shift;
+    return if $obj->{flags} & VALID_SV;
+    $obj->{sv} = "($obj->{iv} ? &PL_sv_yes : &PL_sv_no)";
+    $obj->{flags} |= VALID_SV;
+}
+
+# XXX Might want to handle as_double/set_double/load_double?
+
+sub B::Stackobj::Bool::invalidate {}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Stackobj - Helper module for CC backend
+
+=head1 SYNOPSIS
+
+	use B::Stackobj;
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Terse.pm

@@ -0,0 +1,152 @@
+package B::Terse;
+use strict;
+use B qw(peekop class walkoptree_slow walkoptree_exec
+	 main_start main_root cstring svref_2object);
+use B::Asmdata qw(@specialsv_name);
+
+sub terse {
+    my ($order, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    if ($order eq "exec") {
+	walkoptree_exec($cv->START, "terse");
+    } else {
+	walkoptree_slow($cv->ROOT, "terse");
+    }
+}
+
+sub compile {
+    my $order = shift;
+    my @options = @_;
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "terse(\$order, \\&$objname)";
+		die "terse($order, \\&$objname) failed: $@" if $@;
+	    }
+	}
+    } else {
+	if ($order eq "exec") {
+	    return sub { walkoptree_exec(main_start, "terse") }
+	} else {
+	    return sub { walkoptree_slow(main_root, "terse") }
+	}
+    }
+}
+
+sub indent {
+    my $level = shift;
+    return "    " x $level;
+}
+
+sub B::OP::terse {
+    my ($op, $level) = @_;
+    my $targ = $op->targ;
+    $targ = ($targ > 0) ? " [$targ]" : "";
+    print indent($level), peekop($op), $targ, "\n";
+}
+
+sub B::SVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ";
+    $op->sv->terse(0);
+}
+
+sub B::GVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), "  ";
+    $op->gv->terse(0);
+}
+
+sub B::PMOP::terse {
+    my ($op, $level) = @_;
+    my $precomp = $op->precomp;
+    print indent($level), peekop($op),
+	defined($precomp) ? " /$precomp/\n" : " (regexp not compiled)\n";
+
+}
+
+sub B::PVOP::terse {
+    my ($op, $level) = @_;
+    print indent($level), peekop($op), " ", cstring($op->pv), "\n";
+}
+
+sub B::COP::terse {
+    my ($op, $level) = @_;
+    my $label = $op->label;
+    if ($label) {
+	$label = " label ".cstring($label);
+    }
+    print indent($level), peekop($op), $label, "\n";
+}
+
+sub B::PV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, cstring($sv->PV);
+}
+
+sub B::AV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) FILL %d\n", class($sv), $$sv, $sv->FILL;
+}
+
+sub B::GV::terse {
+    my ($gv, $level) = @_;
+    my $stash = $gv->STASH->NAME;
+    if ($stash eq "main") {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    print indent($level);
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+}
+
+sub B::IV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
+}
+
+sub B::NV::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
+}
+
+sub B::NULL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx)\n", class($sv), $$sv;
+}
+    
+sub B::SPECIAL::terse {
+    my ($sv, $level) = @_;
+    print indent($level);
+    printf "%s #%d %s\n", class($sv), $$sv, $specialsv_name[$$sv];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+B::Terse - Walk Perl syntax tree, printing terse info about ops
+
+=head1 SYNOPSIS
+
+	perl -MO=Terse[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/B/Xref.pm

@@ -0,0 +1,392 @@
+package B::Xref;
+
+=head1 NAME
+
+B::Xref - Generates cross reference reports for Perl programs
+
+=head1 SYNOPSIS
+
+perl -MO=Xref[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Xref module is used to generate a cross reference listing of all
+definitions and uses of variables, subroutines and formats in a Perl program.
+It is implemented as a backend for the Perl compiler.
+
+The report generated is in the following format:
+
+    File filename1
+      Subroutine subname1
+	Package package1
+	  object1        C<line numbers>
+	  object2        C<line numbers>
+	  ...
+	Package package2
+	...
+
+Each B<File> section reports on a single file. Each B<Subroutine> section
+reports on a single subroutine apart from the special cases
+"(definitions)" and "(main)". These report, respectively, on subroutine
+definitions found by the initial symbol table walk and on the main part of
+the program or module external to all subroutines.
+
+The report is then grouped by the B<Package> of each variable,
+subroutine or format with the special case "(lexicals)" meaning
+lexical variables. Each B<object> name (implicitly qualified by its
+containing B<Package>) includes its type character(s) at the beginning
+where possible. Lexical variables are easier to track and even
+included dereferencing information where possible.
+
+The C<line numbers> are a comma separated list of line numbers (some
+preceded by code letters) where that object is used in some way.
+Simple uses aren't preceded by a code letter. Introductions (such as
+where a lexical is first defined with C<my>) are indicated with the
+letter "i". Subroutine and method calls are indicated by the character
+"&".  Subroutine definitions are indicated by "s" and format
+definitions by "f".
+
+=head1 OPTIONS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options.
+
+=over 8
+
+=item C<-oFILENAME>
+
+Directs output to C<FILENAME> instead of standard output.
+
+=item C<-r>
+
+Raw output. Instead of producing a human-readable report, outputs a line
+in machine-readable form for each definition/use of a variable/sub/format.
+
+=item C<-D[tO]>
+
+(Internal) debug options, probably only useful if C<-r> included.
+The C<t> option prints the object on the top of the stack as it's
+being tracked. The C<O> option prints each operator as it's being
+processed in the execution order of the program.
+
+=back
+
+=head1 BUGS
+
+Non-lexical variables are quite difficult to track through a program.
+Sometimes the type of a non-lexical variable's use is impossible to
+determine. Introductions of non-lexical non-scalars don't seem to be
+reported properly.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(peekop class comppadlist main_start svref_2object walksymtable);
+
+# Constants (should probably be elsewhere)
+sub OPpLVAL_INTRO () { 128 }
+sub SVf_POK () { 0x40000 }
+
+sub UNKNOWN { ["?", "?", "?"] }
+
+my @pad;			# lexicals in current pad
+				# as ["(lexical)", type, name]
+my %done;			# keyed by $$op: set when each $op is done
+my $top = UNKNOWN;		# shadows top element of stack as
+				# [pack, type, name] (pack can be "(lexical)")
+my $file;			# shadows current filename
+my $line;			# shadows current line number
+my $subname;			# shadows current sub name
+my %table;			# Multi-level hash to record all uses etc.
+my @todo = ();			# List of CVs that need processing
+
+my %code = (intro => "i", used => "",
+	    subdef => "s", subused => "&",
+	    formdef => "f", meth => "->");
+
+
+# Options
+my ($debug_op, $debug_top, $nodefs, $raw);
+
+sub process {
+    my ($var, $event) = @_;
+    my ($pack, $type, $name) = @$var;
+    if ($type eq "*") {
+	if ($event eq "used") {
+	    return;
+	} elsif ($event eq "subused") {
+	    $type = "&";
+	}
+    }
+    $type =~ s/(.)\*$/$1/g;
+    if ($raw) {
+	printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
+	    $file, $subname, $line, $pack, $type, $name, $event;
+    } else {
+	# Wheee
+	push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
+	    $line);
+    }
+}
+
+sub load_pad {
+    my $padlist = shift;
+    my ($namelistav, @namelist, $ix);
+    @pad = ();
+    return if class($padlist) eq "SPECIAL";
+    ($namelistav) = $padlist->ARRAY;
+    @namelist = $namelistav->ARRAY;
+    for ($ix = 1; $ix < @namelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	next if class($namesv) eq "SPECIAL";
+	my ($type, $name) = $namesv->PV =~ /^(.)(.*)$/;
+	$pad[$ix] = ["(lexical)", $type, $name];
+    }
+}
+
+sub xref {
+    my $start = shift;
+    my $op;
+    for ($op = $start; $$op; $op = $op->next) {
+	last if $done{$$op}++;
+	warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
+	warn peekop($op), "\n" if $debug_op;
+	my $ppname = $op->ppaddr;
+	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile)$/) {
+	    xref($op->other);
+	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} elsif ($ppname eq "pp_substcont") {
+	    xref($op->other->pmreplstart);
+	    $op = $op->other;
+	    redo;
+	} elsif ($ppname eq "pp_cond_expr") {
+	    # pp_cond_expr never returns op_next
+	    xref($op->true);
+	    $op = $op->false;
+	    redo;
+	} elsif ($ppname eq "pp_enterloop") {
+	    xref($op->redoop);
+	    xref($op->nextop);
+	    xref($op->lastop);
+	} elsif ($ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} else {
+	    no strict 'refs';
+	    &$ppname($op) if defined(&$ppname);
+	}
+    }
+}
+
+sub xref_cv {
+    my $cv = shift;
+    my $pack = $cv->GV->STASH->NAME;
+    $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
+    load_pad($cv->PADLIST);
+    xref($cv->START);
+    $subname = "(main)";
+}
+
+sub xref_object {
+    my $cvref = shift;
+    xref_cv(svref_2object($cvref));
+}
+
+sub xref_main {
+    $subname = "(main)";
+    load_pad(comppadlist);
+    xref(main_start);
+    while (@todo) {
+	xref_cv(shift @todo);
+    }
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $file = $op->filegv->SV->PV;
+    $line = $op->line;
+    $top = UNKNOWN;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    $top = $pad[$op->targ];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+sub deref {
+    my ($var, $as) = @_;
+    $var->[1] = $as . $var->[1];
+    process($var, "used");
+}
+
+sub pp_rv2cv { deref($top, "&"); }
+sub pp_rv2hv { deref($top, "%"); }
+sub pp_rv2sv { deref($top, "\$"); }
+sub pp_rv2av { deref($top, "\@"); }
+sub pp_rv2gv { deref($top, "*"); }
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, '$', $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_gv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    $top = ["?", "",
+	    (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+}
+
+sub pp_method {
+    my $op = shift;
+    $top = ["(method)", "->".$top->[1], $top->[2]];
+}
+
+sub pp_entersub {
+    my $op = shift;
+    if ($top->[1] eq "m") {
+	process($top, "meth");
+    } else {
+	process($top, "subused");
+    }
+    $top = UNKNOWN;
+}
+
+#
+# Stuff for cross referencing definitions of variables and subs
+#
+
+sub B::GV::xref {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv) {
+	#return if $done{$$cv}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
+	push(@todo, $cv);
+    }
+    my $form = $gv->FORM;
+    if ($$form) {
+	return if $done{$$form}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
+    }
+}
+
+sub xref_definitions {
+    my ($pack, %exclude);
+    return if $nodefs;
+    $subname = "(definitions)";
+    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
+		      strict vars FileHandle Exporter Carp)) {
+        $exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
+}
+
+sub output {
+    return if $raw;
+    my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
+	$perpack, $pername, $perev);
+    foreach $file (sort(keys(%table))) {
+	$perfile = $table{$file};
+	print "File $file\n";
+	foreach $subname (sort(keys(%$perfile))) {
+	    $persubname = $perfile->{$subname};
+	    print "  Subroutine $subname\n";
+	    foreach $pack (sort(keys(%$persubname))) {
+		$perpack = $persubname->{$pack};
+		print "    Package $pack\n";
+		foreach $name (sort(keys(%$perpack))) {
+		    $pername = $perpack->{$name};
+		    my @lines;
+		    foreach $ev (qw(intro formdef subdef meth subused used)) {
+			$perev = $pername->{$ev};
+			if (defined($perev) && @$perev) {
+			    my $code = $code{$ev};
+			    push(@lines, map("$code$_", @$perev));
+			}
+		    }
+		    printf "      %-16s  %s\n", $name, join(", ", @lines);
+		}
+	    }
+	}
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "d") {
+	    $nodefs = 1;
+	} elsif ($opt eq "r") {
+	    $raw = 1;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "t") {
+		    $debug_top = 1;
+		}
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    xref_definitions();
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "xref_object(\\&$objname)";
+		die "xref_object(\\&$objname) failed: $@" if $@;
+	    }
+	    output();
+	}
+    } else {
+	return sub {
+	    xref_definitions();
+	    xref_main();
+	    output();
+	}
+    }
+}
+
+1;

contrib/perl5/ext/B/B/assemble

@@ -0,0 +1,30 @@
+use B::Assembler qw(assemble_fh);
+use FileHandle;
+
+my ($filename, $fh, $out);
+
+if ($ARGV[0] eq "-d") {
+    B::Assembler::debug(1);
+    shift;
+}
+
+$out = \*STDOUT;
+
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+    $filename = "-";
+} elsif (@ARGV == 1) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+    $out = new FileHandle ">$ARGV[1]";
+} else {
+    die "Usage: assemble [filename] [outfilename]\n";
+}
+
+binmode $out;
+$SIG{__WARN__} = sub { warn "$filename:@_" };
+$SIG{__DIE__} = sub { die "$filename: @_" };
+assemble_fh($fh, sub { print $out @_ });

contrib/perl5/ext/B/B/cc_harness

@@ -0,0 +1,12 @@
+use Config;
+
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
+
+if (!grep(/^-[cS]$/, @ARGV)) {
+    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+			@Config{qw(ldflags libs)});
+}
+
+$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
+print "$cccmd\n";
+exec $cccmd;

contrib/perl5/ext/B/B/disassemble

@@ -0,0 +1,22 @@
+use B::Disassembler qw(disassemble_fh);
+use FileHandle;
+
+my $fh;
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+} elsif (@ARGV == 1) {
+    $fh = new FileHandle "<$ARGV[0]";
+} else {
+    die "Usage: disassemble [filename]\n";
+}
+
+sub print_insn {
+    my ($insn, $arg) = @_;
+    if (defined($arg)) {
+	printf "%s %s\n", $insn, $arg;
+    } else {
+	print $insn, "\n";
+    }
+}
+
+disassemble_fh($fh, \&print_insn);

contrib/perl5/ext/B/B/makeliblinks

@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+    warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+    exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+    my ($to, $from) = @_;
+    my $up;
+    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+	$from =~ s(
+		   [^/]+	(?# a group of non-slashes) 
+		   /*		(?# maybe with some trailing slashes)
+		   $		(?# at the end of the path)
+                  )()x;
+    }
+    return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+    if (/\.($dlext|$lib_ext)$/o) {
+	my $ext = $1;
+	my $name = $File::Find::name;
+	if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+	    die "directory of $name doesn't match $libautodir\n";
+	}
+	substr($name, 0, length($libautodir) + 1) = '';
+	my @parts = split(m(/), $name);
+	if ($parts[-1] ne "$parts[-2].$ext") {
+	    die "module name $_ doesn't match its directory $libautodir\n";
+	}
+	pop @parts;
+	my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+	print "$libpath -> $relprefix/$name\n";
+	symlink("$relprefix/$name", $libpath)
+	    or warn "above link failed with error: $!\n";
+    }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;

contrib/perl5/ext/B/Makefile.PL

@@ -0,0 +1,46 @@
+use ExtUtils::MakeMaker;
+use Config;
+
+my $e = $Config{'exe_ext'};
+my $o = $Config{'obj_ext'};
+my $exeout_flag = '-o ';
+if ($^O eq 'MSWin32') {
+    if ($Config{'cc'} =~ /^cl/i) {
+	$exeout_flag = '-Fe';
+    }
+    elsif ($Config{'cc'} =~ /^bcc/i) {
+	$exeout_flag = '-e';
+    }
+}
+
+WriteMakefile(
+    NAME	=> "B",
+    VERSION	=> "a5",
+    MAN3PODS => ' ',
+    clean	=> {
+	FILES		=> "perl$e byteperl$e *$o B.c *~"
+    }
+);
+
+sub MY::post_constants {
+    "\nLIBS = $Config{libs}\n"
+}
+
+# Leave out doing byteperl for now. Probably should be built in the
+# core directory or somewhere else rather than here
+#sub MY::top_targets {
+#    my $self = shift;
+#    my $targets = $self->MM::top_targets();
+#    $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
+#    return <<"EOT" . $targets;
+
+#
+# byteperl is *not* a standard perl+XSUB executable. It's a special
+# program for running standalone bytecode executables. It isn't an XSUB
+# at the moment because a standlone Perl program needs to set up curpad
+# which is overwritten on exit from an XSUB.
+#
+#byteperl$e : byteperl$o B$o \$(PERL_SRC)/byterun$o
+#	\$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS)
+#EOT
+#}

contrib/perl5/ext/B/NOTES

@@ -0,0 +1,168 @@
+C backend invocation
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	-v		Verbose (currently gives a few compilation statistics)
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed
+		c	COPs, prints COPs as processed (incl. file & line num)
+		A	prints AV information on saving
+		C	prints CV information on saving
+		M	prints MAGIC information on saving
+	-f		Force optimisations on or off one at a time.
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 and higher set -fcog.
+
+Examples
+	perl -MO=C foo.pl > foo.c
+	perl cc_harness -o foo foo.c
+
+	perl -MO=C,-v,-DcA bar.pl > /dev/null
+
+CC backend invocation
+	If there are any non-option arguments, they are taken to be names of
+	subs to be saved. Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-mModulename	Instead of generating source for a runnable executable,
+			generate source for an XSUB module. The
+			boot_Modulename function (which DynaLoader can look
+			for) does the appropriate initialisation and runs the
+			main part of the Perl source that is being compiled.
+	-pn		Generate code for perl patchlevel n (e.g. 3 or 4).
+			The default is to generate C code which will link
+			with the currently executing version of perl.
+			running the perl compiler.
+	-D		Debug options (concat or separate flags like perl -D)
+		r	Writes debugging output to STDERR just as it's about
+			to write to the program's runtime (otherwise writes
+			debugging info as comments in its C output).
+		O	Outputs each OP as it's compiled
+		s	Outputs the contents of the shadow stack at each OP
+		p	Outputs the contents of the shadow pad of lexicals as
+			it's loaded for each sub or the main program.
+		q	Outputs the name of each fake PP function in the queue
+			as it's about to processes.
+		l	Output the filename and line number of each original
+			line of Perl code as it's processed (pp_nextstate).
+		t	Outputs timing information of compilation stages
+	-f		Force optimisations on or off one at a time.
+		[
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+		These two not in CC yet.
+		]
+		freetmps-each-bblock	Delays FREETMPS from the end of each
+					statement to the end of the each basic
+					block.
+		freetmps-each-loop	Delays FREETMPS from the end of each
+					statement to the end of the group of
+					basic blocks forming a loop. At most
+					one of the freetmps-each-* options can
+					be used.
+		omit-taint		Omits generating code for handling
+					perl's tainting mechanism.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 sets -ffreetmps-each-bblock and -O2
+			sets -ffreetmps-each-loop.
+
+Example
+	perl -MO=CC,-O2,-ofoo.c foo.pl
+	perl cc_harness -o foo foo.c
+
+	perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+	perl cc_harness -shared -c -o Foo.so Foo.c
+
+
+Bytecode backend invocation
+
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT.
+	--		Force end of options.
+	-f		Force optimisations on or off one at a time.
+			Each can be preceded by no- to turn the option off.
+		compress-nullops
+			Only fills in the necessary fields of ops which have
+			been optimised away by perl's internal compiler.
+		omit-sequence-numbers
+			Leaves out code to fill in the op_seq field of all ops
+			which is only used by perl's internal compiler.
+		bypass-nullops
+			If op->op_next ever points to a NULLOP, replaces the
+			op_next field with the first non-NULLOP in the path
+			of execution.
+		strip-syntax-tree
+			Leaves out code to fill in the pointers which link the
+			internal syntax tree together. They're not needed at
+			run-time but leaving them out will make it impossible
+			to recompile or disassemble the resulting program.
+			It will also stop "goto label" statements from working.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			-O1 sets -fcompress-nullops -fomit-sequence numbers.
+			-O6 adds -fstrip-syntax-tree.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed.
+		b	print debugging information about bytecompiler progress
+		a	tells the assembler to include source assembler lines
+			in its output as bytecode comments.
+		C	prints each CV taken from the final symbol tree walk.
+	-S		Output assembler source rather than piping it
+			through the assembler and outputting bytecode.
+	-m		Compile as a module rather than a standalone program.
+			Currently this just means that the bytecodes for
+			initialising main_start, main_root and curpad are
+			omitted.
+
+Example
+	perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+	perl -MO=Bytecode,-S foo.pl > foo.S
+	assemble foo.S > foo.plc
+	byteperl foo.plc
+
+	perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+
+Backends for debugging
+	perl -MO=Terse,exec foo.pl
+	perl -MO=Debug bar.pl
+
+O module
+	Used with "perl -MO=Backend,foo,bar prog.pl" to invoke the backend
+	B::Backend with options foo and bar. O invokes the sub
+	B::Backend::compile() with arguments foo and bar at BEGIN time.
+	That compile() sub must do any inital argument processing replied.
+	If unsuccessful, it should return a string which O arranges to be
+	printed as an error message followed by a clean error exit. In the
+	normal case where any option processing in compile() is successful,
+	it should return a sub ref (usually a closure) to perform the
+	actual compilation. When O regains control, it ensures that the
+	"-c" option is forced (so that the program being compiled doesn't
+	end up running) and registers an END block to call back the sub ref
+	returned from the backend's compile(). Perl then continues by
+	parsing prog.pl (just as it would with "perl -c prog.pl") and after
+	doing so, assuming there are no parse-time errors, the END block
+	of O gets called and the actual backend compilation happens. Phew.

contrib/perl5/ext/B/O.pm

@@ -0,0 +1,85 @@
+package O;
+use B qw(minus_c);
+use Carp;    
+
+sub import {
+    my ($class, $backend, @options) = @_;
+    eval "use B::$backend ()";
+    if ($@) {
+	croak "use of backend $backend failed: $@";
+    }
+    my $compilesub = &{"B::${backend}::compile"}(@options);
+    if (ref($compilesub) eq "CODE") {
+	minus_c;
+	eval 'END { &$compilesub() }';
+    } else {
+	die $compilesub;
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+O - Generic interface to Perl Compiler backends
+
+=head1 SYNOPSIS
+
+	perl -MO=Backend[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+This is the module that is used as a frontend to the Perl Compiler.
+
+=head1 CONVENTIONS
+
+Most compiler backends use the following conventions: OPTIONS
+consists of a comma-separated list of words (no white-space).
+The C<-v> option usually puts the backend into verbose mode.
+The C<-ofile> option generates output to B<file> instead of
+stdout. The C<-D> option followed by various letters turns on
+various internal debugging flags. See the documentation for the
+desired backend (named C<B::Backend> for the example above) to
+find out about that backend.
+
+=head1 IMPLEMENTATION
+
+This section is only necessary for those who want to write a
+compiler backend module that can be used via this module.
+
+The command-line mentioned in the SYNOPSIS section corresponds to
+the Perl code
+
+    use O ("Backend", OPTIONS);
+
+The C<import> function which that calls loads in the appropriate
+C<B::Backend> module and calls the C<compile> function in that
+package, passing it OPTIONS. That function is expected to return
+a sub reference which we'll call CALLBACK. Next, the "compile-only"
+flag is switched on (equivalent to the command-line option C<-c>)
+and an END block is registered which calls CALLBACK. Thus the main
+Perl program mentioned on the command-line is read in, parsed and
+compiled into internal syntax tree form. Since the C<-c> flag is
+set, the program does not start running (excepting BEGIN blocks of
+course) but the CALLBACK function registered by the compiler
+backend is called.
+
+In summary, a compiler backend module should be called "B::Foo"
+for some foo and live in the appropriate directory for that name.
+It should define a function called C<compile>. When the user types
+
+    perl -MO=Foo,OPTIONS foo.pl
+
+that function is called and is passed those OPTIONS (split on
+commas). It should return a sub ref to the main compilation function.
+After the user's program is loaded and parsed, that returned sub ref
+is invoked which can then go ahead and do the compilation, usually by
+making use of the C<B> module's functionality.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut

contrib/perl5/ext/B/README

@@ -0,0 +1,325 @@
+		  Perl Compiler Kit, Version alpha4
+
+		 Copyright (c) 1996, 1997, Malcolm Beattie
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of either:
+
+	a) the GNU General Public License as published by the Free
+	Software Foundation; either version 1, or (at your option) any
+	later version, or
+
+	b) the "Artistic License" which comes with this kit.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this kit,
+    in the file named "Artistic".  If not, you can get one from the Perl
+    distribution. You should also have received a copy of the GNU General
+    Public License, in the file named "Copying". If not, you can get one
+    from the Perl distribution or else write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+CHANGES
+
+New since alpha3
+    Anonymous subs work properly with C and CC.
+    Heuristics for forcing compilation of apparently unused subs/methods.
+    Subs which use the AutoLoader module are forcibly loaded at compile-time.
+    Slightly faster compilation.
+    Handles slightly more complex code within a BEGIN { }.
+    Minor bug fixes.
+
+New since alpha2
+    CC backend now supports ".." and s//e.
+    Xref backend generates cross-reference reports
+    Cleanups to fix benign but irritating "-w" warnings
+    Minor cxstack fix
+New since alpha1
+    Working CC backend
+    Shared globs and pre-initialised hash support
+    Some XSUB support
+    Assorted bug fixes
+
+INSTALLATION
+
+(1) You need perl5.002 or later.
+
+(2) If you want to compile and run programs with the C or CC backends
+which undefine (or redefine) subroutines, then you need to apply a
+one-line patch to perl itself. One or two of the programs in perl's
+own test suite do this. The patch is in file op.patch. It prevents
+perl from calling free() on OPs with the magic sequence number (U16)-1.
+The compiler declares all OPs as static structures and uses that magic
+sequence number.
+
+(3) Type
+    perl Makefile.PL
+to write a personalised Makefile for your system. If you want the
+bytecode modules to support reading bytecode from strings (instead of
+just from files) then add the option
+    -DINDIRECT_BGET_MACROS
+into the middle of the definition of the CCCMD macro in the Makefile.
+Your C compiler may need to be able to cope with Standard C for this.
+I haven't tested this option yet with an old pre-Standard compiler.
+
+(4) If your platform supports dynamic loading then just type
+    make
+and you can then use
+    perl -Iblib/arch -MO=foo bar
+to use the compiler modules (see later for details).
+If you need/want instead to make a statically linked perl which
+contains the appropriate modules, then type
+    make perl
+    make byteperl
+and you can then use
+    ./perl -MO=foo bar
+to use the compiler modules.    
+In both cases, the byteperl executable is required for running standalone
+bytecode programs. It is *not* a standard perl+XSUB perl executable.
+
+USAGE
+
+As of the alpha3 release, the Bytecode, C and CC backends are now all
+functional enough to compile almost the whole of the main perl test
+suite. In the case of the CC backend, any failures are all due to
+differences and/or known bugs documented below. See the file TESTS.
+In the following examples, you'll need to replace "perl" by
+    perl -Iblib/arch
+if you have built the extensions for a dynamic loading platform but
+haven't installed the extensions completely. You'll need to replace
+"perl" by
+    ./perl
+if you have built the extensions into a statically linked perl binary.
+
+(1) To compile perl program foo.pl with the C backend, do
+    perl -MO=C,-ofoo.c foo.pl
+Then use the cc_harness perl program to compile the resulting C source:
+    perl cc_harness -O2 -o foo foo.c
+
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+pre-declaring static arrays, then add -DBROKEN_STATIC_REDECL to the
+options you use:
+    perl cc_harness -O2 -o foo -DBROKEN_STATIC_REDECL foo.c
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+static initialisation of structures with union members then add
+-DBROKEN_UNION_INIT to the options you use. If you want command line
+arguments passed to your executable to be interpreted by perl (e.g. -Dx)
+then compile foo.c with -DALLOW_PERL_OPTIONS. Otherwise, all command line
+arguments passed to foo will appear directly in @ARGV.  The resulting
+executable foo is the compiled version of foo.pl. See the file NOTES for
+extra options you can pass to -MO=C.
+
+There are some constraints on the contents on foo.pl if you want to be
+able to compile it successfully. Some problems can be fixed fairly easily
+by altering foo.pl; some problems with the compiler are known to be
+straightforward to solve and I'll do so soon. The file Todo lists a
+number of known problems. See the XSUB section lower down for information
+about compiling programs which use XSUBs.
+
+(2) To compile foo.pl with the CC backend (which generates actual
+optimised C code for the execution path of your perl program), use
+    perl -MO=CC,-ofoo.c foo.pl
+
+and proceed just as with the C backend. You should almost certainly
+use an option such as -O2 with the subsequent cc_harness invocation
+so that your C compiler uses optimisation. The C code generated by
+the Perl compiler's CC backend looks ugly to humans but is easily
+optimised by C compilers.
+
+To make the most of this compiler backend, you need to tell the
+compiler when you're using int or double variables so that it can
+optimise appropriately (although this part of the compiler is the most
+buggy). You currently do that by naming lexical variables ending in
+"_i" for ints, "_d" for doubles, "_ir" for int "register" variables or
+"_dr" for double "register" variables. Here "register" is a promise
+that you won't pass a reference to the variable into a sub which then
+modifies the variable. The compiler ought to catch attempts to use
+"\$i" just as C compilers catch attempts to do "&i" for a register int
+i but it doesn't at the moment. Bugs in the CC backend may make your
+program fail in mysterious ways and give wrong answers rather than just
+crash in boring ways. But, hey, this is an alpha release so you knew
+that anyway. See the XSUB section lower down for information about
+compiling programs which use XSUBs.
+
+If your program uses classes which define methods (or other subs which
+are not exported and not apparently used until runtime) then you'll
+need to use -u compile-time options (see the NOTES file) to force the
+subs to be compiled. Future releases will probably default the other
+way, do more auto-detection and provide more fine-grained control.
+
+Since compiled executables need linking with libperl, you may want
+to turn libperl.a into a shared library if your platform supports
+it. For example, with Digital UNIX, do something like
+    ld -shared -o libperl.so -all libperl.a -none -lc
+and with Linux/ELF, rebuild the perl .c files with -fPIC (and I
+also suggest -fomit-frame-pointer for Linux on Intel architetcures),
+do "make libperl.a" and then do
+    gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a`
+and then
+    # cp libperl.so.5.3 /usr/lib
+    # cd /usr/lib
+    # ln -s libperl.so.5.3 libperl.so.5
+    # ln -s libperl.so.5 libperl.so
+    # ldconfig
+When you compile perl executables with cc_harness, append -L/usr/lib
+otherwise the -L for the perl source directory will override it. For
+example,
+    perl -Iblib/arch -MO=CC,-O2,-ofoo3.c foo3.bench
+    perl cc_harness -o foo3 -O2 foo3.c -L/usr/lib
+    ls -l foo3
+    -rwxr-xr-x   1 mbeattie xzdg        11218 Jul  1 15:28 foo3
+You'll probably also want to link your main perl executable against
+libperl.so; it's nice having an 11K perl executable.
+
+(3) To compile foo.pl into bytecode do
+    perl -MO=Bytecode,-ofoo foo.pl
+To run the resulting bytecode file foo as a standalone program, you
+use the program byteperl which should have been built along with the
+extensions.
+    ./byteperl foo
+Any extra arguments are passed in as @ARGV; they are not interpreted
+as perl options. If you want to load chunks of bytecode into an already
+running perl program then use the -m option and investigate the
+byteload_fh and byteload_string functions exported by the B module.
+See the NOTES file for details of these and other options (including
+optimisation options and ways of getting at the intermediate "assembler"
+code that the Bytecode backend uses).
+
+(3) There are little Bourne shell scripts and perl programs to aid with
+some common operations: assemble, disassemble, run_bytecode_test,
+run_test, cc_harness, test_harness, test_harness_bytecode.
+
+(4) Walk the op tree in execution order printing terse info about each op
+    perl -MO=Terse,exec foo.pl
+
+(5) Walk the op tree in syntax order printing lengthier debug info about
+each op. You can also append ",exec" to walk in execution order, but the
+formatting is designed to look nice with Terse rather than Debug.
+    perl -MO=Debug foo.pl
+
+(6) Produce a cross-reference report of the line numbers at which all
+variables, subs and formats are defined and used.
+    perl -MO=Xref foo.pl
+
+XSUBS
+
+The C and CC backends can successfully compile some perl programs which
+make use of XSUB extensions. [I'll add more detail to this section in a
+later release.] As a prerequisite, such extensions must not need to do
+anything in their BOOT: section which needs to be done at runtime rather
+than compile time. Normally, the only code in the boot_Foo() function is
+a list of newXS() calls which xsubpp puts there and the compiler handles
+saving those XS subs itself. For each XSUB used, the C and CC compiler
+will generate an initialiser in their C output which refers to the name
+of the relevant C function (XS_Foo_somesub). What is not yet automated
+is the necessary commands and cc command-line options (e.g. via
+"perl cc_harness") which link against the extension libraries. For now,
+you need the XSUB extension to have installed files in the right format
+for using as C libraries (e.g. Foo.a or Foo.so). As the Foo.so files (or
+your platform's version) aren't suitable for linking against, you will
+have to reget the extension source and rebuild it as a static extension
+to force the generation of a suitable Foo.a file. Then you need to make
+a symlink (or copy or rename) of that file into a libFoo.a suitable for
+cc linking. Then add the appropriate -L and -l options to your
+"perl cc_harness" command line to find and link against those libraries.
+You may also need to fix up some platform-dependent environment variable
+to ensure that linked-against .so files are found at runtime too.
+
+DIFFERENCES
+
+The result of running a compiled Perl program can sometimes be different
+from running the same program with standard perl. Think of the compiler
+as having a slightly different implementation of the language Perl.
+Unfortunately, since Perl has had a single implementation until now,
+there are no formal standards or documents defining what behaviour is
+guaranteed of Perl the language and what just "happens to work".
+Some of the differences below are almost impossible to change because of
+the way the compiler works. Others can be changed to produce "standard"
+perl behaviour if it's deemed proper and the resulting performance hit
+is accepted. I'll use "standard perl" to mean the result of running a
+Perl program using the perl executable from the perl distribution.
+I'll use "compiled Perl program" to mean running an executable produced
+by this compiler kit ("the compiler") with the CC backend.
+
+Loops
+    Standard perl calculates the target of "next", "last", and "redo"
+    at run-time. The compiler calculates the targets at compile-time.
+    For example, the program
+
+        sub skip_on_odd { next NUMBER if $_[0] % 2 }
+        NUMBER: for ($i = 0; $i < 5; $i++) {
+            skip_on_odd($i);
+            print $i;
+        }
+
+    produces the output
+        024
+    with standard perl but gives a compile-time error with the compiler.
+
+Context of ".."
+    The context (scalar or array) of the ".." operator determines whether
+    it behaves as a range or a flip/flop. Standard perl delays until
+    runtime the decision of which context it is in but the compiler needs
+    to know the context at compile-time. For example,
+	@a = (4,6,1,0,0,1);
+	sub range { (shift @a)..(shift @a) }
+	print range();
+	while (@a) { print scalar(range()) }
+    generates the output
+        456123E0
+    with standard Perl but gives a compile-time error with compiled Perl.
+
+Arithmetic
+    Compiled Perl programs use native C arithemtic much more frequently
+    than standard perl. Operations on large numbers or on boundary
+    cases may produce different behaviour.
+
+Deprecated features
+    Features of standard perl such as $[ which have been deprecated
+    in standard perl since version 5 was released have not been
+    implemented in the compiler.
+
+Others
+    I'll add to this list as I remember what they are.
+
+BUGS
+
+Here are some things which may cause the compiler problems.
+
+The following render the compiler useless (without serious hacking):
+* Use of the DATA filehandle (via __END__ or __DATA__ tokens)
+* Operator overloading with %OVERLOAD
+* The (deprecated) magic array-offset variable $[ does not work
+* The following operators are not yet implemented for CC
+    goto
+    sort with a non-default comparison (i.e. a named sub or inline block)
+* You can't use "last" to exit from a non-loop block.
+
+The following may give significant problems:
+* BEGIN blocks containing complex initialisation code
+* Code which is only ever referred to at runtime (e.g. via eval "..." or
+  via method calls): see the -u option for the C and CC backends.
+* Run-time lookups of lexical variables in "outside" closures
+
+The following may cause problems (not thoroughly tested):
+* Dependencies on whether values of some "magic" Perl variables are
+  determined at compile-time or runtime.
+* For the C and CC backends: compile-time strings which are longer than
+  your C compiler can cope with in a single line or definition.
+* Reliance on intimate details of global destruction
+* For the Bytecode backend: high -On optimisation numbers with code
+  that has complex flow of control.
+* Any "-w" option in the first line of your perl program is seen and
+  acted on by perl itself before the compiler starts. The compiler
+  itself then runs with warnings turned on. This may cause perl to
+  print out warnings about the compiler itself since I haven't tested
+  it thoroughly with warnings turned on.
+
+There is a terser but more complete list in the Todo file.
+
+Malcolm Beattie
+2 September 1996

contrib/perl5/ext/B/TESTS

@@ -0,0 +1,78 @@
+Test results from compiling t/*/*.t
+		C		Bytecode	CC
+
+base/cond.t	OK		ok		OK
+base/if.t	OK		ok		OK
+base/lex.t	OK		ok		OK
+base/pat.t	OK		ok		OK
+base/term.t	OK		ok		OK
+cmd/elsif.t	OK		ok		OK
+cmd/for.t	OK		ok		ok 1, 2, 3, panic: pp_iter
+cmd/mod.t	OK		ok		ok
+cmd/subval.t	OK		ok		1..34, not ok 27,28 (simply
+						because filename changes).
+cmd/switch.t	OK		ok		ok
+cmd/while.t	OK		ok		ok
+io/argv.t	OK		ok		ok
+io/dup.t	OK		ok		ok
+io/fs.t		OK		ok		ok
+io/inplace.t	OK		ok		ok
+io/pipe.t	OK		ok		ok with -umain
+io/print.t	OK		ok		ok
+io/tell.t	OK		ok		ok
+op/append.t	OK		ok		OK
+op/array.t	OK		ok		1..36, not ok 7,10 (no $[)
+op/auto.t	OK		ok		OK
+op/chop.t	OK		ok		OK
+op/cond.t	OK		ok		OK
+op/delete.t	OK		ok		OK
+op/do.t		OK		ok		OK
+op/each.t	OK		ok		OK
+op/eval.t	OK		ok		ok 1-6 of 16 then exits
+op/exec.t	OK		ok		OK
+op/exp.t	OK		ok		OK
+op/flip.t	OK		ok		OK
+op/fork.t	OK		ok		OK
+op/glob.t	OK		ok		OK
+op/goto.t	OK		ok		1..9, Can't find label label1.
+op/groups.t	OK (s/ucb/bin/ under Linux)	OK 1..0 for now.
+op/index.t	OK		ok		OK
+op/int.t	OK		ok		OK
+op/join.t	OK		ok		OK
+op/list.t	OK		ok		OK
+op/local.t	OK		ok		OK
+op/magic.t	OK		ok		OK
+op/misc.t	no DATA filehandle so succeeds trivially with 1..0
+op/mkdir.t	OK		ok		OK
+op/my.t		OK		ok		OK
+op/oct.t	OK		ok		OK (C large const warnings)
+op/ord.t	OK		ok		OK
+op/overload.t	Mostly not ok	Mostly not ok	C errors.
+op/pack.t	OK		ok		OK
+op/pat.t	omit 26 (reset)	ok		[lots of memory for compile]
+op/push.t	OK		ok		OK
+op/quotemeta.t	OK		ok		OK
+op/rand.t	OK		ok		
+op/range.t	OK		ok		OK
+op/read.t	OK		ok		OK
+op/readdir.t	OK		ok		OK (substcont works too)
+op/ref.t	omits "ok 40" (lex destruction)	ok (Bytecode)
+						CC: need -u for OBJ,BASEOBJ,
+						UNIVERSAL,WHATEVER,main.
+						1..41, ok1-33,36-38,
+						then ok 41, ok 39.DESTROY probs
+op/regexp.t	OK		ok		ok (trivially all eval'd)
+op/repeat.t	OK		ok		ok
+op/sleep.t	OK		ok		ok
+op/sort.t	OK		ok		1..10, ok 1, Out of memory!
+op/split.t	OK		ok		ok
+op/sprintf.t	OK		ok		ok
+op/stat.t	OK		ok		ok
+op/study.t	OK		ok		ok
+op/subst.t	OK		ok		ok
+op/substr.t	OK		ok		ok1-22 except 7-9,11 (all $[)
+op/time.t	OK		ok		ok
+op/undef.t	omit 21		ok		ok
+op/unshift.t	OK		ok		ok
+op/vec.t	OK		ok		ok
+op/write.t	not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang

contrib/perl5/ext/B/Todo

@@ -0,0 +1,37 @@
+* Fixes
+
+CC backend: goto, sort with non-default comparison. last for non-loop blocks.
+Version checking
+improve XSUB handling (both static and dynamic)
+sv_magic can do SvREFCNT_inc(obj) which messes up precalculated refcounts
+allocation of XPV[INAHC]V structures needs fixing: Perl tries to free
+them whereas the compiler expects them to be linked to a xpv[inahc]v_root
+list the same as X[IPR]V structures.
+ref counts
+perl_parse replacement
+fix cstring for long strings
+compile-time initialisation of AvARRAYs
+signed/unsigned problems with NV (and IV?) initialisation and elsewhere?
+CvOUTSIDE for ordinary subs
+DATA filehandle for standalone Bytecode program (easy)
+DATA filehandle for multiple bytecode-compiled modules (harder)
+DATA filehandle for C-compiled program (yet harder)
+
+* Features
+
+type checking
+compile time v. runtime initialisation
+save PMOPs in compiled form
+selection of what to dump
+options for cutting out line info etc.
+comment output
+shared constants
+module dependencies
+
+* Optimisations
+collapse LISTOPs to UNOPs or BASEOPs
+compile-time qw(), constant subs
+global analysis of variables, type hints etc.
+demand-loaded bytecode (leader of each basic block replaced by an op
+which loads in bytecode for its block)
+fast sub calls for CC backend

contrib/perl5/ext/B/byteperl.c

@@ -0,0 +1,110 @@
+#include "EXTERN.h"
+#include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+
+int
+#ifndef CAN_PROTOTYPE
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#else  /* def(CAN_PROTOTYPE) */
+main(int argc, char **argv, char **env)
+#endif  /* def(CAN_PROTOTYPE) */
+{
+    int exitstatus;
+    int i;
+    char **fakeargv;
+    FILE *fp;
+#ifdef INDIRECT_BGET_MACROS
+    struct bytestream bs;
+#endif /* INDIRECT_BGET_MACROS */
+
+    INIT_SPECIALSV_LIST;
+    PERL_SYS_INIT(&argc,&argv);
+ 
+#if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1)
+    perl_init_i18nl10n(1);
+#else
+    perl_init_i18nl14n(1);
+#endif
+
+    if (!PL_do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+#ifdef VMS
+	    exit(vaxc$errno);
+#else
+	    exit(1);
+#endif
+	perl_construct( my_perl );
+    }
+
+#ifdef CSH
+    if (!PL_cshlen) 
+      PL_cshlen = strlen(PL_cshname);
+#endif
+
+    if (argc < 2)
+	fp = stdin;
+    else {
+#ifdef WIN32
+	fp = fopen(argv[1], "rb");
+#else
+	fp = fopen(argv[1], "r");
+#endif
+	if (!fp) {
+	    perror(argv[1]);
+#ifdef VMS
+	    exit(vaxc$errno);
+#else
+	    exit(1);
+#endif
+	}
+	argv++;
+	argc--;
+    }
+    New(666, fakeargv, argc + 4, char *);
+    fakeargv[0] = argv[0];
+    fakeargv[1] = "-e";
+    fakeargv[2] = "";
+    fakeargv[3] = "--";
+    for (i = 1; i < argc; i++)
+	fakeargv[i + 3] = argv[i];
+    fakeargv[argc + 3] = 0;
+    
+    exitstatus = perl_parse(my_perl, xs_init, argc + 3, fakeargv, NULL);
+    if (exitstatus)
+	exit( exitstatus );
+
+    sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
+    PL_main_cv = PL_compcv;
+    PL_compcv = 0;
+
+#ifdef INDIRECT_BGET_MACROS
+    bs.data = fp;
+    bs.fgetc = (int(*) _((void*)))fgetc;
+    bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
+    bs.freadpv = freadpv;
+    byterun(bs);
+#else    
+    byterun(fp);
+#endif /* INDIRECT_BGET_MACROS */
+    
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    exit( exitstatus );
+}
+
+static void
+xs_init()
+{
+}

contrib/perl5/ext/B/ramblings/cc.notes

@@ -0,0 +1,32 @@
+At entry to each basic block, the following can be assumed (and hence
+must be forced where necessary at the end of each basic block):
+
+The shadow stack @stack is empty.
+For each lexical object in @pad, VALID_IV holds for each T_INT,
+VALID_DOUBLE holds for each T_DOUBLE and VALID_SV holds otherwise.
+The C shadow variable sp holds the stack pointer (not necessarily stack_sp).
+
+write_back_stack
+    Writes the contents of the shadow stack @stack back to the real stack.
+    A write-back of each object in the stack is forced so that its
+    backing SV contains the right value and that SV is then pushed onto the
+    real stack. On return, @stack is empty.
+
+write_back_lexicals
+    Forces a write-back (i.e. achieves VALID_SV), where necessary, for each
+    lexical object in @pad. Objects with the TEMPORARY flag are skipped. If
+    write_back_lexicals is called with an (optional) argument, then it is
+    taken to be a bitmask of more flags: any lexical object with one of those
+    flags set is also skipped and not written back to its SV.
+
+invalidate_lexicals($avoid)
+    The VALID_INT and VALID_DOUBLE flags are turned off for each lexical
+    object in @pad whose flags field doesn't overlap with $avoid.
+
+reload_lexicals
+    For each necessary lexical object in @pad, makes sure that VALID_IV
+    holds for objects of type T_INT, VALID_DOUBLE holds for objects for
+    type T_DOUBLE, and VALID_SV holds for other objects. An object is
+    considered for reloading if its flags field does not overlap with the
+    (optional) argument passed to reload_lexicals.
+

contrib/perl5/ext/B/ramblings/curcop.runtime

@@ -0,0 +1,39 @@
+PP code uses of curcop
+----------------------
+
+pp_rv2gv
+	when a new glob is created for an OPpLVAL_INTRO,
+	curcop->cop_line is stored as GvLINE() in the new GP.
+pp_bless
+	curcop->cop_stash is used as the stash in the one-arg form of bless
+
+pp_repeat
+	tests (curcop != &compiling) to warn "Can't x= to readonly value"
+
+pp_pos
+pp_substr
+pp_index
+pp_rindex
+pp_aslice
+pp_lslice
+pp_splice
+	curcop->cop_arybase
+
+pp_sort
+	curcop->cop_stash used to determine whether to gv_fetchpv $a and $b
+
+pp_caller
+	tests (curcop->cop_stash == debstash) to determine whether
+	to set DB::args
+
+pp_reset
+	resets vars in curcop->cop_stash
+
+pp_dbstate
+	sets curcop = (COP*)op
+
+doeval
+	compiles into curcop->cop_stash
+
+pp_nextstate
+	sets curcop = (COP*)op

contrib/perl5/ext/B/ramblings/flip-flop

@@ -0,0 +1,51 @@
+PP(pp_range)
+{
+    if (GIMME == G_ARRAY)
+        return cCONDOP->op_true;
+    return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
+}
+
+pp_range is a CONDOP.
+In array context, it just returns op_true.
+In scalar context it checks the truth of targ and returns
+op_false if true, op_true if false.
+
+flip is an UNOP.
+It "looks after" its child which is always a pp_range CONDOP.
+In array context, it just returns the child's op_false.
+In scalar context, there are three possible outcomes:
+  (1) set child's targ to 1, our targ to 1 and return op_next.
+  (2) set child's targ to 1, our targ to 0, sp-- and return child's op_false.
+  (3) Blank targ and  TOPs and return op_next.
+Case 1 happens for a "..." with a matching lineno... or true TOPs.
+Case 2 happens for a ".." with a matching lineno... or true TOPs.
+Case 3 happens for a non-matching lineno or false TOPs.
+
+               $a = lhs..rhs;
+
+        ,------->  range
+        ^         /     \
+        |    true/       \false
+        |       /         \
+   first|     lhs        rhs
+        |      \   first   /
+        ^--- flip <----- flop
+                 \       /
+                  \     /
+                  sassign
+
+
+/* range */
+if (SvTRUE(curpad[op->op_targ]))
+    goto label(op_false);
+/* op_true */
+...
+/* flip */
+/* For "..." returns op_next. For ".." returns op_next or op_first->op_false */
+/* end of basic block */
+goto out;
+label(range op_false):
+...
+/* flop */
+out:
+...

contrib/perl5/ext/B/ramblings/magic

@@ -0,0 +1,93 @@
+sv_magic()
+----------
+av.c
+av_store()
+	Storing a non-undef element into an SMAGICAL array, av,
+	assigns the equivalent lowercase form of magic (of the first
+	MAGIC in the chain) to the value (with obj = av, name = 0 and
+	namlen = array index).
+
+gv.c
+gv_init()
+	Initialising gv assigns '*' magic to it with obj = gv, name =
+	GvNAME and namlen = GvNAMELEN.
+gv_fetchpv()
+	@ISA gets 'I' magic with obj = gv, zero name and namlen.
+	%OVERLOAD gets 'A' magic with obj = gv, zero name and namlen.
+	$1 to $9, $&, $`, $', $+ get '\0' magic with obj = gv,
+	name = GvNAME and namlen = len ( = 1 presumably).
+Gv_AMupdate()
+	Stashes for overload magic seem to get 'c' magic with obj = 0,
+	name = &amt and namlen = sizeof(amt).
+hv_magic(hv, gv, how)
+	Gives magic how to hv with obj = gv and zero name and namlen.
+
+mg.c
+mg_copy(sv, nsv, key, klen)
+	Traverses the magic chain of sv. Upper case forms of magic
+	(only) are copied across to nsv, preserving obj but using
+	name = key and namlen = klen.
+magic_setpos()
+	LvTARG of a PVLV gets 'g' magic with obj = name = 0 and namlen = pos.
+
+op.c
+mod()
+	PVLV operators give magic to their targs with
+	obj = name = namlen = 0. OP_POS gives '.', OP_VEC gives 'v'
+	and OP_SUBSTR gives 'x'.
+
+perl.c
+magicname(sym, name, namlen)
+	Fetches/creates a GV with name sym and gives it '\0' magic
+	with obj = gv, name and namlen as passed.
+init_postdump_symbols()
+	Elements of the environment get given SVs with 'e' magic.
+	obj = sv and name and namlen point to the actual string
+	within env.
+
+pp.c
+pp_av2arylen()
+	$#foo gives '#' magic to the new SV with obj = av and
+	name = namlen = 0.
+pp_study()
+	SV gets 'g' magic with obj = name = namlen = 0.
+pp_substr()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+pp_vec()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+
+pp_hot.c
+pp_match()
+	m//g gets 'g' magic with obj = name = namlen = 0.
+
+pp_sys.c
+pp_tie()
+	sv gets magic with obj = sv and name = namlen = 0.
+	If an HV or an AV, it gets 'P' magic, otherwise 'q' magic.
+pp_dbmopen()
+	'P' magic for the HV just as with pp_tie().
+pp_sysread()
+	If tainting, the buffer SV gets 't' magic with
+	obj = name = namlen = 0.
+
+sv.c
+sv_setsv()
+	Doing sv_setsv(dstr, gv) gives '*' magic to dstr with
+	obj = dstr, name = GvNAME, namlen = GvNAMELEN.
+
+util.c
+fbm_compile()
+	The PVBM gets 'B' magic with obj = name = namlen = 0 and SvVALID
+	is set to indicate that the Boyer-Moore table is valid.
+	magic_setbm() just clears the SvVALID flag.
+
+hv_magic()
+----------
+
+gv.c
+gv_fetchfile()
+	With perldb, the HV of a gvfile gv gets 'L' magic with obj = gv.
+gv_fetchpv()
+	%SIG gets 'S' magic with obj = siggv.
+init_postdump_symbols()
+	%ENV gets 'E' magic with obj = envgv.

contrib/perl5/ext/B/ramblings/reg.alloc

@@ -0,0 +1,32 @@
+while ($i--) {
+    foo();
+}
+exit
+
+    PP code			if i an int register	if i an int but not a
+				(i.e. can't be		register (i.e. can be
+				implicitly invalidated)	implicitly invalidated)
+    nextstate
+    enterloop
+
+							
+  loop:
+    gvsv  GV (0xe6078) *i	validates i		validates i
+    postdec			invalidates $i		invalidates $i
+    and if_false goto out;
+				i valid; $i invalid	i valid; $i invalid
+
+				i valid; $i invalid	i valid; $i invalid
+    nextstate
+    pushmark
+    gv  GV (0xe600c) *foo
+    entersub						validates $i; invals i
+
+    unstack
+    goto loop:
+
+				i valid; $i invalid
+  out:
+    leaveloop
+    nextstate
+    exit

contrib/perl5/ext/B/ramblings/runtime.porting

@@ -0,0 +1,350 @@
+Notes on porting the perl runtime PP engine.
+Importance: 1 = who cares?, 10 = vital
+Difficulty: 1 = trivial, 10 = very difficult. Level assumes a
+reasonable implementation of the SV and OP API already ported.
+
+OP		Import	Diff	Comments
+null		10	1
+stub		10	1
+scalar		10	1
+pushmark	10	1	PUSHMARK
+wantarray	7	3	cxstack, dopoptosub
+const		10	1	
+gvsv		10	1	save_scalar
+gv		10	1	
+gelem		3	3	
+padsv		10	2	SAVECLEARSV, provide_ref
+padav		10	2
+padhv		10	2
+padany		1	1
+pushre		7	3	pushes an op. Blech.
+rv2gv		6	5
+rv2sv		10	4
+av2arylen	7	3	sv_magic	
+rv2cv		8	5	sv_2cv
+anoncode	7	6	cv_clone
+prototype	4	4	sv_2cv
+refgen		8	3
+srefgen		8	2
+ref		8	3
+bless		7	3
+backtick	5	4
+glob		5	2	do_readline
+readline	8	2	do_readline	
+rcatline	8	2
+regcmaybe	8	1
+regcomp		8	9	pregcomp
+match		8	10
+subst		8	10
+substcont	8	7
+trans		7	4	do_trans
+sassign		10	3	mg_find, SvSETMAGIC
+aassign		10	5	
+chop		8	3	do_chop
+schop		8	3	do_chop
+chomp		8	3	do_chomp
+schomp		8	3	do_chomp
+defined		10	2
+undef		10	3
+study		4	5
+pos		8	3	PVLV, mg_find
+preinc		10	2	sv_inc, SvSETMAGIC
+i_preinc
+predec		10	2	sv_dec, SvSETMAGIC
+i_predec
+postinc		10	2	sv_dec, SvSETMAGIC
+i_postinc
+postdec		10	2	sv_dec, SvSETMAGIC
+i_postdec
+pow		10	1
+multiply	10	1
+i_multiply	10	1
+divide		10	2
+i_divide	10	1
+modulo		10	2
+i_modulo	10	1
+repeat		6	4
+add		10	1
+i_add		10	1
+subtract	10	1
+i_subtract	10	1
+concat		10	2	mg_get
+stringify	10	2	sv_setpvn
+left_shift	10	1
+right_shift	10	1
+lt		10	1
+i_lt		10	1
+gt		10	1
+i_gt		10	1
+le		10	1
+i_le		10	1
+ge		10	1
+i_ge		10	1
+eq		10	1
+i_eq		10	1
+ne		10	1
+i_ne		10	1
+ncmp		10	1
+i_ncmp		10	1
+slt		10	2
+sgt		10	2
+sle		10	2
+sge		10	2
+seq		10	2	sv_eq
+sne		10	2
+scmp		10	2
+bit_and		10	2
+bit_xor		10	2
+bit_or		10	2
+negate		10	3
+i_negate	10	1
+not		10	1
+complement	10	3
+atan2		6	1
+sin		6	1
+cos		6	1
+rand		5	2
+srand		5	2
+exp		6	1
+log		6	2
+sqrt		6	2
+int		10	2
+hex		9	2
+oct		9	2
+abs		10	1
+length		10	1
+substr		10	4	PVLV
+vec		5	4
+index		9	3
+rindex		9	3
+sprintf		9	4	do_sprintf
+formline	6	7
+ord		6	2	
+chr		6	2
+crypt		3	2
+ucfirst		6	2
+lcfirst		6	2
+uc		6	2
+lc		6	2
+quotemeta	6	3
+rv2av		10	3	save_svref, mg_get, save_ary
+aelemfast	10	2	av_fetch
+aelem		10	3
+aslice		9	4
+each		10	3	hv_iternext
+values		10	3	do_kv
+keys		10	3	do_kv
+delete		10	3
+exists		10	3
+rv2hv		10	3	save_svref, mg_get, save_ary, do_kv
+helem		10	3	save_svref, provide_ref
+hslice		9	4
+unpack		9	6	lengthy
+pack		9	6	lengthy
+split		9	9
+join		10	4	do_join
+list		10	2
+lslice		9	4
+anonlist	10	2
+anonhash	10	3
+splice		9	6
+push		10	2
+pop		10	2
+shift		10	2
+unshift		10	2
+sort		6	7
+reverse		9	4
+grepstart	6	5	modifies flow of control
+grepwhile	6	5	modifies flow of control
+mapstart	1	1
+mapwhile	6	5	modifies flow of control
+range		7	3	modifies flow of control
+flip		7	4	modifies flow of control
+flop		7	4	modifies flow of control
+and		10	3	modifies flow of control
+or		10	3	modifies flow of control
+xor
+cond_expr	10	3	modifies flow of control
+andassign	7	3	modifies flow of control
+orassign	7	3	modifies flow of control
+method		8	5
+entersub	10	7
+leavesub	10	5
+caller		2	8
+warn		9	3
+die		9	3
+reset		2	2
+lineseq		1	1
+nextstate	10	1	Update stack_sp from cxstack. FREETMPS.
+dbstate		3	7		
+unstack
+enter		10	3	cxstack, ENTER, SAVETMPS, PUSHBLOCK
+leave		10	3	cxstack, SAVETMPS, LEAVE, POPBLOCK
+scope		1	1
+enteriter	9	4	cxstack
+iter		9	3	cxstack
+enterloop	10	4
+leaveloop	10	4
+return		10	5
+last		9	6
+next		9	6
+redo		9	6
+dump		1	9	pp_goto
+goto		6	9
+exit		9	2	my_exit
+open		9	5	do_open
+close		9	3	do_close
+pipe_op		7	4
+fileno		9	2
+umask		4	2
+binmode		4	2
+tie		5	5	pp_entersub
+untie		5	2	sv_unmagic
+tied		5	2
+dbmopen		4	5
+dbmclose	4	2
+sselect		4	4
+select		7	3
+getc		7	2
+read		8	2	pp_sysread
+enterwrite	4	4	doform
+leavewrite	4	5
+prtf		4	4	do_sprintf
+print		8	6
+sysopen		8	2
+sysread		8	4
+syswrite	8	4	pp_send
+send		8	4
+recv		8	4	pp_sysread
+eof		9	2
+tell		9	3
+seek		9	2
+truncate	8	3
+fcntl		8	4	pp_ioctl
+ioctl		8	4
+flock		8	2
+socket		5	3
+sockpair	5	3
+bind		5	3
+connect		5	3
+listen		5	3
+accept		5	3
+shutdown	5	2
+gsockopt	5	3	pp_ssockopt
+ssockopt	5	3
+getsockname	5	3	pp_getpeername
+getpeername	5	3
+lstat		5	4	pp_stat
+stat		5	4	lengthy
+ftrread		5	2	cando
+ftrwrite	5	2	cando
+ftrexec		5	2	cando
+fteread		5	2	cando
+ftewrite	5	2	cando
+fteexec		5	2	cando
+ftis		5	2	cando
+fteowned	5	2	cando
+ftrowned	5	2	cando
+ftzero		5	2	cando
+ftsize		5	2	cando
+ftmtime		5	2	cando
+ftatime		5	2	cando
+ftctime		5	2	cando
+ftsock		5	2	cando
+ftchr		5	2	cando
+ftblk		5	2	cando
+ftfile		5	2	cando
+ftdir		5	2	cando
+ftpipe		5	2	cando
+ftlink		5	2	cando
+ftsuid		5	2	cando
+ftsgid		5	2	cando
+ftsvtx		5	2	cando
+fttty		5	2	cando
+fttext		5	4
+ftbinary	5	4	fttext
+chdir
+chown
+chroot
+unlink
+chmod
+utime
+rename
+link
+symlink
+readlink
+mkdir
+rmdir
+open_dir
+readdir
+telldir
+seekdir
+rewinddir
+closedir
+fork
+wait
+waitpid
+system
+exec
+kill
+getppid
+getpgrp
+setpgrp
+getpriority
+setpriority
+time
+tms
+localtime
+gmtime
+alarm
+sleep
+shmget
+shmctl
+shmread
+shmwrite
+msgget
+msgctl
+msgsnd
+msgrcv
+semget
+semctl
+semop
+require		6	9	doeval
+dofile		6	9	doeval
+entereval	6	9	doeval
+leaveeval	6	5
+entertry	7	4	modifies flow of control
+leavetry	7	3
+ghbyname
+ghbyaddr
+ghostent
+gnbyname
+gnbyaddr
+gnetent
+gpbyname
+gpbynumber
+gprotoent
+gsbyname
+gsbyport
+gservent
+shostent
+snetent
+sprotoent
+sservent
+ehostent
+enetent
+eprotoent
+eservent
+gpwnam
+gpwuid
+gpwent
+spwent
+epwent
+ggrnam
+ggrgid
+ggrent
+sgrent
+egrent
+getlogin
+syscall
+	

contrib/perl5/ext/B/typemap

@@ -0,0 +1,69 @@
+TYPEMAP
+
+B::OP		T_OP_OBJ
+B::UNOP		T_OP_OBJ
+B::BINOP	T_OP_OBJ
+B::LOGOP	T_OP_OBJ
+B::CONDOP	T_OP_OBJ
+B::LISTOP	T_OP_OBJ
+B::PMOP		T_OP_OBJ
+B::SVOP		T_OP_OBJ
+B::GVOP		T_OP_OBJ
+B::PVOP		T_OP_OBJ
+B::CVOP		T_OP_OBJ
+B::LOOP		T_OP_OBJ
+B::COP		T_OP_OBJ
+
+B::SV		T_SV_OBJ
+B::PV		T_SV_OBJ
+B::IV		T_SV_OBJ
+B::NV		T_SV_OBJ
+B::PVMG		T_SV_OBJ
+B::PVLV		T_SV_OBJ
+B::BM		T_SV_OBJ
+B::RV		T_SV_OBJ
+B::GV		T_SV_OBJ
+B::CV		T_SV_OBJ
+B::HV		T_SV_OBJ
+B::AV		T_SV_OBJ
+B::IO		T_SV_OBJ
+
+B::MAGIC	T_MG_OBJ
+SSize_t		T_IV
+STRLEN		T_IV
+
+INPUT
+T_OP_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_SV_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_MG_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+OUTPUT
+T_OP_OBJ
+	sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var);
+
+T_SV_OBJ
+	make_sv_object(($arg), (SV*)($var));
+
+
+T_MG_OBJ
+	sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)$var);

contrib/perl5/ext/DB_File/Changes

@@ -0,0 +1,205 @@
+
+0.1
+
+    First Release.
+
+0.2
+
+    When DB_File is opening a database file it no longer terminates the
+    process if dbopen returned an error. This allows file protection
+    errors to be caught at run time. Thanks to Judith Grass
+    <grass@cybercash.com> for spotting the bug.
+
+0.3
+
+    Added prototype support for multiple btree compare callbacks.
+
+1.0
+
+    DB_File has been in use for over a year. To reflect that, the
+    version number has been incremented to 1.0.
+
+    Added complete support for multiple concurrent callbacks.
+
+    Using the push method on an empty list didn't work properly. This
+    has been fixed.
+
+1.01
+
+    Fixed a core dump problem with SunOS.
+
+    The return value from TIEHASH wasn't set to NULL when dbopen
+    returned an error.
+
+1.02
+
+    Merged OS/2 specific code into DB_File.xs
+
+    Removed some redundant code in DB_File.xs.
+
+    Documentation update.
+
+    Allow negative subscripts with RECNO interface.
+
+    Changed the default flags from O_RDWR to O_CREAT|O_RDWR.
+
+    The example code which showed how to lock a database needed a call
+    to sync added. Without it the resultant database file was empty.
+
+    Added get_dup method.
+
+1.03
+
+    Documentation update.
+
+    DB_File now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl
+    automatically.
+
+    The standard hash function exists is now supported.
+
+    Modified the behavior of get_dup. When it returns an associative
+    array, the value is the count of the number of matching BTREE
+    values.
+
+1.04
+
+    Minor documentation changes.
+
+    Fixed a bug in hash_cb. Patches supplied by Dave Hammen,
+    <hammen@gothamcity.jsc.nasa.govt>.
+
+    Fixed a bug with the constructors for DB_File::HASHINFO,
+    DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the
+    constructors to make them -w clean.
+
+    Reworked part of the test harness to be more locale friendly.
+
+1.05
+
+    Made all scripts in the documentation strict and -w clean.
+
+    Added logic to DB_File.xs to allow the module to be built after
+    Perl is installed.
+
+1.06
+
+    Minor namespace cleanup: Localized PrintBtree.
+
+1.07
+
+    Fixed bug with RECNO, where bval wasn't defaulting to "\n".
+
+1.08
+
+    Documented operation of bval.
+
+1.09
+
+    Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and
+    DB_File::BTREEINFO.
+
+    Changed default mode to 0666.
+
+1.10
+
+    Fixed fd method so that it still returns -1 for in-memory files
+    when db 1.86 is used.
+
+1.11
+
+    Documented the untie gotcha.
+
+1.12
+
+    Documented the incompatibility with version 2 of Berkeley DB.
+
+1.13
+
+    Minor changes to DB_FIle.xs and DB_File.pm
+
+1.14
+
+    Made it illegal to tie an associative array to a RECNO database and
+    an ordinary array to a HASH or BTREE database.
+
+1.15
+
+    Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
+    value" warning with db_get and db_seq.
+
+    Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the
+    O_* constants from Fcntl.
+
+    Removed the DESTROY method from the DB_File::HASHINFO module.
+
+    Previously DB_File hard-wired the class name of any object that it
+    created to "DB_File". This makes sub-classing difficult. Now
+    DB_File creats objects in the namespace of the package it has been
+    inherited into.
+
+
+1.16
+
+   A harmless looking tab was causing Makefile.PL to fail on AIX 3.2.5
+
+    Small fix for the AIX strict C compiler XLC which doesn't like
+    __attribute__ being defined via proto.h and redefined via db.h. Fix
+    courtesy of Jarkko Hietaniemi.
+
+1.50
+
+    DB_File can now build with either DB 1.x or 2.x, but not both at
+    the same time.
+
+1.51
+
+    Fixed the test harness so that it doesn't expect DB_File to have
+    been installed by the main Perl build.
+
+
+    Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
+
+1.52
+
+   Patch from Nick Ing-Simmons now allows DB_File to build on NT.
+   Merged 1.15 patch.
+
+1.53
+
+   Added DB_RENUMBER to flags for recno.
+
+1.54
+
+   Fixed a small bug in the test harness when run under win32
+   The emulation of fd when useing DB 2.x was busted.
+
+1.55
+   Merged 1.16 changes.
+
+1.56
+   Documented the Solaris 2.5 mutex bug
+
+1.57
+   If Perl has been compiled with Threads support,the symbol op will be
+   defined. This clashes with a field name in db.h, so it needs to be
+   #undef'ed before db.h is included.
+
+1.58
+   Tied Array support was enhanced in Perl 5.004_57. DB_File now
+   supports PUSH,POP,SHIFT,UNSHIFT & STORESIZE.
+
+   Fixed a problem with the use of sv_setpvn. When the size is
+   specified as 0, it does a strlen on the data.  This was ok for DB
+   1.x, but isn't for DB 2.x.
+
+1.59
+   Updated the license section.
+
+   Berkeley DB 2.4.10 disallows zero length keys. Tests 32 & 42 in
+   db-btree.t and test 27 in db-hash.t failed because of this change.
+   Those tests have been zapped.
+
+   Added dbinfo to the distribution.
+
+1.60
+   Changed the test to check for full tied array support

contrib/perl5/ext/DB_File/DB_File_BS

@@ -0,0 +1,6 @@
+# NeXT needs /usr/lib/libposix.a to load along with DB_File.so
+if ( $dlsrc eq "dl_next.xs" ) {
+    @DynaLoader::dl_resolve_using = ( '/usr/lib/libposix.a' );
+}
+
+1;

contrib/perl5/ext/DB_File/Makefile.PL

@@ -0,0 +1,20 @@
+use ExtUtils::MakeMaker 5.16 ;
+use Config ;
+
+# OS2 is a special case, so check for it now.
+my $OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
+
+my $LIB = "-ldb" ;
+# so is win32
+$LIB = "-llibdb" if $^O eq 'MSWin32' ;
+
+WriteMakefile(
+	NAME 		=> 'DB_File',
+	LIBS 		=> ["-L/usr/local/lib $LIB"],
+        MAN3PODS        => ' ',         # Pods will be built by installman.
+	#INC		=> '-I/usr/local/include',
+	VERSION_FROM	=> 'DB_File.pm',
+	XSPROTOARG	=> '-noprototypes',
+	DEFINE		=> "$OS2",
+	);
+

contrib/perl5/ext/DB_File/dbinfo

@@ -0,0 +1,96 @@
+#!/usr/local/bin/perl
+
+# Name:		dbinfo -- identify berkeley DB version used to create 
+#			  a database file
+#
+# Author:	Paul Marquess
+# Version: 	1.01 
+# Date		16th April 1998
+#
+#     Copyright (c) 1998 Paul Marquess. All rights reserved.
+#     This program is free software; you can redistribute it and/or
+#     modify it under the same terms as Perl itself.
+
+# Todo: Print more stats on a db file, e.g. no of records
+#       add log/txn/lock files
+
+use strict ;
+
+my %Data =
+	(
+	0x053162 =>	{
+			  Type 	=> "Btree",
+			  Versions => 
+				{
+				  1	=> "Unknown (older than 1.71)",
+				  2	=> "Unknown (older than 1.71)",
+				  3	=> "1.71 -> 1.85, 1.86",
+				  4	=> "Unknown",
+				  5	=> "2.0.0 -> 2.3.0",
+				  6	=> "2.3.1 or greater",
+				}
+			},
+	0x061561 => 	{
+			  Type => "Hash",
+			  Versions =>
+				{
+				  1	=> "Unknown (older than 1.71)",
+        			  2     => "1.71 -> 1.85",
+        			  3     => "1.86",
+        			  4     => "2.0.0 -> 2.1.0",
+        			  5     => "2.2.6 or greater",
+				}
+			},
+	) ;
+
+die "Usage: dbinfo file\n" unless @ARGV == 1 ;
+
+print "testing file $ARGV[0]...\n\n" ;
+open (F, "<$ARGV[0]") or die "Cannot open file $ARGV[0]: $!\n" ;
+
+my $buff ;
+read F, $buff, 20 ;
+
+my (@info) = unpack("NNNNN", $buff) ;
+my (@info1) = unpack("VVVVV", $buff) ;
+my ($magic, $version, $endian) ;
+
+if ($Data{$info[0]}) # first try DB 1.x format
+{
+    $magic = $info[0] ;
+    $version = $info[1] ;
+    $endian  = "Unknown" ;
+}
+elsif ($Data{$info[3]}) # next DB 2.x big endian
+{
+    $magic = $info[3] ;
+    $version = $info[4] ;
+    $endian  = "Big Endian" ;
+}
+elsif ($Data{$info1[3]}) # next DB 2.x little endian
+{
+    $magic = $info1[3] ;
+    $version = $info1[4] ;
+    $endian  = "Little Endian" ;
+}
+else
+  { die "not a Berkeley DB database file.\n" }
+
+my $type = $Data{$magic} ;
+my $magic = sprintf "%06X", $magic ;
+
+my $ver_string = "Unknown" ;
+$ver_string = $type->{Versions}{$version}
+	if defined $type->{Versions}{$version} ;
+
+print <<EOM ;
+File Type:		Berkeley DB $type->{Type} file.
+File Version ID:	$version
+Built with Berkeley DB:	$ver_string
+Byte Order:		$endian
+Magic:			$magic
+EOM
+
+close F ;
+
+exit ;

contrib/perl5/ext/DB_File/typemap

@@ -0,0 +1,41 @@
+# typemap for Perl 5 interface to Berkeley 
+#
+# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+# last modified 13th May 1998
+# version 1.59
+#
+#################################### DB SECTION
+#
+# 
+
+u_int			T_U_INT
+DB_File			T_PTROBJ
+DBT			T_dbtdatum
+DBTKEY			T_dbtkeydatum
+
+INPUT
+T_dbtkeydatum
+	if (db->type != DB_RECNO) {
+	    $var.data = SvPV($arg, PL_na);
+	    $var.size = (int)PL_na;
+	    DBT_flags($var);
+	}
+	else {
+	    Value =  GetRecnoKey(db, SvIV($arg)) ; 
+	    $var.data = & Value; 
+	    $var.size = (int)sizeof(recno_t);
+	    DBT_flags($var);
+	}
+T_dbtdatum
+	$var.data = SvPV($arg, PL_na);
+	$var.size = (int)PL_na;
+	DBT_flags($var);
+
+OUTPUT
+
+T_dbtkeydatum
+	OutputKey($arg, $var)
+T_dbtdatum
+	OutputValue($arg, $var)
+T_PTROBJ
+        sv_setref_pv($arg, dbtype, (void*)$var);

contrib/perl5/ext/Data/Dumper/Changes

@@ -0,0 +1,160 @@
+=head1 NAME
+
+HISTORY - public release history for Data::Dumper
+
+=head1 DESCRIPTION
+
+=over 8
+
+=item 2.09  (9 July 1998)
+
+Implement $Data::Dumper::Bless, suggested by Mark Daku <daku@nortel.ca>.
+
+=item 2.081  (15 January 1998)
+
+Minor release to fix Makefile.PL not accepting MakeMaker args.
+
+=item 2.08  (7 December 1997)
+
+Glob dumps don't output superflous 'undef' anymore.
+
+Fixes from Gisle Aas <gisle@aas.no> to make Dumper() work with
+overloaded strings in recent perls, and his new testsuite.
+
+require 5.004.
+
+A separate flag to always quote hash keys (on by default).
+
+Recreating known CODE refs is now better supported.
+
+Changed flawed constant SCALAR bless workaround.
+
+=item 2.07  (7 December 1996)
+
+Dumpxs output is now exactly the same as Dump.  It still doesn't
+honor C<Useqq> though.
+
+Regression tests test for identical output and C<eval>-ability.
+
+Bug in *GLOB{THING} output fixed.
+
+Other small enhancements.
+
+=item 2.06  (2 December 1996)
+
+Bugfix that was serious enough for new release--the bug cripples
+MLDBM.  Problem was "Attempt to modify readonly value..." failures
+that stemmed for a misguided SvPV_force() instead of a SvPV().)
+
+=item 2.05  (2 December 1996)
+
+Fixed the type mismatch that was causing Dumpxs test to fail
+on 64-bit platforms.
+
+GLOB elements are dumped now when C<Purity> is set (using the
+*GLOB{THING} syntax).
+
+The C<Freezer> option can be set to a method name to call
+before probing objects for dumping.  Some applications: objects with
+external data, can re-bless themselves into a transitional package;
+Objects the maintain ephemeral state (like open files) can put
+additional information in the object to facilitate persistence.
+
+The corresponding C<Toaster> option, if set, specifies
+the method call that will revive the frozen object.
+
+The C<Deepcopy> flag has been added to do just that.
+
+Dumper does more aggressive cataloging of SCALARs encountered
+within ARRAY/HASH structures. Thanks to Norman Gaywood 
+<norm@godel.une.edu.au> for reporting the problem.
+
+Objects that C<overload> the '""' operator are now handled
+properly by the C<Dump> method.
+
+Significant additions to the testsuite.
+
+More documentation.
+
+=item 2.04beta  (28 August 1996)
+
+Made dump of glob names respect C<Useqq> setting.
+
+[@$%] are now escaped now when in double quotes.
+
+=item 2.03beta  (26 August 1996)
+
+Fixed Dumpxs.  It was appending trailing nulls to globnames.
+(reported by Randal Schwartz <merlyn@teleport.com>).
+
+Calling the C<Indent()> method on a dumper object now correctly
+resets the internal separator (reported by Curt Tilmes
+<curt@ltpmail.gsfc.nasa.gov>).
+
+New C<Terse> option to suppress the 'C<VARI<n> = >' prefix 
+introduced.  If the option is set, they are output only when
+absolutely essential.
+
+The C<Useqq> flag is supported (but not by the XSUB version
+yet).
+
+Embedded nulls in keys are now handled properly by Dumpxs.
+
+Dumper.xs now use various integer types in perl.h (should
+make it compile without noises on 64 bit platforms, although
+I haven't been able to test this).
+
+All the dump methods now return a list of strings in a list
+context.
+
+
+=item 2.02beta  (13 April 1996)
+
+Non portable sprintf usage in XS code fixed (thanks to 
+Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>).
+
+
+=item 2.01beta  (10 April 1996)
+
+Minor bugfix (single digit numbers were always getting quoted).
+
+
+=item 2.00beta  (9 April 1996)
+
+C<Dumpxs> is now the exact XSUB equivalent of C<Dump>.  The XS version
+is 4-5 times faster.
+
+C<require 5.002>.
+
+MLDBM example removed (as its own module, it has a separate CPAN 
+reality now).
+
+Fixed bugs in handling keys with wierd characters.  Perl can be
+tripped up in its implicit quoting of the word before '=>'.  The
+fix: C<Data::Dumper::Purity>, when set, always triggers quotes
+around hash keys.
+
+Andreas Koenig <k@anna.in-berlin.de> pointed out that handling octals
+is busted.  His patch added.
+
+Dead code removed, other minor documentation fixes.
+
+
+=item 1.23      (3 Dec 1995)
+
+MLDBM example added.
+
+Several folks pointed out that quoting of ticks and backslashes 
+in strings is missing. Added.
+
+Ian Phillips <ian@pipex.net> pointed out that numerics may lose 
+precision without quotes.  Fixed.
+
+
+=item 1.21     (20 Nov 1995)
+
+Last stable version I can remember.
+
+=back
+
+=cut

contrib/perl5/ext/Data/Dumper/Dumper.pm

@@ -0,0 +1,963 @@
+#
+# Data/Dumper.pm
+#
+# convert perl data structures into perl syntax suitable for both printing
+# and eval
+#
+# Documentation at the __END__
+#
+
+package Data::Dumper;
+
+$VERSION = $VERSION = '2.09';
+
+#$| = 1;
+
+require 5.004;
+require Exporter;
+require DynaLoader;
+require overload;
+
+use Carp;
+
+@ISA = qw(Exporter DynaLoader);
+@EXPORT = qw(Dumper);
+@EXPORT_OK = qw(DumperX);
+
+bootstrap Data::Dumper;
+
+# module vars and their defaults
+$Indent = 2 unless defined $Indent;
+$Purity = 0 unless defined $Purity;
+$Pad = "" unless defined $Pad;
+$Varname = "VAR" unless defined $Varname;
+$Useqq = 0 unless defined $Useqq;
+$Terse = 0 unless defined $Terse;
+$Freezer = "" unless defined $Freezer;
+$Toaster = "" unless defined $Toaster;
+$Deepcopy = 0 unless defined $Deepcopy;
+$Quotekeys = 1 unless defined $Quotekeys;
+$Bless = "bless" unless defined $Bless;
+#$Expdepth = 0 unless defined $Expdepth;
+#$Maxdepth = 0 unless defined $Maxdepth;
+
+#
+# expects an arrayref of values to be dumped.
+# can optionally pass an arrayref of names for the values.
+# names must have leading $ sign stripped. begin the name with *
+# to cause output of arrays and hashes rather than refs.
+#
+sub new {
+  my($c, $v, $n) = @_;
+
+  croak "Usage:  PACKAGE->new(ARRAYREF, [ARRAYREF])" 
+    unless (defined($v) && (ref($v) eq 'ARRAY'));
+  $n = [] unless (defined($n) && (ref($v) eq 'ARRAY'));
+
+  my($s) = { 
+             level      => 0,           # current recursive depth
+	     indent     => $Indent,     # various styles of indenting
+	     pad	=> $Pad,        # all lines prefixed by this string
+	     xpad       => "",          # padding-per-level
+	     apad       => "",          # added padding for hash keys n such
+	     sep        => "",          # list separator
+	     seen       => {},          # local (nested) refs (id => [name, val])
+	     todump     => $v,          # values to dump []
+	     names      => $n,          # optional names for values []
+	     varname    => $Varname,    # prefix to use for tagging nameless ones
+             purity     => $Purity,     # degree to which output is evalable
+             useqq 	=> $Useqq,      # use "" for strings (backslashitis ensues)
+             terse 	=> $Terse,      # avoid name output (where feasible)
+             freezer	=> $Freezer,    # name of Freezer method for objects
+             toaster	=> $Toaster,    # name of method to revive objects
+             deepcopy	=> $Deepcopy,   # dont cross-ref, except to stop recursion
+             quotekeys	=> $Quotekeys,  # quote hash keys
+             'bless'	=> $Bless,	# keyword to use for "bless"
+#	     expdepth   => $Expdepth,   # cutoff depth for explicit dumping
+#	     maxdepth	=> $Maxdepth,   # depth beyond which we give up
+	   };
+
+  if ($Indent > 0) {
+    $s->{xpad} = "  ";
+    $s->{sep} = "\n";
+  }
+  return bless($s, $c);
+}
+
+#
+# add-to or query the table of already seen references
+#
+sub Seen {
+  my($s, $g) = @_;
+  if (defined($g) && (ref($g) eq 'HASH'))  {
+    my($k, $v, $id);
+    while (($k, $v) = each %$g) {
+      if (defined $v and ref $v) {
+	($id) = (overload::StrVal($v) =~ /\((.*)\)$/);
+	if ($k =~ /^[*](.*)$/) {
+	  $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
+	       (ref $v eq 'HASH')  ? ( "\\\%" . $1 ) :
+	       (ref $v eq 'CODE')  ? ( "\\\&" . $1 ) :
+				     (   "\$" . $1 ) ;
+	}
+	elsif ($k !~ /^\$/) {
+	  $k = "\$" . $k;
+	}
+	$s->{seen}{$id} = [$k, $v];
+      }
+      else {
+	carp "Only refs supported, ignoring non-ref item \$$k";
+      }
+    }
+    return $s;
+  }
+  else {
+    return map { @$_ } values %{$s->{seen}};
+  }
+}
+
+#
+# set or query the values to be dumped
+#
+sub Values {
+  my($s, $v) = @_;
+  if (defined($v) && (ref($v) eq 'ARRAY'))  {
+    $s->{todump} = [@$v];        # make a copy
+    return $s;
+  }
+  else {
+    return @{$s->{todump}};
+  }
+}
+
+#
+# set or query the names of the values to be dumped
+#
+sub Names {
+  my($s, $n) = @_;
+  if (defined($n) && (ref($n) eq 'ARRAY'))  {
+    $s->{names} = [@$n];         # make a copy
+    return $s;
+  }
+  else {
+    return @{$s->{names}};
+  }
+}
+
+sub DESTROY {}
+
+#
+# dump the refs in the current dumper object.
+# expects same args as new() if called via package name.
+#
+sub Dump {
+  my($s) = shift;
+  my(@out, $val, $name);
+  my($i) = 0;
+  local(@post);
+
+  $s = $s->new(@_) unless ref $s;
+
+  for $val (@{$s->{todump}}) {
+    my $out = "";
+    @post = ();
+    $name = $s->{names}[$i++];
+    if (defined $name) {
+      if ($name =~ /^[*](.*)$/) {
+	if (defined $val) {
+	  $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
+		  (ref $val eq 'HASH')  ? ( "\%" . $1 ) :
+		  (ref $val eq 'CODE')  ? ( "\*" . $1 ) :
+					  ( "\$" . $1 ) ;
+	}
+	else {
+	  $name = "\$" . $1;
+	}
+      }
+      elsif ($name !~ /^\$/) {
+	$name = "\$" . $name;
+      }
+    }
+    else {
+      $name = "\$" . $s->{varname} . $i;
+    }
+
+    my $valstr;
+    {
+      local($s->{apad}) = $s->{apad};
+      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
+      $valstr = $s->_dump($val, $name);
+    }
+
+    $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
+    $out .= $s->{pad} . $valstr . $s->{sep};
+    $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post) 
+      . ';' . $s->{sep} if @post;
+
+    push @out, $out;
+  }
+  return wantarray ? @out : join('', @out);
+}
+
+#
+# twist, toil and turn;
+# and recurse, of course.
+#
+sub _dump {
+  my($s, $val, $name) = @_;
+  my($sname);
+  my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
+
+  return "undef" unless defined $val;
+
+  $type = ref $val;
+  $out = "";
+
+  if ($type) {
+
+    # prep it, if it looks like an object
+    if ($type =~ /[a-z_:]/) {
+      my $freezer = $s->{freezer};
+      # UNIVERSAL::can should be used here, when we can require 5.004
+      if ($freezer) {
+	eval { $val->$freezer() };
+	carp "WARNING(Freezer method call failed): $@" if $@;
+      }
+    }
+
+    ($realpack, $realtype, $id) =
+      (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
+    
+    # keep a tab on it so that we dont fall into recursive pit
+    if (exists $s->{seen}{$id}) {
+#     if ($s->{expdepth} < $s->{level}) {
+      if ($s->{purity} and $s->{level} > 0) {
+	$out = ($realtype eq 'HASH')  ? '{}' :
+	       ($realtype eq 'ARRAY') ? '[]' :
+					"''" ;
+	  push @post, $name . " = " . $s->{seen}{$id}[0];
+      }
+      else {
+	$out = $s->{seen}{$id}[0];
+	if ($name =~ /^([\@\%])/) {
+	  my $start = $1;
+	  if ($out =~ /^\\$start/) {
+	    $out = substr($out, 1);
+	  }
+	  else {
+	    $out = $start . '{' . $out . '}';
+	  }
+	}
+      }
+      return $out;
+#     }
+    }
+    else {
+      # store our name
+      $s->{seen}{$id} = [ (($name =~ /^[@%]/)     ? ('\\' . $name ) :
+			   ($realtype eq 'CODE' and
+			    $name =~ /^[*](.*)$/) ? ('\\&' . $1 )   :
+						     $name          ),
+			  $val ];
+    }
+
+    $s->{level}++;
+    $ipad = $s->{xpad} x $s->{level};
+
+    if ($realpack) {          # we have a blessed ref
+      $out = $s->{'bless'} . '( ';
+      $blesspad = $s->{apad};
+      $s->{apad} .= '       ' if ($s->{indent} >= 2);
+    }
+    
+    if ($realtype eq 'SCALAR') {
+      if ($realpack) {
+	$out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}';
+      }
+      else {
+	$out .= '\\' . $s->_dump($$val, "");
+      }
+    }
+    elsif ($realtype eq 'GLOB') {
+	$out .= '\\' . $s->_dump($$val, "");
+    }
+    elsif ($realtype eq 'ARRAY') {
+      my($v, $pad, $mname);
+      my($i) = 0;
+      $out .= ($name =~ /^\@/) ? '(' : '[';
+      $pad = $s->{sep} . $s->{pad} . $s->{apad};
+      ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) : 
+	($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+      $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
+      for $v (@$val) {
+	$sname = $mname . '[' . $i . ']';
+	$out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
+	$out .= $pad . $ipad . $s->_dump($v, $sname);
+	$out .= "," if $i++ < $#$val;
+      }
+      $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
+      $out .= ($name =~ /^\@/) ? ')' : ']';
+    }
+    elsif ($realtype eq 'HASH') {
+      my($k, $v, $pad, $lpad, $mname);
+      $out .= ($name =~ /^\%/) ? '(' : '{';
+      $pad = $s->{sep} . $s->{pad} . $s->{apad};
+      $lpad = $s->{apad};
+      ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) : 
+	($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
+      $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
+      while (($k, $v) = each %$val) {
+	my $nk = $s->_dump($k, "");
+	$nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
+	$sname = $mname . '{' . $nk . '}';
+	$out .= $pad . $ipad . $nk . " => ";
+
+	# temporarily alter apad
+	$s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
+	$out .= $s->_dump($val->{$k}, $sname) . ",";
+	$s->{apad} = $lpad if $s->{indent} >= 2;
+      }
+      if (substr($out, -1) eq ',') {
+	chop $out;
+	$out .= $pad . ($s->{xpad} x ($s->{level} - 1));
+      }
+      $out .= ($name =~ /^\%/) ? ')' : '}';
+    }
+    elsif ($realtype eq 'CODE') {
+      $out .= '"DUMMY"';
+      $out = 'sub { ' . $out . ' }';
+      carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
+    }
+    else {
+      croak "Can\'t handle $realtype type.";
+    }
+    
+    if ($realpack) { # we have a blessed ref
+      $out .= ', \'' . $realpack . '\'' . ' )';
+      $out .= '->' . $s->{toaster} . '()'  if $s->{toaster} ne '';
+      $s->{apad} = $blesspad;
+    }
+    $s->{level}--;
+
+  }
+  else {                                 # simple scalar
+
+    my $ref = \$_[1];
+    # first, catalog the scalar
+    if ($name ne '') {
+      ($id) = ("$ref" =~ /\(([^\(]*)\)$/);
+      if (exists $s->{seen}{$id}) {
+	$out = $s->{seen}{$id}[0];
+	return $out;
+      }
+      else {
+	$s->{seen}{$id} = ["\\$name", $val];
+      }
+    }
+    if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) {  # glob
+      my $name = substr($val, 1);
+      if ($name =~ /^[A-Za-z_][\w:]*$/) {
+	$name =~ s/^main::/::/;
+	$sname = $name;
+      }
+      else {
+	$sname = $s->_dump($name, "");
+	$sname = '{' . $sname . '}';
+      }
+      if ($s->{purity}) {
+	my $k;
+	local ($s->{level}) = 0;
+	for $k (qw(SCALAR ARRAY HASH)) {
+	  # _dump can push into @post, so we hold our place using $postlen
+	  my $postlen = scalar @post;
+	  $post[$postlen] = "\*$sname = ";
+	  local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
+	  $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}");
+	}
+      }
+      $out .= '*' . $sname;
+    }
+    elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
+      $out .= $val;
+    }
+    else {				 # string
+      if ($s->{useqq}) {
+	$out .= qquote($val);
+      }
+      else {
+	$val =~ s/([\\\'])/\\$1/g;
+	$out .= '\'' . $val .  '\'';
+      }
+    }
+  }
+
+  # if we made it this far, $id was added to seen list at current
+  # level, so remove it to get deep copies
+  delete($s->{seen}{$id}) if $id and $s->{deepcopy};
+  return $out;
+}
+  
+#
+# non-OO style of earlier version
+#
+sub Dumper {
+  return Data::Dumper->Dump([@_]);
+}
+
+#
+# same, only calls the XS version
+#
+sub DumperX {
+  return Data::Dumper->Dumpxs([@_], []);
+}
+
+sub Dumpf { return Data::Dumper->Dump(@_) }
+
+sub Dumpp { print Data::Dumper->Dump(@_) }
+
+#
+# reset the "seen" cache 
+#
+sub Reset {
+  my($s) = shift;
+  $s->{seen} = {};
+  return $s;
+}
+
+sub Indent {
+  my($s, $v) = @_;
+  if (defined($v)) {
+    if ($v == 0) {
+      $s->{xpad} = "";
+      $s->{sep} = "";
+    }
+    else {
+      $s->{xpad} = "  ";
+      $s->{sep} = "\n";
+    }
+    $s->{indent} = $v;
+    return $s;
+  }
+  else {
+    return $s->{indent};
+  }
+}
+
+sub Pad {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
+}
+
+sub Varname {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
+}
+
+sub Purity {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
+}
+
+sub Useqq {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
+}
+
+sub Terse {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
+}
+
+sub Freezer {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
+}
+
+sub Toaster {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
+}
+
+sub Deepcopy {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
+}
+
+sub Quotekeys {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
+}
+
+sub Bless {
+  my($s, $v) = @_;
+  defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
+}
+
+# put a string value in double quotes
+sub qquote {
+  local($_) = shift;
+  s/([\\\"\@\$\%])/\\$1/g;    
+  s/\a/\\a/g;
+  s/[\b]/\\b/g;
+  s/\t/\\t/g;
+  s/\n/\\n/g;
+  s/\f/\\f/g;
+  s/\r/\\r/g;
+  s/\e/\\e/g;
+
+# this won't work!
+#  s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg;
+  s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+  return "\"$_\"";
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Data::Dumper - stringified perl data structures, suitable for both printing and C<eval>
+
+
+=head1 SYNOPSIS
+
+    use Data::Dumper;
+
+    # simple procedural interface
+    print Dumper($foo, $bar);
+
+    # extended usage with names
+    print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
+
+    # configuration variables
+    {
+      local $Data::Dump::Purity = 1;
+      eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
+    }
+
+    # OO usage
+    $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
+       ...
+    print $d->Dump;
+       ...
+    $d->Purity(1)->Terse(1)->Deepcopy(1);
+    eval $d->Dump;
+
+
+=head1 DESCRIPTION
+
+Given a list of scalars or reference variables, writes out their contents in
+perl syntax. The references can also be objects.  The contents of each
+variable is output in a single Perl statement.  Handles self-referential
+structures correctly.
+
+The return value can be C<eval>ed to get back an identical copy of the
+original reference structure.
+
+Any references that are the same as one of those passed in will be named
+C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
+to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
+notation.  You can specify names for individual values to be dumped if you
+use the C<Dump()> method, or you can change the default C<$VAR> prefix to
+something else.  See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
+below.
+
+The default output of self-referential structures can be C<eval>ed, but the
+nested references to C<$VAR>I<n> will be undefined, since a recursive
+structure cannot be constructed using one Perl statement.  You should set the
+C<Purity> flag to 1 to get additional statements that will correctly fill in
+these references.
+
+In the extended usage form, the references to be dumped can be given
+user-specified names.  If a name begins with a C<*>, the output will 
+describe the dereferenced type of the supplied reference for hashes and
+arrays, and coderefs.  Output of names will be avoided where possible if
+the C<Terse> flag is set.
+
+In many cases, methods that are used to set the internal state of the
+object will return the object itself, so method calls can be conveniently
+chained together.
+
+Several styles of output are possible, all controlled by setting
+the C<Indent> flag.  See L<Configuration Variables or Methods> below 
+for details.
+
+
+=head2 Methods
+
+=over 4
+
+=item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>)
+
+Returns a newly created C<Data::Dumper> object.  The first argument is an
+anonymous array of values to be dumped.  The optional second argument is an
+anonymous array of names for the values.  The names need not have a leading
+C<$> sign, and must be comprised of alphanumeric characters.  You can begin
+a name with a C<*> to specify that the dereferenced type must be dumped
+instead of the reference itself, for ARRAY and HASH references.
+
+The prefix specified by C<$Data::Dumper::Varname> will be used with a
+numeric suffix if the name for a value is undefined.
+
+Data::Dumper will catalog all references encountered while dumping the
+values. Cross-references (in the form of names of substructures in perl
+syntax) will be inserted at all possible points, preserving any structural
+interdependencies in the original set of values.  Structure traversal is
+depth-first,  and proceeds in order from the first supplied value to
+the last.
+
+=item I<$OBJ>->Dump  I<or>  I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>)
+
+Returns the stringified form of the values stored in the object (preserving
+the order in which they were supplied to C<new>), subject to the
+configuration options below.  In an array context, it returns a list
+of strings corresponding to the supplied values.
+
+The second form, for convenience, simply calls the C<new> method on its
+arguments before dumping the object immediately.
+
+=item I<$OBJ>->Dumpxs  I<or>  I<PACKAGE>->Dumpxs(I<ARRAYREF [>, I<ARRAYREF]>)
+
+This method is available if you were able to compile and install the XSUB
+extension to C<Data::Dumper>. It is exactly identical to the C<Dump> method 
+above, only about 4 to 5 times faster, since it is written entirely in C.
+
+=item I<$OBJ>->Seen(I<[HASHREF]>)
+
+Queries or adds to the internal table of already encountered references.
+You must use C<Reset> to explicitly clear the table if needed.  Such
+references are not dumped; instead, their names are inserted wherever they
+are encountered subsequently.  This is useful especially for properly
+dumping subroutine references.
+
+Expects a anonymous hash of name => value pairs.  Same rules apply for names
+as in C<new>.  If no argument is supplied, will return the "seen" list of
+name => value pairs, in an array context.  Otherwise, returns the object
+itself.
+
+=item I<$OBJ>->Values(I<[ARRAYREF]>)
+
+Queries or replaces the internal array of values that will be dumped.
+When called without arguments, returns the values.  Otherwise, returns the
+object itself.
+
+=item I<$OBJ>->Names(I<[ARRAYREF]>)
+
+Queries or replaces the internal array of user supplied names for the values
+that will be dumped.  When called without arguments, returns the names.
+Otherwise, returns the object itself.
+
+=item I<$OBJ>->Reset
+
+Clears the internal table of "seen" references and returns the object
+itself.
+
+=back
+
+=head2 Functions
+
+=over 4
+
+=item Dumper(I<LIST>)
+
+Returns the stringified form of the values in the list, subject to the
+configuration options below.  The values will be named C<$VAR>I<n> in the
+output, where I<n> is a numeric suffix.  Will return a list of strings
+in an array context.
+
+=item DumperX(I<LIST>)
+
+Identical to the C<Dumper()> function above, but this calls the XSUB 
+implementation.  Only available if you were able to compile and install
+the XSUB extensions in C<Data::Dumper>.
+
+=back
+
+=head2 Configuration Variables or Methods
+
+Several configuration variables can be used to control the kind of output
+generated when using the procedural interface.  These variables are usually
+C<local>ized in a block so that other parts of the code are not affected by
+the change.  
+
+These variables determine the default state of the object created by calling
+the C<new> method, but cannot be used to alter the state of the object
+thereafter.  The equivalent method names should be used instead to query
+or set the internal state of the object.
+
+The method forms return the object itself when called with arguments,
+so that they can be chained together nicely.
+
+=over 4
+
+=item $Data::Dumper::Indent  I<or>  I<$OBJ>->Indent(I<[NEWVAL]>)
+
+Controls the style of indentation.  It can be set to 0, 1, 2 or 3.  Style 0
+spews output without any newlines, indentation, or spaces between list
+items.  It is the most compact format possible that can still be called
+valid perl.  Style 1 outputs a readable form with newlines but no fancy
+indentation (each level in the structure is simply indented by a fixed
+amount of whitespace).  Style 2 (the default) outputs a very readable form
+which takes into account the length of hash keys (so the hash value lines
+up).  Style 3 is like style 2, but also annotates the elements of arrays
+with their index (but the comment is on its own line, so array output
+consumes twice the number of lines).  Style 2 is the default.
+
+=item $Data::Dumper::Purity  I<or>  I<$OBJ>->Purity(I<[NEWVAL]>)
+
+Controls the degree to which the output can be C<eval>ed to recreate the
+supplied reference structures.  Setting it to 1 will output additional perl
+statements that will correctly recreate nested references.  The default is
+0.
+
+=item $Data::Dumper::Pad  I<or>  I<$OBJ>->Pad(I<[NEWVAL]>)
+
+Specifies the string that will be prefixed to every line of the output.
+Empty string by default.
+
+=item $Data::Dumper::Varname  I<or>  I<$OBJ>->Varname(I<[NEWVAL]>)
+
+Contains the prefix to use for tagging variable names in the output. The
+default is "VAR".
+
+=item $Data::Dumper::Useqq  I<or>  I<$OBJ>->Useqq(I<[NEWVAL]>)
+
+When set, enables the use of double quotes for representing string values.
+Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
+characters will be backslashed, and unprintable characters will be output as
+quoted octal integers.  Since setting this variable imposes a performance
+penalty, the default is 0.  The C<Dumpxs()> method does not honor this
+flag yet.
+
+=item $Data::Dumper::Terse  I<or>  I<$OBJ>->Terse(I<[NEWVAL]>)
+
+When set, Data::Dumper will emit single, non-self-referential values as
+atoms/terms rather than statements.  This means that the C<$VAR>I<n> names
+will be avoided where possible, but be advised that such output may not
+always be parseable by C<eval>.
+
+=item $Data::Dumper::Freezer  I<or>  $I<OBJ>->Freezer(I<[NEWVAL]>)
+
+Can be set to a method name, or to an empty string to disable the feature.
+Data::Dumper will invoke that method via the object before attempting to
+stringify it.  This method can alter the contents of the object (if, for
+instance, it contains data allocated from C), and even rebless it in a
+different package.  The client is responsible for making sure the specified
+method can be called via the object, and that the object ends up containing
+only perl data types after the method has been called.  Defaults to an empty
+string.
+
+=item $Data::Dumper::Toaster  I<or>  $I<OBJ>->Toaster(I<[NEWVAL]>)
+
+Can be set to a method name, or to an empty string to disable the feature.
+Data::Dumper will emit a method call for any objects that are to be dumped
+using the syntax C<bless(DATA, CLASS)->METHOD()>.  Note that this means that
+the method specified will have to perform any modifications required on the
+object (like creating new state within it, and/or reblessing it in a
+different package) and then return it.  The client is responsible for making
+sure the method can be called via the object, and that it returns a valid
+object.  Defaults to an empty string.
+
+=item $Data::Dumper::Deepcopy  I<or>  $I<OBJ>->Deepcopy(I<[NEWVAL]>)
+
+Can be set to a boolean value to enable deep copies of structures.
+Cross-referencing will then only be done when absolutely essential
+(i.e., to break reference cycles).  Default is 0.
+
+=item $Data::Dumper::Quotekeys  I<or>  $I<OBJ>->Quotekeys(I<[NEWVAL]>)
+
+Can be set to a boolean value to control whether hash keys are quoted.
+A false value will avoid quoting hash keys when it looks like a simple
+string.  Default is 1, which will always enclose hash keys in quotes.
+
+=item $Data::Dumper::Bless  I<or>  $I<OBJ>->Bless(I<[NEWVAL]>)
+
+Can be set to a string that specifies an alternative to the C<bless>
+builtin operator used to create objects.  A function with the specified
+name should exist, and should accept the same arguments as the builtin.
+Default is C<bless>.
+
+=back
+
+=head2 Exports
+
+=over 4
+
+=item Dumper
+
+=back
+
+=head1 EXAMPLES
+
+Run these code snippets to get a quick feel for the behavior of this
+module.  When you are through with these examples, you may want to
+add or change the various configuration variables described above,
+to see their behavior.  (See the testsuite in the Data::Dumper
+distribution for more examples.)
+
+
+    use Data::Dumper;
+
+    package Foo;
+    sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]};
+
+    package Fuz;                       # a weird REF-REF-SCALAR object
+    sub new {bless \($_ = \ 'fu\'z'), $_[0]};
+
+    package main;
+    $foo = Foo->new;
+    $fuz = Fuz->new;
+    $boo = [ 1, [], "abcd", \*foo,
+             {1 => 'a', 023 => 'b', 0x45 => 'c'}, 
+             \\"p\q\'r", $foo, $fuz];
+    
+    ########
+    # simple usage
+    ########
+
+    $bar = eval(Dumper($boo));
+    print($@) if $@;
+    print Dumper($boo), Dumper($bar);  # pretty print (no array indices)
+
+    $Data::Dumper::Terse = 1;          # don't output names where feasible
+    $Data::Dumper::Indent = 0;         # turn off all pretty print
+    print Dumper($boo), "\n";
+
+    $Data::Dumper::Indent = 1;         # mild pretty print
+    print Dumper($boo);
+
+    $Data::Dumper::Indent = 3;         # pretty print with array indices
+    print Dumper($boo);
+
+    $Data::Dumper::Useqq = 1;          # print strings in double quotes
+    print Dumper($boo);
+    
+    
+    ########
+    # recursive structures
+    ########
+    
+    @c = ('c');
+    $c = \@c;
+    $b = {};
+    $a = [1, $b, $c];
+    $b->{a} = $a;
+    $b->{b} = $a->[1];
+    $b->{c} = $a->[2];
+    print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
+    
+    
+    $Data::Dumper::Purity = 1;         # fill in the holes for eval
+    print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
+    
+    
+    $Data::Dumper::Deepcopy = 1;       # avoid cross-refs
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
+    
+    
+    $Data::Dumper::Purity = 0;         # avoid cross-refs
+    print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
+    
+    
+    ########
+    # object-oriented usage
+    ########
+    
+    $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+    $d->Seen({'*c' => $c});            # stash a ref without printing it
+    $d->Indent(3);
+    print $d->Dump;
+    $d->Reset->Purity(0);              # empty the seen cache
+    print join "----\n", $d->Dump;
+    
+    
+    ########
+    # persistence
+    ########
+    
+    package Foo;
+    sub new { bless { state => 'awake' }, shift }
+    sub Freeze {
+        my $s = shift;
+	print STDERR "preparing to sleep\n";
+	$s->{state} = 'asleep';
+	return bless $s, 'Foo::ZZZ';
+    }
+    
+    package Foo::ZZZ;
+    sub Thaw {
+        my $s = shift;
+	print STDERR "waking up\n";
+	$s->{state} = 'awake';
+	return bless $s, 'Foo';
+    }
+    
+    package Foo;
+    use Data::Dumper;
+    $a = Foo->new;
+    $b = Data::Dumper->new([$a], ['c']);
+    $b->Freezer('Freeze');
+    $b->Toaster('Thaw');
+    $c = $b->Dump;
+    print $c;
+    $d = eval $c;
+    print Data::Dumper->Dump([$d], ['d']);
+    
+    
+    ########
+    # symbol substitution (useful for recreating CODE refs)
+    ########
+    
+    sub foo { print "foo speaking\n" }
+    *other = \&foo;
+    $bar = [ \&other ];
+    $d = Data::Dumper->new([\&other,$bar],['*other','bar']);
+    $d->Seen({ '*foo' => \&foo });
+    print $d->Dump;
+
+
+=head1 BUGS
+
+Due to limitations of Perl subroutine call semantics, you cannot pass an
+array or hash.  Prepend it with a C<\> to pass its reference instead.  This
+will be remedied in time, with the arrival of prototypes in later versions
+of Perl.  For now, you need to use the extended usage form, and prepend the
+name with a C<*> to output it as a hash or array.
+
+C<Data::Dumper> cheats with CODE references.  If a code reference is
+encountered in the structure being processed, an anonymous subroutine that
+contains the string '"DUMMY"' will be inserted in its place, and a warning
+will be printed if C<Purity> is set.  You can C<eval> the result, but bear
+in mind that the anonymous sub that gets created is just a placeholder.
+Someday, perl will have a switch to cache-on-demand the string
+representation of a compiled piece of code, I hope.  If you have prior
+knowledge of all the code refs that your data structures are likely
+to have, you can use the C<Seen> method to pre-seed the internal reference
+table and make the dumped output point to them, instead.  See L<EXAMPLES>
+above.
+
+The C<Useqq> flag is not honored by C<Dumpxs()> (it always outputs
+strings in single quotes).
+
+SCALAR objects have the weirdest looking C<bless> workaround.
+
+
+=head1 AUTHOR
+
+Gurusamy Sarathy        gsar@umich.edu
+
+Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+
+=head1 VERSION
+
+Version 2.09    (9 July 1998)
+
+=head1 SEE ALSO
+
+perl(1)
+
+=cut