[asperl] integrate latest win32 branch

p4raw-id: //depot/asperl@569
author: Gurusamy Sarathy <gsar@cpan.org> 1998-02-22 03:09:55 +0000
committer: Gurusamy Sarathy <gsar@cpan.org> 1998-02-22 03:09:55 +0000
commit: 611e57134ef8720264c53f5e0589f41461af4dcb (patch)
tree: 7901de389646fca2b4f19dc03c78c679f294afa4
parent: 6ad2b1bc3b01dc0cbc9f3d6840532b8e64de9f53 (diff)
parent: 2a321948466e7bb48bfd30dd6612a9a479df612a (diff)
download: perl-611e57134ef8720264c53f5e0589f41461af4dcb.tar.gz
100 files changed, 11784 insertions, 1021 deletions
diff --git a/Configure b/Configure
index df610b2b34..62249dd580 100755
--- a/Configure
+++ b/Configure
@@ -10448,7 +10448,7 @@ d_setgrps='$d_setgrps'
 d_gethbyaddr='$d_gethbyaddr'
 netdb_host_type='$netdb_host_type'
 netdb_hlen_type='$netdb_hlen_type'
-d_gethbynam='$d_gethbynam'
+d_gethbyname='$d_gethbyname'
 netdb_name_type='$netdb_name_type'
 d_gethent='$d_gethent'
 d_gethname='$d_gethname'
diff --git a/INSTALL b/INSTALL
index f8931aea76..4814d84bf9 100644
--- a/INSTALL
+++ b/INSTALL
@@ -930,7 +930,18 @@ to test your version of miniperl.
 If you have any locale-related environment variables set, try
 unsetting them.  I have some reports that some versions of IRIX hang
 while running B<./miniperl configpm> with locales other than the C
-locale.  See the discussion under L<make test> below about locales.
+locale.  See the discussion under L<"make test"> below about locales
+and the whole L<Locale problems> section in the file pod/perllocale.pod.
+The latter is especially useful if you see something like this
+
+	perl: warning: Setting locale failed.
+	perl: warning: Please check that your locale settings:
+	        LC_ALL = "En_US",
+	        LANG = (unset)
+	    are supported and installed on your system.
+	perl: warning: Falling back to the standard locale ("C").
+
+at Perl startup.
 
 =item malloc duplicates
 
diff --git a/MANIFEST b/MANIFEST
index 84d65069a3..a0e0dd5a63 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -31,6 +31,11 @@ Todo.5.005		What needs doing before 5.005 release
 XSUB.h			Include file for extension subroutines
 av.c			Array value code
 av.h			Array value header
+bytecode.h		Bytecode header for compiler
+bytecode.pl		Produces byterun.h, byterun.c and ext/B/Asmdata.pm
+byterun.c		Runtime support for compiler-generated bytecode
+byterun.h		Header for byterun.c
+cc_runtime.h		Macros need by runtime of compiler-generated code
 cflags.SH		A script that emits C compilation flags per file
 compat3.sym		List of symbols for binary-compatibility with 5.003
 config_H		Sample config.h
@@ -120,6 +125,40 @@ emacs/ptags		Creates smart TAGS file
 embed.h			Maps symbols to safer names
 embed.pl		Produces embed.h
 embedvar.h		C namespace management
+ext/B/B.pm		Compiler backend support functions and methods
+ext/B/B.xs		Compiler backend external subroutines
+ext/B/B/Asmdata.pm	Compiler backend data for assembler
+ext/B/B/Assembler.pm	Compiler backend assembler support functions
+ext/B/B/Bblock.pm	Compiler basic block analysis support
+ext/B/B/Bytecode.pm	Compiler Bytecode backend
+ext/B/B/C.pm		Compiler C backend
+ext/B/B/CC.pm		Compiler CC backend
+ext/B/B/Debug.pm	Compiler Debug backend
+ext/B/B/Deparse.pm	Compiler Deparse backend
+ext/B/B/Disassembler.pm	Compiler Disassembler backend
+ext/B/B/Lint.pm		Compiler Lint backend
+ext/B/B/Showlex.pm	Compiler Showlex backend
+ext/B/B/Stackobj.pm	Compiler stack objects support functions
+ext/B/B/Terse.pm	Compiler Terse backend
+ext/B/B/Xref.pm		Compiler Xref backend
+ext/B/B/assemble	Assemble compiler bytecode
+ext/B/B/cc_harness	Simplistic wrapper for using -MO=CC compiler
+ext/B/B/disassemble	Disassemble compiler bytecode output
+ext/B/B/makeliblinks	Make a simplistic XSUB .so symlink tree for compiler
+ext/B/Makefile.PL	Compiler backend makefile writer
+ext/B/NOTES		Compiler backend notes
+ext/B/O.pm		Compiler front-end module (-MO=...)
+ext/B/README		Compiler backend README
+ext/B/TESTS		Compiler backend test data
+ext/B/Todo		Compiler backend Todo list
+ext/B/byteperl.c	Bytecode runner
+ext/B/ramblings/cc.notes	Compiler ramblings: notes on CC backend
+ext/B/ramblings/curcop.runtime	Compiler ramblings: notes on curcop use
+ext/B/ramblings/flip-flop	Compiler ramblings: notes on flip-flop
+ext/B/ramblings/magic		Compiler ramblings: notes on magic
+ext/B/ramblings/reg.alloc	Compiler ramblings: register allocation
+ext/B/ramblings/runtime.porting	Compiler ramblings: porting PP enging
+ext/B/typemap		Compiler backend interface types
 ext/DB_File/Changes		Berkeley DB extension change log
 ext/DB_File/DB_File.pm		Berkeley DB extension Perl module
 ext/DB_File/DB_File.xs		Berkeley DB extension external subroutines
@@ -424,6 +463,7 @@ lib/Sys/Syslog.pm	Perl module supporting syslogging
 lib/Term/Cap.pm		Perl module supporting termcap usage
 lib/Term/Complete.pm	A command completion subroutine
 lib/Term/ReadLine.pm	Stub readline library
+lib/Test.pm		A simple framework for writing test scripts
 lib/Test/Harness.pm	A test harness
 lib/Text/Abbrev.pm	An abbreviation table builder
 lib/Text/ParseWords.pm	Perl module to split words on arbitrary delimiter
@@ -823,6 +863,7 @@ t/op/undef.t		See if undef works
 t/op/universal.t	See if UNIVERSAL class works
 t/op/unshift.t		See if unshift works
 t/op/vec.t		See if vectors work
+t/op/wantarray.t	See if wantarray works
 t/op/write.t		See if write works
 t/pragma/constant.t	See if compile-time constants work
 t/pragma/locale.t	See if locale support (i18n and l10n) works
diff --git a/Makefile.SH b/Makefile.SH
index d334525873..4280570916 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -405,10 +405,13 @@ perly.c: perly.y
 perly.h: perly.y
 	-@sh -c true
 
-# The following three header files are generated automatically
+# 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
 # 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
@@ -417,6 +420,7 @@ regen_headers:	FORCE
 	perl keywords.pl
 	perl opcode.pl
 	perl embed.pl
+	perl bytecode.pl
 
 # Extensions:
 # Names added to $(dynamic_ext) or $(static_ext) will automatically
diff --git a/README.vms b/README.vms
index 4b8c29d345..40de6acac7 100644
--- a/README.vms
+++ b/README.vms
@@ -207,6 +207,13 @@ PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T
 7) Optionally define the command PERLBUG (the Perl bug report generator) as
 PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
 
+8) Optionally define the command POD2MAN (Converts POD files to nroff
+source suitable for converting to man pages. Also quiets complaints during
+module builds) as
+
+DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
+POD2MAN :== $PERL_ROOT:[000000]PERL POD2MAN
+
 * Installing Perl into DCLTABLES
 
 Courtesy of Brad  Hughes:
@@ -373,367 +380,3 @@ have made our sleepless nights possible.
 
 Thanks,
 The VMSperl group
-
-
----------------------------------------------------------------------------
-[Here's the pre-5.004_04 version of README.vms, for the record.]
-
-Last revised: 19-Jan-1996 by Charles Bailey  bailey@genetics.upenn.edu
-
-The VMS port of Perl is still under development.  At this time, the Perl
-binaries built under VMS handle internal operations properly, for the most
-part, as well as most of the system calls which have close equivalents under
-VMS. There are still some incompatibilities in process handling (e.g the
-fork/exec model for creating subprocesses doesn't do what you might expect
-under Unix), and there remain some file handling differences from Unix.  Over
-the longer term, we'll try to get many of the useful VMS system services
-integrated as well, depending on time and people available.  Of course, if
-you'd like to add something yourself, or join the porting team, we'd love to
-have you!
-
-The current sources and build procedures have been tested on a VAX using VAXC
-and DECC, and on an AXP using DECC.  If you run into problems with other
-compilers, please let us know.
-
-Note to DECC users: Some early versions of the DECCRTL contained a few bugs
-which affect Perl performance:
-    - Newlines are lost on I/O through pipes, causing lines to run together.
-      This shows up as RMS RTB errors when reading from a pipe.  You can
-      work around this by having one process write data to a file, and
-      then having the other read the file, instead of the pipe.  This is
-      fixed in version 4 of DECC.
-    - The modf() routine returns a non-integral value for some values above
-      INT_MAX; the Perl "int" operator will return a non-integral value in
-      these cases.  This is fixed in version 4 of DECC.
-    - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine 
-      changes the process default device and directory permanently, even
-      though the call specified that the change should not persist after
-      Perl exited.  This is fixed by DEC CSC patch AXPACRT04_061.
-
-* Other software required
-
-At the moment, in addition to basic VMS, you'll need two things:
-   - a C compiler: VAXC, DECC, or gcc for the VAX; DECC for the AXP
-   - a make tool: DEC's MMS (version 2.6 or later) or the free analog MMK
-     (available from ftp.spc.edu), or a standard make utility (e.g. GNU make,
-     also available from ftp.spc.edu).
-In addition, you may include socket support if you have an IP stack running
-on your system.  See the topic "Socket support" for more information.
-
-* Socket support
-
-Perl includes a number of IP socket routines among its builtin functions,
-which are available if you choose to compile Perl with socket support.  Since
-IP networking is an optional addition to VMS, there are several different IP
-stacks available, so it's difficult to automate the process of building Perl
-with socket support in a way which will work on all systems.  
-
-By default, Perl is built without IP socket support.  If you define the macro
-SOCKET when invoking MMK, however, socket support will be included.  As
-distributed, Perl for VMS includes support for the SOCKETSHR socket library,
-which is layered on MadGoat software's vendor-independent NETLIB interface. 
-This provides support for all socket calls used by Perl except the
-[g|s]etnet*() routines, which are replaced for the moment by stubs which
-generate a fatal error if a Perl script attempts to call one of these routines. 
-Both SOCKETSHR and NETLIB are available from MadGoat ftp sites, such as
-ftp.spc.edu or ftp.wku.edu.
-
-You can link Perl directly to your TCP/IP stack's library, *as long as* it
-supplies shims for stdio routines which will properly handle both sockets and
-normal file descriptors.  This is necessary because Perl does not distinguish
-between the two, and will try to make normal stdio calls such as read() and
-getc() on socket file descriptors.  If you'd like to link Perl directly to
-your IP stack, then make the following changes:
-  - In Descrip.MMS, locate the section beginning with .ifdef SOCKET, and
-    change the SOCKLIB macro so that it translates to  the filespec of your
-    IP stack's socket library.  This will be added to the RTL options file.
-  - Edit the file SockAdapt.H in the [.VMS] subdirectory so that it
-    includes the Socket.H, In.H, Inet.H, NetDb.H, and, if necessary,
-    Errno.H header files for your IP stack, or so that it declares the
-    standard TCP/IP constants and data structures appropriately.  (See
-    the distributed copy of SockAdapt.H for a collection of the structures
-    needed by Perl itself, and [.ext.Socket]Socket.xs for a list of the
-    constants used by the Socket extension, if you elect to built it.)
-    You should also define any logical names necessary for your C compiler
-    to find these files before invoking MM[KS] to build Perl.
-  - Edit the file SockAdapt.C in the [.VMS] subdirectory so that it
-    contains routines which substitute for any IP library routines
-    required by Perl which your IP stack does not provide.  This may
-    require a little trial and error; we'll try to compile a complete
-    list soon of socket routines required by Perl.
-
-
-* Building Perl under VMS
-
-Since you're reading this, presumably you've unpacked the Perl distribution
-into its directory tree, in which you will find a [.vms] subdirectory below
-the directory in which this file is found.  If this isn't the case, then you'll
-need to unpack the distribution properly, or manually edit Descrip.MMS or
-the VMS Makefile to alter directory paths as necessary.  (I'd advise using the 
-`normal' directory tree, at least for the first time through.)  This
-subdirectory contains several files, among which are the following:
-  Config.VMS     - A template Config.H set up for VMS.
-  Descrip.MMS    - The MMS/MMK dependency file for building Perl
-  GenConfig.Pl   - A Perl script to generate Config.SH retrospectively
-                   from Config.VMS, since the Configure shell script which
-                   normally generates Config.SH doesn't run under VMS.
-  GenOpt.Com     - A little DCL procedure used to write some linker options
-                   files, since not all make utilities can do this easily.
-  Gen_ShrFls.Pl  - A Perl script which generates linker options files and
-                   MACRO declarations for PerlShr.Exe.
-  Makefile       - The make dependency file for building Perl  
-  MMS2Make.Pl    - A Perl script used to generate Makefile from Descrip.MMS
-  PerlVMS.pod    - Documentation for VMS-specific behavior of Perl
-  Perly_[CH].VMS - Versions of the byacc output from Perl's grammar,
-                   modified to include VMS-specific C compiler options
-  SockAdapt.[CH] - C source code used to integrate VMS TCP/IP support
-  Test.Com       - DCL driver for Perl regression tests
-  VMSish.H       - C header file containing VMS-specific definitions
-  VMS.C          - C source code for VMS-specific routines
-  VMS_Yfix.Pl    - Perl script to convert Perly.[CH] to Perly_[CH].VMS
-  WriteMain.Pl   - Perl script to generate Perlmain.C
-The [.Ext...] directories contain VMS-specific extensions distributed with
-Perl.  There may also be other files in [.VMS...] pertaining to features under
-development; for the most part, you can ignore them.  Note that packages in
-[.ext.*] are not built with Perl by default; you build the ones you want
-once the basic Perl build is complete (see the perlvms docs for instructions
-on building extensions.)
-
-Config.VMS and Decrip.MMS/Makefile are set up to build a version of Perl which
-includes all features known to work when this release was assembled.  If you
-have code at your site which would support additional features (e.g. emulation
-of Unix system calls), feel free to make the appropriate changes to these
-files.  (Note: Do not use or edit config.h in the main Perl source directory;
-it is superseded by the current Config.VMS during the build.)  You may also
-wish to make site-specific changes to Descrip.MMS or Makefile to reflect local
-conventions for naming of files, etc.
-
-There are several pieces of system-specific information which become part of
-the Perl Config extension.  Under VMS, the data for Config are generated by the
-script GenConfig.Pl in the [.VMS] subdirectory.  It tries to ascertain the
-necessary information from various files, or from the system itself, and
-generally does the right thing.  There is a list of hard-coded values at the
-end of this script which specifies items that are correct for most VMS systems,
-but may be incorrect for you, if your site is set up in an unusual fashion.  If
-you're familiar with Perl's Config extension, feel free to edit these values as
-necessary.  If this doesn't mean much to you, don't worry -- the information is
-probably correct, and even if it's not, none of these parameters affect your
-ability to build or run Perl.  You'll only get the wrong answer if you ask for
-it specifically from Config.
-
-Examine the information at the beginning of Descrip.MMS for information about
-specifying alternate C compilers or building a version of Perl with debugging
-support.  For instance, if you want to use DECC, you'll need to include the
-/macro="decc=1" qualifier to MMK  (If you're using make, these options are not
-supported.)  If you're on an AXP system, define the macro __AXP__ (MMK does
-this for you), and DECC will automatically be selected.
-
-To start the build, set default to the main source directory.  Since
-Descrip.MMS assumes that VMS commands have their usual meaning, and makes use
-of command-line macros, you may want to be certain that you haven't defined DCL
-symbols which would interfere with the build.  Then, if you are using MMS or
-MMK, say
-$ MMS/Descrip=[.VMS] ! or MMK
-(N.B. If you are using MMS, you must use version 2.6 or later; a bug in
-earlier versions produces malformed cc command lines.)  If you are using a
-version of make, say
-$ Make -f [.VMS]Makefile
-Note that the Makefile doesn't support conditional compilation, is
-set up to use VAXC on a VAX, and does not include socket support.  You can
-either edit the Makefile by hand, using Descrip.MMS as a guide, or use the
-Makefile to build Miniperl.Exe, and then run the Perl script MMS2Make.pl,
-found in the [.VMS] subdirectory, to generate a new Makefile with the options
-appropriate to your site.
-
-If you are using MM[SK], and you decide to rebuild Perl with a different set
-of parameters (e.g. changing the C compiler, or adding socket support), be
-sure to say
-$ MMK/Descrip=[.VMS] realclean
-first, in order to remove files generated during the previous build.  If
-you omit this step, you risk ending up with a copy of Perl which
-composed partially of old files and partially of new ones, which may lead
-to strange effects when you try to run Perl.
-
-A bug in some early versions of the DECC RTL on the AXP causes newlines
-to be lost when writing to a pipe.  A different bug in some patched versions
-of DECC 4.0 for VAX can also scramble preprocessor output.  Finally, gcc 2.7.2
-has yet another preprocessor bug, which causes line breaks to be inserted
-into the output at inopportune times.  Each of these bugs causes Gen_ShrFls.pl
-to fail, since it can't parse the preprocessor output to identify global
-variables and routines.  This problem is generally manifested as missing
-global symbols when linking PerlShr.Exe or Perl.Exe.  You can work around
-it by defining the macro PIPES_BROKEN when you invoke MMS or MMK.
-
-
-This will build the following files:
-  Miniperl.Exe        - a stand-alone version of without any extensions.
-                        Miniperl has all the intrinsic capabilities of Perl,
-                        but cannot make use of the DynaLoader or any
-                        extensions which use XS code.
-  PerlShr.Exe         - a shareable image containing most of Perl's internal
-                        routines and global variables.  Perl.Exe is linked to
-                        this image, as are all dynamic extensions, so everyone's
-                        using the same set of global variables and routines.
-  Perl.Exe            - the main Perl executable image.  It's contains the
-                        main() routine, plus code for any statically linked
-                        extensions.
-  PerlShr_Attr.Opt    - A linker options file which specifies psect attributes
-                        matching those in PerlShr.Exe.  It should be used when
-                        linking images against PerlShr.Exe
-  PerlShr_Bld.Opt     - A linker options file which specifies various things
-                        used to build PerlShr.Exe.  It should be used when
-                        rebuilding PerlShr.Exe via MakeMaker-produced
-                        Descrip.MMS files for static extensions.
-  c2ph                - Perl program which generates template code to access
-                        C struct members from Perl.
-  h2ph                - Perl program which generates template code to access
-                        #defined constants in a C header file from Perl,
-                        using the "old-style" interface.  (Largely supplanted
-                        by h2xs.)
-  h2xs                - Perl program which generates template files for creating
-                        XSUB extensions, optionally beginning with the #defined
-                        constants in a C header file.
-  [.lib.pod]perldoc   - A Perl program which locates and displays documentation
-                        for Perl and its extensions.
-  [.Lib]Config.pm     - the Perl extension which saves configuration information
-                        about Perl and your system.
-  [.Lib]DynaLoader.pm - The Perl extension which performs dynamic linking of
-                        shareable images for extensions.
-  Several subdirectories under [.Lib] containing preprocessed files or
-                        site-specific files.
-There are, of course, a number of other files created for use during the build. 
-Once you've got the binaries built, you may wish to `build' the `tidy' or
-`clean' targets to remove extra files.
-
-If you run into problems during the build, you can get help from the VMSPerl
-or perl5-porters mailing lists (see below).  When you report the problem,
-please include the following information:
-  - The version of Perl you're trying to build.  Please include any
-    "letter" patchlevel, in addition to the version number.  If the
-    build successfully created Miniperl.Exe, you can check this by
-    saying '$ MCR Sys$Disk:[]Miniperl -v'.  Also, please mention
-    where you obtained the distribution kit; in particular, note
-    whether you were using a basic Perl kit or the VMS test kit
-    (see below).
-  - The exact command you issued to build Perl.
-  - A copy of all error messages which were generated during the build.
-    Please include enough of the build log to establish the context of
-    the error messages.
-  - A summary of your configuration.  If the build progressed far enough
-    to generate Miniperl.Exe and [.Lib]Config.pm, you can obtain this
-    by saying '$ MCR Sys$Disk:[]Miniperl "-V"' (note the "" around -V).
-    If not, then you can say '$ MMK/Descrip=[.VMS] printconfig' to
-    produce the summary.
-This may sound like a lot of information to send, but it'll often make
-it easier for someone to spot the problem, instead of having to give
-a spectrum of possibilities.
-  
-
-
-* Installing Perl once it's built
-
-Once the build is complete, you'll need to do the following:
-  - Put PerlShr.Exe in a common directory, and make it world-readable.
-    If you place it in a location other than Sys$Share, you'll need to
-    define the logical name PerlShr to point to the image.  (If you're
-    installing on a VMScluster, be sure that each node is using the
-    copy of PerlShr you expect [e.g. if you put PerlShr.Exe in Sys$Share,
-    do they all share Sys$Share?]).
-  - Put Perl.Exe in a common directory, and make it world-executable.
-  - Define a foreign command to invoke Perl, using a statement like
-    $ Perl == "$dev:[dir]Perl.Exe"
-  - Create a world-readable directory tree for Perl library modules,
-    scripts, and what-have-you, and define PERL_ROOT as a rooted logical
-    name pointing to the top of this tree (i.e. if your Perl files were
-    going to live in DKA1:[Util.Perl5...], then you should
-      $ Define/Translation=Concealed Perl_Root DKA1:[Util.Perl5.]
-    (Be careful to follow the rules for rooted logical names; in particular,
-    remember that a rooted logical name cannot have as its device portion
-    another rooted logical name - you've got to supply the actual device name
-    and directory path to the root directory.)
-  - Place the files from the [.lib...] directory tree in the distribution
-    package into a [.lib...] directory tree off the root directory described
-    above.
-  - Most of the Perl documentation lives in the [.pod] subdirectory, and
-    is written in a simple markup format which can be easily read.  In this
-    directory as well are pod2man and pod2html translators to reformat the
-    docs for common display engines; a pod2hlp translator is under development.
-    These files are copied to [.lib.pod] during the installation.
-  - Define a foreign command to execute perldoc, such as
-    $ Perldoc == "''Perl' Perl_Root:[lib.pod]Perldoc -t"
-    This will allow users to retrieve documentation using Perldoc.  For
-    more details, say "perldoc perldoc".
-That's it.
-
-If you run into a bug in Perl, please submit a bug report.  The PerlBug
-program, found in the [.lib] directory, will walk you through the process
-of assembling the necessary information into a bug report, and sending
-of to the Perl bug reporting address, perlbug@perl.com.
-
-* For more information
-
-If you're interested in more information on Perl in general, you may wish to
-consult the Usenet newsgroups comp.lang.perl.announce and comp.lang.perl.misc.
-The FAQ for these groups provides pointers to other online sources of
-information, as well as books describing Perl in depth.
-
-If you're interested in up-to-date information on Perl development and
-internals, you might want to subscribe to the perl5-porters mailing list.  You
-can do this by sending a message to perl5-porters-request@nicoh.com, containing
-the single line
-subscribe perl5-porters
-This is a high-volume list at the moment (>50 messages/day).
-
-If you're interested in ongoing information about the VMS port, you can
-subscribe to the VMSPerl mailing list by sending a request to
-vmsperl-request@genetics.upenn.edu, containing the single line
-subscribe VMSPerl
-as the body of the message.  And, as always, we welcome any help or code you'd
-like to offer - you can send mail to bailey@genetics.upenn.edu or directly to
-the VMSPerl list at vmsperl@genetics.upenn.edu.
-
-Finally, if you'd like to try out the latest changes to VMS Perl, you can
-retrieve a test distribution kit by anonymous ftp from genetics.upenn.edu, in
-the file [.perl5]perl5_ppp_yymmddx.zip, where "ppp" is the current Perl
-patchlevel, and "yymmddx" is a sequence number indicating the date that
-particular kit was assembled.  In order to make retrieval convenient, this
-kit is also available by the name Perl5_VMSTest.Zip.  These test kits contain
-"unofficial" patches from the perl5-porters group, test patches for important
-bugs, and VMS-specific fixes and improvements which have occurred since the
-last Perl release.  Most of these changes will be incorporated in the next
-release of Perl, but until Larry Wall's looked at them and said they're OK,
-none of them should be considered official.
-
-Good luck using Perl.  Please let us know how it works for you - we can't
-guarantee that we'll be able to fix bugs quickly, but we'll try, and we'd
-certainly like to know they're out there.
-
-
-* Acknowledgements
-
-There are, of course, far too many people involved in the porting and testing
-of Perl to mention everyone who deserves it, so please forgive us if we've
-missed someone.  That said, special thanks are due to the following:
-  Tim Adye <T.J.Adye@rl.ac.uk>
-     for the VMS emulations of getpw*()
-  David Denholm <denholm@conmat.phys.soton.ac.uk>
-     for extensive testing and provision of pipe and SocketShr code,
-  Mark Pizzolato <mark@infocomm.com>
-     for the getredirection() code
-  Rich Salz <rsalz@bbn.com>
-     for readdir() and related routines
-  Peter Prymmer <pvhp@lns62.lns.cornell.edu)
-     for extensive testing, as well as development work on
-     configuration and documentation for VMS Perl,
-  the Stanford Synchrotron Radiation Laboratory and the
-     Laboratory of Nuclear Studies at Cornell University for
-     the the opportunity to test and develop for the AXP,
-and to the entire VMSperl group for useful advice and suggestions.  In addition
-the perl5-porters, especially Andy Dougherty <doughera@lafcol.lafayette.edu>
-and Tim Bunce <Tim.Bunce@ig.co.uk>,  deserve credit for their creativity and
-willingness to work with the VMS newcomers.  Finally, the greatest debt of
-gratitude is due to Larry Wall <larry@wall.org>, for having the ideas which
-have made our sleepless nights possible.
-
-Thanks,
-The VMSperl group
diff --git a/XSUB.h b/XSUB.h
index 73c76b1c36..dc5ee194a5 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -10,7 +10,7 @@
 #define XS(name) void name(cv) CV* cv;
 #endif
 
-#if defined(WIN32) && defined(__GNUC__)
+#if 0 /*defined(WIN32) && defined(__GNUC__)*/ /* this bug is gone in mingw32/gcc-2.8.0*/
 #define STRINGIFY_THINGY(x) #x
 #define FORCE_ARG_STRING(x) STRINGIFY_THINGY(x)
 #else
@@ -54,7 +54,7 @@
 #ifdef XS_VERSION
 # define XS_VERSION_BOOTCHECK \
     STMT_START {							\
-        char *xs_version = FORCE_ARG_STRING(XS_VERSION);			\
+        char *xs_version = FORCE_ARG_STRING(XS_VERSION);		\
 	char *vn = "", *module = SvPV(ST(0),na);			\
 	if (items >= 2)	 /* version supplied as bootstrap arg */	\
 	    Sv = ST(1);							\
diff --git a/bytecode.h b/bytecode.h
new file mode 100644
index 0000000000..bfa4025f14
--- /dev/null
+++ b/bytecode.h
@@ -0,0 +1,168 @@
+typedef char *pvcontents;
+typedef char *strconst;
+typedef U32 PV;
+typedef char *op_tr_array;
+typedef int comment;
+typedef SV *svindex;
+typedef OP *opindex;
+typedef IV IV64;
+
+EXT int iv_overflows INIT(0);
+void *bset_obj_store _((void *, I32));
+void freadpv _((U32, void *));
+
+EXT SV *sv;
+#ifndef USE_THREADS
+EXT OP *op;
+#endif
+EXT XPV pv;
+
+EXT void **obj_list;
+EXT I32 obj_list_fill INIT(-1);
+
+#ifdef INDIRECT_BGET_MACROS
+#define FREAD(argp, len, nelem) bs.fread((char*)(argp),(len),(nelem),bs.data)
+#define FGETC() bs.fgetc(bs.data)
+#else
+#define FREAD(argp, len, nelem) fread((argp), (len), (nelem), fp)
+#define FGETC() getc(fp)
+#endif /* INDIRECT_BGET_MACROS */
+
+#define BGET_U32(arg)	FREAD(&arg, sizeof(U32), 1); arg = ntohl((U32)arg)
+#define BGET_I32(arg)	FREAD(&arg, sizeof(I32), 1); arg = (I32)ntohl((U32)arg)
+#define BGET_U16(arg)	FREAD(&arg, sizeof(U16), 1); arg = ntohs((U16)arg)
+#define BGET_U8(arg)	arg = FGETC()
+
+#if INDIRECT_BGET_MACROS
+#define BGET_PV(arg)	do {		\
+	BGET_U32(arg);			\
+	if (arg)			\
+	    bs.freadpv(arg, bs.data);	\
+	else {				\
+	    pv.xpv_pv = 0;		\
+	    pv.xpv_len = 0;		\
+	    pv.xpv_cur = 0;		\
+	}				\
+    } while (0)
+#else
+#define BGET_PV(arg)	do {			\
+	BGET_U32(arg);				\
+	if (arg) {				\
+	    New(666, pv.xpv_pv, arg, char);	\
+	    fread(pv.xpv_pv, 1, arg, fp);	\
+	    pv.xpv_len = arg;			\
+	    pv.xpv_cur = arg - 1;		\
+	} else {				\
+	    pv.xpv_pv = 0;			\
+	    pv.xpv_len = 0;			\
+	    pv.xpv_cur = 0;			\
+	}					\
+    } while (0)
+#endif /* INDIRECT_BGET_MACROS */
+
+#define BGET_comment(arg) \
+	do { arg = 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) do {				\
+	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 {						\
+	    iv_overflows++;				\
+	    arg = 0;					\
+	}						\
+    } while (0)
+
+#define BGET_op_tr_array(arg) do {	\
+	unsigned short *ary;		\
+	int i;				\
+	New(666, ary, 256, unsigned short); \
+	FREAD(ary, 256, 2);		\
+	for (i = 0; i < 256; i++)	\
+	    ary[i] = ntohs(ary[i]);	\
+	arg = (char *) ary;		\
+    } while (0)
+
+#define BGET_pvcontents(arg)	arg = pv.xpv_pv
+#define BGET_strconst(arg)	do {	\
+	for (arg = tokenbuf; (*arg = FGETC()); arg++) /* nothing */;	\
+	arg = tokenbuf;			\
+    } while (0)
+
+#define BGET_double(arg)	do {	\
+	char *str;			\
+	BGET_strconst(str);		\
+	arg = atof(str);		\
+    } while (0)
+
+#define BGET_objindex(arg) do {	\
+	U32 ix;			\
+	BGET_U32(ix);		\
+	arg = obj_list[ix];	\
+    } while (0)
+
+#define BSET_ldspecsv(sv, arg) sv = 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)	do {	\
+	gp_free((GV*)sv);		\
+	GvGP(sv) = GvGP(arg);		\
+    } while (0)
+
+#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 = pv.xpv_cur
+#define BSET_sv_upgrade(sv, arg)	(void)SvUPGRADE(sv, arg)
+#define BSET_xpv(sv)	do {	\
+	SvPV_set(sv, pv.xpv_pv);	\
+	SvCUR_set(sv, pv.xpv_cur);	\
+	SvLEN_set(sv, 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, pv.xpv_pv, pv.xpv_cur, arg, 0)
+#define BSET_pv_free(pv)	Safefree(pv.xpv_pv)
+#define BSET_pregcomp(o, arg) \
+	((PMOP*)o)->op_pmregexp = arg ? \
+		pregcomp(arg, arg + 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)	do {	\
+	OP *oldop = o;			\
+	BSET_newop(o, arg);		\
+	oldop->op_next = o;		\
+    } while (0)
+
+#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)	do {	\
+	o->op_type = arg;		\
+	if (arg == OP_MAPSTART)		\
+	    arg = OP_GREPSTART;		\
+	o->op_ppaddr = ppaddr[arg];	\
+    } while (0)
+#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 > obj_list_fill ?	\
+	bset_obj_store(obj, (I32)ix) : (obj_list[ix] = obj)
diff --git a/bytecode.pl b/bytecode.pl
new file mode 100644
index 0000000000..8eadbdd941
--- /dev/null
+++ b/bytecode.pl
@@ -0,0 +1,369 @@
+use strict;
+my %alias_to = (
+    U32 => [qw(PADOFFSET STRLEN)],
+    I32 => [qw(SSize_t long)],
+    U16 => [qw(OPCODE line_t short)],
+    U8 => [qw(char)],
+    objindex => [qw(svindex opindex)]		
+);
+
+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 &sv_undef &sv_yes &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/Asmdata.pm";
+
+#
+# Start with boilerplate for Asmdata.pm
+#
+open(ASMDATA_PM, ">ext/B/Asmdata.pm") or die "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"
+#include "bytecode.h"
+#include "byterun.h"
+
+#ifdef INDIRECT_BGET_MACROS
+void byterun(bs)
+struct bytestream bs;
+#else
+void byterun(fp)
+FILE *fp;
+#endif /* INDIRECT_BGET_MACROS */
+{
+    dTHR;
+    int insn;
+    while ((insn = 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 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*);
+};
+void freadpv _((U32, void *));
+void byterun _((struct bytestream));
+#else
+void byterun _((FILE *));
+#endif /* INDIRECT_BGET_MACROS */
+
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+#if PATCHLEVEL < 4 || (PATCHLEVEL == 4 && SUBVERSION < 50)
+#define dTHR extern int errno
+#endif
+
+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
+
+printf BYTERUN_H <<'EOT', scalar(@specialsv);
+EXT SV * specialsv_list[%d];
+#define INIT_SPECIALSV_LIST STMT_START { \
+EOT
+for ($i = 0; $i < @specialsv; $i++) {
+    print BYTERUN_H "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;
+EOT
+
+__END__
+# First set instruction ord("#") to read comment to end-of-line (sneaky)
+%number 35
+comment		arg			comment
+# 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		sv			svindex
+ldop		op			opindex
+stsv		sv			U32		s
+stop		op			U32		s
+ldspecsv	sv			U8		x
+newsv		sv			U8		x
+newop		op			U8		x
+newopn		op			U8		x
+newpv		none			PV
+pv_cur		pv.xpv_cur		STRLEN
+pv_free		pv			none		x
+sv_upgrade	sv			char		x
+sv_refcnt	SvREFCNT(sv)		U32
+sv_refcnt_add	SvREFCNT(sv)		I32		x
+sv_flags	SvFLAGS(sv)		U32
+xrv		SvRV(sv)		svindex
+xpv		sv			none		x
+xiv32		SvIVX(sv)		I32
+xiv64		SvIVX(sv)		IV64
+xnv		SvNVX(sv)		double
+xlv_targoff	LvTARGOFF(sv)		STRLEN
+xlv_targlen	LvTARGLEN(sv)		STRLEN
+xlv_targ	LvTARG(sv)		svindex
+xlv_type	LvTYPE(sv)		char
+xbm_useful	BmUSEFUL(sv)		I32
+xbm_previous	BmPREVIOUS(sv)		U16
+xbm_rare	BmRARE(sv)		U8
+xfm_lines	FmLINES(sv)		I32
+xio_lines	IoLINES(sv)		long
+xio_page	IoPAGE(sv)		long
+xio_page_len	IoPAGE_LEN(sv)		long
+xio_lines_left	IoLINES_LEFT(sv)	long
+xio_top_name	IoTOP_NAME(sv)		pvcontents
+xio_top_gv	*(SV**)&IoTOP_GV(sv)	svindex
+xio_fmt_name	IoFMT_NAME(sv)		pvcontents
+xio_fmt_gv	*(SV**)&IoFMT_GV(sv)	svindex
+xio_bottom_name	IoBOTTOM_NAME(sv)	pvcontents
+xio_bottom_gv	*(SV**)&IoBOTTOM_GV(sv)	svindex
+xio_subprocess	IoSUBPROCESS(sv)	short
+xio_type	IoTYPE(sv)		char
+xio_flags	IoFLAGS(sv)		char
+xcv_stash	*(SV**)&CvSTASH(sv)	svindex
+xcv_start	CvSTART(sv)		opindex
+xcv_root	CvROOT(sv)		opindex
+xcv_gv		*(SV**)&CvGV(sv)	svindex
+xcv_filegv	*(SV**)&CvFILEGV(sv)	svindex
+xcv_depth	CvDEPTH(sv)		long
+xcv_padlist	*(SV**)&CvPADLIST(sv)	svindex
+xcv_outside	*(SV**)&CvOUTSIDE(sv)	svindex
+xcv_flags	CvFLAGS(sv)		U8
+av_extend	sv			SSize_t		x
+av_push		sv			svindex		x
+xav_fill	AvFILLp(sv)		SSize_t
+xav_max		AvMAX(sv)		SSize_t
+xav_flags	AvFLAGS(sv)		U8
+xhv_riter	HvRITER(sv)		I32
+xhv_name	HvNAME(sv)		pvcontents
+hv_store	sv			svindex		x
+sv_magic	sv			char		x
+mg_obj		SvMAGIC(sv)->mg_obj	svindex
+mg_private	SvMAGIC(sv)->mg_private	U16
+mg_flags	SvMAGIC(sv)->mg_flags	U8
+mg_pv		SvMAGIC(sv)		pvcontents	x
+xmg_stash	*(SV**)&SvSTASH(sv)	svindex
+gv_fetchpv	sv			strconst	x
+gv_stashpv	sv			strconst	x
+gp_sv		GvSV(sv)		svindex
+gp_refcnt	GvREFCNT(sv)		U32
+gp_refcnt_add	GvREFCNT(sv)		I32		x
+gp_av		*(SV**)&GvAV(sv)	svindex
+gp_hv		*(SV**)&GvHV(sv)	svindex
+gp_cv		*(SV**)&GvCV(sv)	svindex
+gp_filegv	*(SV**)&GvFILEGV(sv)	svindex
+gp_io		*(SV**)&GvIOp(sv)	svindex
+gp_form		*(SV**)&GvFORM(sv)	svindex
+gp_cvgen	GvCVGEN(sv)		U32
+gp_line		GvLINE(sv)		line_t
+gp_share	sv			svindex		x
+xgv_flags	GvFLAGS(sv)		U8
+op_next		op->op_next		opindex
+op_sibling	op->op_sibling		opindex
+op_ppaddr	op->op_ppaddr		strconst	x
+op_targ		op->op_targ		PADOFFSET
+op_type		op			OPCODE		x
+op_seq		op->op_seq		U16
+op_flags	op->op_flags		U8
+op_private	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	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	main_start		opindex
+main_root	main_root		opindex
+curpad		curpad			svindex		x
diff --git a/byterun.c b/byterun.c
new file mode 100644
index 0000000000..3d4b64fb9d
--- /dev/null
+++ b/byterun.c
@@ -0,0 +1,857 @@
+/*
+ *      Copyright (c) 1996, 1997 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"
+#include "bytecode.h"
+#include "byterun.h"
+
+#ifdef INDIRECT_BGET_MACROS
+void byterun(bs)
+struct bytestream bs;
+#else
+void byterun(fp)
+FILE *fp;
+#endif /* INDIRECT_BGET_MACROS */
+{
+    dTHR;
+    int insn;
+    while ((insn = FGETC()) != EOF) {
+	switch (insn) {
+	  case INSN_COMMENT:		/* 35 */
+	    {
+		comment arg;
+		BGET_comment(arg);
+		arg = arg;
+		break;
+	    }
+	  case INSN_NOP:		/* 10 */
+	    {
+		break;
+	    }
+	  case INSN_RET:		/* 0 */
+	    {
+		BSET_ret(none);
+		break;
+	    }
+	  case INSN_LDSV:		/* 1 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		sv = arg;
+		break;
+	    }
+	  case INSN_LDOP:		/* 2 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		op = arg;
+		break;
+	    }
+	  case INSN_STSV:		/* 3 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		BSET_OBJ_STORE(sv, arg);
+		break;
+	    }
+	  case INSN_STOP:		/* 4 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		BSET_OBJ_STORE(op, arg);
+		break;
+	    }
+	  case INSN_LDSPECSV:		/* 5 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_ldspecsv(sv, arg);
+		break;
+	    }
+	  case INSN_NEWSV:		/* 6 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newsv(sv, arg);
+		break;
+	    }
+	  case INSN_NEWOP:		/* 7 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newop(op, arg);
+		break;
+	    }
+	  case INSN_NEWOPN:		/* 8 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BSET_newopn(op, arg);
+		break;
+	    }
+	  case INSN_NEWPV:		/* 9 */
+	    {
+		PV arg;
+		BGET_PV(arg);
+		break;
+	    }
+	  case INSN_PV_CUR:		/* 11 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		pv.xpv_cur = arg;
+		break;
+	    }
+	  case INSN_PV_FREE:		/* 12 */
+	    {
+		BSET_pv_free(pv);
+		break;
+	    }
+	  case INSN_SV_UPGRADE:		/* 13 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		BSET_sv_upgrade(sv, arg);
+		break;
+	    }
+	  case INSN_SV_REFCNT:		/* 14 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		SvREFCNT(sv) = arg;
+		break;
+	    }
+	  case INSN_SV_REFCNT_ADD:		/* 15 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BSET_sv_refcnt_add(SvREFCNT(sv), arg);
+		break;
+	    }
+	  case INSN_SV_FLAGS:		/* 16 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		SvFLAGS(sv) = arg;
+		break;
+	    }
+	  case INSN_XRV:		/* 17 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		SvRV(sv) = arg;
+		break;
+	    }
+	  case INSN_XPV:		/* 18 */
+	    {
+		BSET_xpv(sv);
+		break;
+	    }
+	  case INSN_XIV32:		/* 19 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		SvIVX(sv) = arg;
+		break;
+	    }
+	  case INSN_XIV64:		/* 20 */
+	    {
+		IV64 arg;
+		BGET_IV64(arg);
+		SvIVX(sv) = arg;
+		break;
+	    }
+	  case INSN_XNV:		/* 21 */
+	    {
+		double arg;
+		BGET_double(arg);
+		SvNVX(sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARGOFF:		/* 22 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		LvTARGOFF(sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARGLEN:		/* 23 */
+	    {
+		STRLEN arg;
+		BGET_U32(arg);
+		LvTARGLEN(sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TARG:		/* 24 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		LvTARG(sv) = arg;
+		break;
+	    }
+	  case INSN_XLV_TYPE:		/* 25 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		LvTYPE(sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_USEFUL:		/* 26 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BmUSEFUL(sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_PREVIOUS:		/* 27 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		BmPREVIOUS(sv) = arg;
+		break;
+	    }
+	  case INSN_XBM_RARE:		/* 28 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		BmRARE(sv) = arg;
+		break;
+	    }
+	  case INSN_XFM_LINES:		/* 29 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		FmLINES(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_LINES:		/* 30 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoLINES(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_PAGE:		/* 31 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoPAGE(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_PAGE_LEN:		/* 32 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoPAGE_LEN(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_LINES_LEFT:		/* 33 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		IoLINES_LEFT(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TOP_NAME:		/* 34 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoTOP_NAME(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TOP_GV:		/* 36 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&IoTOP_GV(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FMT_NAME:		/* 37 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoFMT_NAME(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FMT_GV:		/* 38 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&IoFMT_GV(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_BOTTOM_NAME:		/* 39 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		IoBOTTOM_NAME(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_BOTTOM_GV:		/* 40 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&IoBOTTOM_GV(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_SUBPROCESS:		/* 41 */
+	    {
+		short arg;
+		BGET_U16(arg);
+		IoSUBPROCESS(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_TYPE:		/* 42 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		IoTYPE(sv) = arg;
+		break;
+	    }
+	  case INSN_XIO_FLAGS:		/* 43 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		IoFLAGS(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_STASH:		/* 44 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&CvSTASH(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_START:		/* 45 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		CvSTART(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_ROOT:		/* 46 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		CvROOT(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_GV:		/* 47 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&CvGV(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_FILEGV:		/* 48 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&CvFILEGV(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_DEPTH:		/* 49 */
+	    {
+		long arg;
+		BGET_I32(arg);
+		CvDEPTH(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_PADLIST:		/* 50 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&CvPADLIST(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_OUTSIDE:		/* 51 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&CvOUTSIDE(sv) = arg;
+		break;
+	    }
+	  case INSN_XCV_FLAGS:		/* 52 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		CvFLAGS(sv) = arg;
+		break;
+	    }
+	  case INSN_AV_EXTEND:		/* 53 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		BSET_av_extend(sv, arg);
+		break;
+	    }
+	  case INSN_AV_PUSH:		/* 54 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		BSET_av_push(sv, arg);
+		break;
+	    }
+	  case INSN_XAV_FILL:		/* 55 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		AvFILLp(sv) = arg;
+		break;
+	    }
+	  case INSN_XAV_MAX:		/* 56 */
+	    {
+		SSize_t arg;
+		BGET_I32(arg);
+		AvMAX(sv) = arg;
+		break;
+	    }
+	  case INSN_XAV_FLAGS:		/* 57 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		AvFLAGS(sv) = arg;
+		break;
+	    }
+	  case INSN_XHV_RITER:		/* 58 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		HvRITER(sv) = arg;
+		break;
+	    }
+	  case INSN_XHV_NAME:		/* 59 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		HvNAME(sv) = arg;
+		break;
+	    }
+	  case INSN_HV_STORE:		/* 60 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		BSET_hv_store(sv, arg);
+		break;
+	    }
+	  case INSN_SV_MAGIC:		/* 61 */
+	    {
+		char arg;
+		BGET_U8(arg);
+		BSET_sv_magic(sv, arg);
+		break;
+	    }
+	  case INSN_MG_OBJ:		/* 62 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		SvMAGIC(sv)->mg_obj = arg;
+		break;
+	    }
+	  case INSN_MG_PRIVATE:		/* 63 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		SvMAGIC(sv)->mg_private = arg;
+		break;
+	    }
+	  case INSN_MG_FLAGS:		/* 64 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		SvMAGIC(sv)->mg_flags = arg;
+		break;
+	    }
+	  case INSN_MG_PV:		/* 65 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		BSET_mg_pv(SvMAGIC(sv), arg);
+		break;
+	    }
+	  case INSN_XMG_STASH:		/* 66 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&SvSTASH(sv) = arg;
+		break;
+	    }
+	  case INSN_GV_FETCHPV:		/* 67 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_gv_fetchpv(sv, arg);
+		break;
+	    }
+	  case INSN_GV_STASHPV:		/* 68 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_gv_stashpv(sv, arg);
+		break;
+	    }
+	  case INSN_GP_SV:		/* 69 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		GvSV(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_REFCNT:		/* 70 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		GvREFCNT(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_REFCNT_ADD:		/* 71 */
+	    {
+		I32 arg;
+		BGET_I32(arg);
+		BSET_gp_refcnt_add(GvREFCNT(sv), arg);
+		break;
+	    }
+	  case INSN_GP_AV:		/* 72 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvAV(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_HV:		/* 73 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvHV(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_CV:		/* 74 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvCV(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_FILEGV:		/* 75 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvFILEGV(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_IO:		/* 76 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvIOp(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_FORM:		/* 77 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&GvFORM(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_CVGEN:		/* 78 */
+	    {
+		U32 arg;
+		BGET_U32(arg);
+		GvCVGEN(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_LINE:		/* 79 */
+	    {
+		line_t arg;
+		BGET_U16(arg);
+		GvLINE(sv) = arg;
+		break;
+	    }
+	  case INSN_GP_SHARE:		/* 80 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		BSET_gp_share(sv, arg);
+		break;
+	    }
+	  case INSN_XGV_FLAGS:		/* 81 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		GvFLAGS(sv) = arg;
+		break;
+	    }
+	  case INSN_OP_NEXT:		/* 82 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		op->op_next = arg;
+		break;
+	    }
+	  case INSN_OP_SIBLING:		/* 83 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		op->op_sibling = arg;
+		break;
+	    }
+	  case INSN_OP_PPADDR:		/* 84 */
+	    {
+		strconst arg;
+		BGET_strconst(arg);
+		BSET_op_ppaddr(op->op_ppaddr, arg);
+		break;
+	    }
+	  case INSN_OP_TARG:		/* 85 */
+	    {
+		PADOFFSET arg;
+		BGET_U32(arg);
+		op->op_targ = arg;
+		break;
+	    }
+	  case INSN_OP_TYPE:		/* 86 */
+	    {
+		OPCODE arg;
+		BGET_U16(arg);
+		BSET_op_type(op, arg);
+		break;
+	    }
+	  case INSN_OP_SEQ:		/* 87 */
+	    {
+		U16 arg;
+		BGET_U16(arg);
+		op->op_seq = arg;
+		break;
+	    }
+	  case INSN_OP_FLAGS:		/* 88 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		op->op_flags = arg;
+		break;
+	    }
+	  case INSN_OP_PRIVATE:		/* 89 */
+	    {
+		U8 arg;
+		BGET_U8(arg);
+		op->op_private = arg;
+		break;
+	    }
+	  case INSN_OP_FIRST:		/* 90 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cUNOP->op_first = arg;
+		break;
+	    }
+	  case INSN_OP_LAST:		/* 91 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cBINOP->op_last = arg;
+		break;
+	    }
+	  case INSN_OP_OTHER:		/* 92 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cLOGOP->op_other = arg;
+		break;
+	    }
+	  case INSN_OP_TRUE:		/* 93 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cCONDOP->op_true = arg;
+		break;
+	    }
+	  case INSN_OP_FALSE:		/* 94 */
+	    {
+		opindex arg;
+		BGET_objindex(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_objindex(arg);
+		cPMOP->op_pmreplroot = arg;
+		break;
+	    }
+	  case INSN_OP_PMREPLROOTGV:		/* 97 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		*(SV**)&cPMOP->op_pmreplroot = arg;
+		break;
+	    }
+	  case INSN_OP_PMREPLSTART:		/* 98 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cPMOP->op_pmreplstart = arg;
+		break;
+	    }
+	  case INSN_OP_PMNEXT:		/* 99 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		*(OP**)&cPMOP->op_pmnext = arg;
+		break;
+	    }
+	  case INSN_PREGCOMP:		/* 100 */
+	    {
+		pvcontents arg;
+		BGET_pvcontents(arg);
+		BSET_pregcomp(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_objindex(arg);
+		cSVOP->op_sv = arg;
+		break;
+	    }
+	  case INSN_OP_GV:		/* 104 */
+	    {
+		svindex arg;
+		BGET_objindex(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_objindex(arg);
+		cLOOP->op_redoop = arg;
+		break;
+	    }
+	  case INSN_OP_NEXTOP:		/* 108 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		cLOOP->op_nextop = arg;
+		break;
+	    }
+	  case INSN_OP_LASTOP:		/* 109 */
+	    {
+		opindex arg;
+		BGET_objindex(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_objindex(arg);
+		*(SV**)&cCOP->cop_stash = arg;
+		break;
+	    }
+	  case INSN_COP_FILEGV:		/* 112 */
+	    {
+		svindex arg;
+		BGET_objindex(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_objindex(arg);
+		main_start = arg;
+		break;
+	    }
+	  case INSN_MAIN_ROOT:		/* 117 */
+	    {
+		opindex arg;
+		BGET_objindex(arg);
+		main_root = arg;
+		break;
+	    }
+	  case INSN_CURPAD:		/* 118 */
+	    {
+		svindex arg;
+		BGET_objindex(arg);
+		BSET_curpad(curpad, arg);
+		break;
+	    }
+	  default:
+	    croak("Illegal bytecode instruction %d\n", insn);
+	    /* NOTREACHED */
+	}
+    }
+}
diff --git a/byterun.h b/byterun.h
new file mode 100644
index 0000000000..81e82049cf
--- /dev/null
+++ b/byterun.h
@@ -0,0 +1,194 @@
+/*
+ *      Copyright (c) 1996, 1997 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*);
+};
+void freadpv _((U32, void *));
+void byterun _((struct bytestream));
+#else
+void byterun _((FILE *));
+#endif /* INDIRECT_BGET_MACROS */
+
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+#if PATCHLEVEL < 4 || (PATCHLEVEL == 4 && SUBVERSION < 50)
+#define dTHR extern int errno
+#endif
+
+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 */
+;
+
+EXT SV * specialsv_list[4];
+#define INIT_SPECIALSV_LIST STMT_START { \
+specialsv_list[0] = Nullsv; \
+specialsv_list[1] = &sv_undef; \
+specialsv_list[2] = &sv_yes; \
+specialsv_list[3] = &sv_no; \
+} STMT_END
diff --git a/cc_runtime.h b/cc_runtime.h
new file mode 100644
index 0000000000..fe830c0bde
--- /dev/null
+++ b/cc_runtime.h
@@ -0,0 +1,71 @@
+#define DOOP(ppname) PUTBACK; op = ppname(ARGS); SPAGAIN
+
+#define PP_LIST(g) do {			\
+	dMARK;				\
+	if (g != G_ARRAY) {		\
+	    if (++MARK <= SP)		\
+		*MARK = *SP;		\
+	    else			\
+		*MARK = &sv_undef;	\
+	    SP = MARK;			\
+	}				\
+   } while (0)
+
+#define MAYBE_TAINT_SASSIGN_SRC(sv) \
+    if (tainting && 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;		\
+	stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;	\
+	FREETMPS;		\
+	oldsave = scopestack[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:					\
+	    op = ppaddr(ARGS);			\
+	    retstack[retstack_ix - 1] = Nullop;	\
+	    if (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 (restartop != nxt)		\
+		JMPENV_JUMP(3);			\
+	}					\
+	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)
diff --git a/doio.c b/doio.c
index d720f99d04..3167aea6b7 100644
--- a/doio.c
+++ b/doio.c
@@ -34,7 +34,7 @@
 #endif
 
 #ifdef I_UTIME
-#  ifdef _MSC_VER
+#  if defined(_MSC_VER) || defined(__MINGW32__)
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
diff --git a/ext/B/B.pm b/ext/B/B.pm
new file mode 100644
index 0000000000..8545c5c847
--- /dev/null
+++ b/ext/B/B.pm
@@ -0,0 +1,271 @@
+#      B.pm
+#
+#      Copyright (c) 1996, 1997 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::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;
diff --git a/ext/B/B.xs b/ext/B/B.xs
new file mode 100644
index 0000000000..0bb7acba02
--- /dev/null
+++ b/ext/B/B.xs
@@ -0,0 +1,1207 @@
+/*	B.xs
+ *
+ *	Copyright (c) 1996 Malcolm Beattie
+ *
+ *	You may distribute under the terms of either the GNU General Public
+ *	License or the Artistic License, as specified in the README file.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "INTERN.h"
+#include "bytecode.h"
+#include "byterun.h"
+
+static char *svclassnames[] = {
+    "B::NULL",
+    "B::IV",
+    "B::NV",
+    "B::RV",
+    "B::PV",
+    "B::PVIV",
+    "B::PVNV",
+    "B::PVMG",
+    "B::BM",
+    "B::PVLV",
+    "B::AV",
+    "B::HV",
+    "B::CV",
+    "B::GV",
+    "B::FM",
+    "B::IO",
+};
+
+typedef enum {
+    OPc_NULL,	/* 0 */
+    OPc_BASEOP,	/* 1 */
+    OPc_UNOP,	/* 2 */
+    OPc_BINOP,	/* 3 */
+    OPc_LOGOP,	/* 4 */
+    OPc_CONDOP,	/* 5 */
+    OPc_LISTOP,	/* 6 */
+    OPc_PMOP,	/* 7 */
+    OPc_SVOP,	/* 8 */
+    OPc_GVOP,	/* 9 */
+    OPc_PVOP,	/* 10 */
+    OPc_CVOP,	/* 11 */
+    OPc_LOOP,	/* 12 */
+    OPc_COP	/* 13 */
+} opclass;
+
+static char *opclassnames[] = {
+    "B::NULL",
+    "B::OP",
+    "B::UNOP",
+    "B::BINOP",
+    "B::LOGOP",
+    "B::CONDOP",
+    "B::LISTOP",
+    "B::PMOP",
+    "B::SVOP",
+    "B::GVOP",
+    "B::PVOP",
+    "B::CVOP",
+    "B::LOOP",
+    "B::COP"	
+};
+
+static int walkoptree_debug = 0;	/* Flag for walkoptree debug hook */
+
+static opclass
+cc_opclass(OP *o)
+{
+    if (!o)
+	return OPc_NULL;
+
+    if (o->op_type == 0)
+	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+    if (o->op_type == OP_SASSIGN)
+	return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+
+    switch (opargs[o->op_type] & OA_CLASS_MASK) {
+    case OA_BASEOP:
+	return OPc_BASEOP;
+
+    case OA_UNOP:
+	return OPc_UNOP;
+
+    case OA_BINOP:
+	return OPc_BINOP;
+
+    case OA_LOGOP:
+	return OPc_LOGOP;
+
+    case OA_CONDOP:
+	return OPc_CONDOP;
+
+    case OA_LISTOP:
+	return OPc_LISTOP;
+
+    case OA_PMOP:
+	return OPc_PMOP;
+
+    case OA_SVOP:
+	return OPc_SVOP;
+
+    case OA_GVOP:
+	return OPc_GVOP;
+
+    case OA_PVOP:
+	return OPc_PVOP;
+
+    case OA_LOOP:
+	return OPc_LOOP;
+
+    case OA_COP:
+	return OPc_COP;
+
+    case OA_BASEOP_OR_UNOP:
+	/*
+	 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+	 * whether bare parens were seen. perly.y uses OPf_SPECIAL to
+	 * signal whether an OP or an UNOP was chosen.
+	 * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too.
+	 */
+	return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP :
+		(o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
+
+    case OA_FILESTATOP:
+	/*
+	 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+	 * the OPf_REF flag to distinguish between OP types instead of the
+	 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+	 * return OPc_UNOP so that walkoptree can find our children. If
+	 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+	 * (no argument to the operator) it's an OP; with OPf_REF set it's
+	 * a GVOP (and op_gv is the GV for the filehandle argument).
+	 */
+	return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+		(o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
+
+    case OA_LOOPEXOP:
+	/*
+	 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+	 * label was omitted (in which case it's a BASEOP) or else a term was
+	 * seen. In this last case, all except goto are definitely PVOP but
+	 * goto is either a PVOP (with an ordinary constant label), an UNOP
+	 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+	 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+	 * get set.
+	 */
+	if (o->op_flags & OPf_STACKED)
+	    return OPc_UNOP;
+	else if (o->op_flags & OPf_SPECIAL)
+	    return OPc_BASEOP;
+	else
+	    return OPc_PVOP;
+    }
+    warn("can't determine class of operator %s, assuming BASEOP\n",
+	 op_name[o->op_type]);
+    return OPc_BASEOP;
+}
+
+static char *
+cc_opclassname(OP *o)
+{
+    return opclassnames[cc_opclass(o)];
+}
+
+static SV *
+make_sv_object(SV *arg, SV *sv)
+{
+    char *type = 0;
+    IV iv;
+    
+    for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
+	if (sv == specialsv_list[iv]) {
+	    type = "B::SPECIAL";
+	    break;
+	}
+    }
+    if (!type) {
+	type = svclassnames[SvTYPE(sv)];
+	iv = (IV)sv;
+    }
+    sv_setiv(newSVrv(arg, type), iv);
+    return arg;
+}
+
+static SV *
+make_mg_object(SV *arg, MAGIC *mg)
+{
+    sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
+    return arg;
+}
+
+static SV *
+cstring(SV *sv)
+{
+    SV *sstr = newSVpv("", 0);
+    STRLEN len;
+    char *s;
+
+    if (!SvOK(sv))
+	sv_setpvn(sstr, "0", 1);
+    else
+    {
+	/* XXX Optimise? */
+	s = SvPV(sv, len);
+	sv_catpv(sstr, "\"");
+	for (; len; len--, s++)
+	{
+	    /* At least try a little for readability */
+	    if (*s == '"')
+		sv_catpv(sstr, "\\\"");
+	    else if (*s == '\\')
+		sv_catpv(sstr, "\\\\");
+	    else if (*s >= ' ' && *s < 127) /* XXX not portable */
+		sv_catpvn(sstr, s, 1);
+	    else if (*s == '\n')
+		sv_catpv(sstr, "\\n");
+	    else if (*s == '\r')
+		sv_catpv(sstr, "\\r");
+	    else if (*s == '\t')
+		sv_catpv(sstr, "\\t");
+	    else if (*s == '\a')
+		sv_catpv(sstr, "\\a");
+	    else if (*s == '\b')
+		sv_catpv(sstr, "\\b");
+	    else if (*s == '\f')
+		sv_catpv(sstr, "\\f");
+	    else if (*s == '\v')
+		sv_catpv(sstr, "\\v");
+	    else
+	    {
+		/* no trigraph support */
+		char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
+		/* Don't want promotion of a signed -1 char in sprintf args */
+		unsigned char c = (unsigned char) *s;
+		sprintf(escbuff, "\\%03o", c);
+		sv_catpv(sstr, escbuff);
+	    }
+	    /* XXX Add line breaks if string is long */
+	}
+	sv_catpv(sstr, "\"");
+    }
+    return sstr;
+}
+
+static SV *
+cchar(SV *sv)
+{
+    SV *sstr = newSVpv("'", 0);
+    char *s = SvPV(sv, na);
+
+    if (*s == '\'')
+	sv_catpv(sstr, "\\'");
+    else if (*s == '\\')
+	sv_catpv(sstr, "\\\\");
+    else if (*s >= ' ' && *s < 127) /* XXX not portable */
+	sv_catpvn(sstr, s, 1);
+    else if (*s == '\n')
+	sv_catpv(sstr, "\\n");
+    else if (*s == '\r')
+	sv_catpv(sstr, "\\r");
+    else if (*s == '\t')
+	sv_catpv(sstr, "\\t");
+    else if (*s == '\a')
+	sv_catpv(sstr, "\\a");
+    else if (*s == '\b')
+	sv_catpv(sstr, "\\b");
+    else if (*s == '\f')
+	sv_catpv(sstr, "\\f");
+    else if (*s == '\v')
+	sv_catpv(sstr, "\\v");
+    else
+    {
+	/* no trigraph support */
+	char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
+	/* Don't want promotion of a signed -1 char in sprintf args */
+	unsigned char c = (unsigned char) *s;
+	sprintf(escbuff, "\\%03o", c);
+	sv_catpv(sstr, escbuff);
+    }
+    sv_catpv(sstr, "'");
+    return sstr;
+}
+
+void *
+bset_obj_store(void *obj, I32 ix)
+{
+    if (ix > obj_list_fill) {
+	if (obj_list_fill == -1)
+	    New(666, obj_list, ix + 1, void*);
+	else
+	    Renew(obj_list, ix + 1, void*);
+	obj_list_fill = ix;
+    }
+    obj_list[ix] = obj;
+    return obj;
+}
+
+#ifdef INDIRECT_BGET_MACROS
+void freadpv(U32 len, void *data)
+{
+    New(666, pv.xpv_pv, len, char);
+    fread(pv.xpv_pv, 1, len, (FILE*)data);
+    pv.xpv_len = len;
+    pv.xpv_cur = len - 1;
+}
+
+void byteload_fh(FILE *fp)
+{
+    struct bytestream bs;
+    bs.data = fp;
+    bs.fgetc = (int(*) _((void*)))fgetc;
+    bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
+    bs.freadpv = freadpv;
+    byterun(bs);
+}
+
+static int fgetc_fromstring(void *data)
+{
+    char **strp = (char **)data;
+    return *(*strp)++;
+}
+
+static int fread_fromstring(char *argp, size_t elemsize, size_t nelem,
+			    void *data)
+{
+    char **strp = (char **)data;
+    size_t len = elemsize * nelem;
+    
+    memcpy(argp, *strp, len);
+    *strp += len;
+    return (int)len;
+}
+
+static void freadpv_fromstring(U32 len, void *data)
+{
+    char **strp = (char **)data;
+    
+    New(666, pv.xpv_pv, len, char);
+    memcpy(pv.xpv_pv, *strp, len);
+    pv.xpv_len = len;
+    pv.xpv_cur = len - 1;
+    *strp += len;
+}    
+
+void byteload_string(char *str)
+{
+    struct bytestream bs;
+    bs.data = &str;
+    bs.fgetc = fgetc_fromstring;
+    bs.fread = fread_fromstring;
+    bs.freadpv = freadpv_fromstring;
+    byterun(bs);
+}
+#else
+void byteload_fh(FILE *fp)
+{
+    byterun(fp);
+}
+
+void byteload_string(char *str)
+{
+    croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string");
+}    
+#endif /* INDIRECT_BGET_MACROS */
+
+void
+walkoptree(SV *opsv, char *method)
+{
+    dSP;
+    OP *o;
+    
+    if (!SvROK(opsv))
+	croak("opsv is not a reference");
+    opsv = sv_mortalcopy(opsv);
+    o = (OP*)SvIV((SV*)SvRV(opsv));
+    if (walkoptree_debug) {
+	PUSHMARK(sp);
+	XPUSHs(opsv);
+	PUTBACK;
+	perl_call_method("walkoptree_debug", G_DISCARD);
+    }
+    PUSHMARK(sp);
+    XPUSHs(opsv);
+    PUTBACK;
+    perl_call_method(method, G_DISCARD);
+    if (o && (o->op_flags & OPf_KIDS)) {
+	OP *kid;
+	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
+	    /* Use the same opsv. Rely on methods not to mess it up. */
+	    sv_setiv(newSVrv(opsv, cc_opclassname(kid)), (IV)kid);
+	    walkoptree(opsv, method);
+	}
+    }
+}
+
+typedef OP	*B__OP;
+typedef UNOP	*B__UNOP;
+typedef BINOP	*B__BINOP;
+typedef LOGOP	*B__LOGOP;
+typedef CONDOP	*B__CONDOP;
+typedef LISTOP	*B__LISTOP;
+typedef PMOP	*B__PMOP;
+typedef SVOP	*B__SVOP;
+typedef GVOP	*B__GVOP;
+typedef PVOP	*B__PVOP;
+typedef LOOP	*B__LOOP;
+typedef COP	*B__COP;
+
+typedef SV	*B__SV;
+typedef SV	*B__IV;
+typedef SV	*B__PV;
+typedef SV	*B__NV;
+typedef SV	*B__PVMG;
+typedef SV	*B__PVLV;
+typedef SV	*B__BM;
+typedef SV	*B__RV;
+typedef AV	*B__AV;
+typedef HV	*B__HV;
+typedef CV	*B__CV;
+typedef GV	*B__GV;
+typedef IO	*B__IO;
+
+typedef MAGIC	*B__MAGIC;
+
+MODULE = B	PACKAGE = B	PREFIX = B_
+
+PROTOTYPES: DISABLE
+
+BOOT:
+    INIT_SPECIALSV_LIST;
+
+#define B_main_cv()	main_cv
+#define B_main_root()	main_root
+#define B_main_start()	main_start
+#define B_comppadlist()	(main_cv ? CvPADLIST(main_cv) : CvPADLIST(compcv))
+#define B_sv_undef()	&sv_undef
+#define B_sv_yes()	&sv_yes
+#define B_sv_no()	&sv_no
+
+B::CV
+B_main_cv()
+
+B::OP
+B_main_root()
+
+B::OP
+B_main_start()
+
+B::AV
+B_comppadlist()
+
+B::SV
+B_sv_undef()
+
+B::SV
+B_sv_yes()
+
+B::SV
+B_sv_no()
+
+MODULE = B	PACKAGE = B
+
+
+void
+walkoptree(opsv, method)
+	SV *	opsv
+	char *	method
+
+int
+walkoptree_debug(...)
+    CODE:
+	RETVAL = walkoptree_debug;
+	if (items > 0 && SvTRUE(ST(1)))
+	    walkoptree_debug = 1;
+    OUTPUT:
+	RETVAL
+
+int
+byteload_fh(fp)
+	FILE *	fp
+    CODE:
+	byteload_fh(fp);
+	RETVAL = 1;
+    OUTPUT:
+	RETVAL
+
+void
+byteload_string(str)
+	char *	str
+
+#define address(sv) (IV)sv
+
+IV
+address(sv)
+	SV *	sv
+
+B::SV
+svref_2object(sv)
+	SV *	sv
+    CODE:
+	if (!SvROK(sv))
+	    croak("argument is not a reference");
+	RETVAL = (SV*)SvRV(sv);
+    OUTPUT:
+	RETVAL
+
+void
+ppname(opnum)
+	int	opnum
+    CODE:
+	ST(0) = sv_newmortal();
+	if (opnum >= 0 && opnum < maxo) {
+	    sv_setpvn(ST(0), "pp_", 3);
+	    sv_catpv(ST(0), op_name[opnum]);
+	}
+
+void
+hash(sv)
+	SV *	sv
+    CODE:
+	char *s;
+	STRLEN len;
+	U32 hash = 0;
+	char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */
+	s = SvPV(sv, len);
+	while (len--)
+	    hash = hash * 33 + *s++;
+	sprintf(hexhash, "0x%x", hash);
+	ST(0) = sv_2mortal(newSVpv(hexhash, 0));
+
+#define cast_I32(foo) (I32)foo
+IV
+cast_I32(i)
+	IV	i
+
+void
+minus_c()
+    CODE:
+	minus_c = TRUE;
+
+SV *
+cstring(sv)
+	SV *	sv
+
+SV *
+cchar(sv)
+	SV *	sv
+
+void
+threadsv_names()
+    PPCODE:
+#ifdef USE_THREADS
+	int i;
+	STRLEN len = strlen(threadsv_names);
+
+	EXTEND(sp, len);
+	for (i = 0; i < len; i++)
+	    PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1)));
+#endif
+
+
+#define OP_next(o)	o->op_next
+#define OP_sibling(o)	o->op_sibling
+#define OP_desc(o)	op_desc[o->op_type]
+#define OP_targ(o)	o->op_targ
+#define OP_type(o)	o->op_type
+#define OP_seq(o)	o->op_seq
+#define OP_flags(o)	o->op_flags
+#define OP_private(o)	o->op_private
+
+MODULE = B	PACKAGE = B::OP		PREFIX = OP_
+
+B::OP
+OP_next(o)
+	B::OP		o
+
+B::OP
+OP_sibling(o)
+	B::OP		o
+
+char *
+OP_ppaddr(o)
+	B::OP		o
+    CODE:
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), "pp_", 3);
+	sv_catpv(ST(0), op_name[o->op_type]);
+
+char *
+OP_desc(o)
+	B::OP		o
+
+U16
+OP_targ(o)
+	B::OP		o
+
+U16
+OP_type(o)
+	B::OP		o
+
+U16
+OP_seq(o)
+	B::OP		o
+
+U8
+OP_flags(o)
+	B::OP		o
+
+U8
+OP_private(o)
+	B::OP		o
+
+#define UNOP_first(o)	o->op_first
+
+MODULE = B	PACKAGE = B::UNOP		PREFIX = UNOP_
+
+B::OP 
+UNOP_first(o)
+	B::UNOP	o
+
+#define BINOP_last(o)	o->op_last
+
+MODULE = B	PACKAGE = B::BINOP		PREFIX = BINOP_
+
+B::OP
+BINOP_last(o)
+	B::BINOP	o
+
+#define LOGOP_other(o)	o->op_other
+
+MODULE = B	PACKAGE = B::LOGOP		PREFIX = LOGOP_
+
+B::OP
+LOGOP_other(o)
+	B::LOGOP	o
+
+#define CONDOP_true(o)	o->op_true
+#define CONDOP_false(o)	o->op_false
+
+MODULE = B	PACKAGE = B::CONDOP		PREFIX = CONDOP_
+
+B::OP
+CONDOP_true(o)
+	B::CONDOP	o
+
+B::OP
+CONDOP_false(o)
+	B::CONDOP	o
+
+#define LISTOP_children(o)	o->op_children
+
+MODULE = B	PACKAGE = B::LISTOP		PREFIX = LISTOP_
+
+U32
+LISTOP_children(o)
+	B::LISTOP	o
+
+#define PMOP_pmreplroot(o)	o->op_pmreplroot
+#define PMOP_pmreplstart(o)	o->op_pmreplstart
+#define PMOP_pmnext(o)		o->op_pmnext
+#define PMOP_pmregexp(o)	o->op_pmregexp
+#define PMOP_pmflags(o)		o->op_pmflags
+#define PMOP_pmpermflags(o)	o->op_pmpermflags
+
+MODULE = B	PACKAGE = B::PMOP		PREFIX = PMOP_
+
+void
+PMOP_pmreplroot(o)
+	B::PMOP		o
+	OP *		root = NO_INIT
+    CODE:
+	ST(0) = sv_newmortal();
+	root = o->op_pmreplroot;
+	/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
+	if (o->op_type == OP_PUSHRE) {
+	    sv_setiv(newSVrv(ST(0), root ?
+			     svclassnames[SvTYPE((SV*)root)] : "B::SV"),
+		     (IV)root);
+	}
+	else {
+	    sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root);
+	}
+
+B::OP
+PMOP_pmreplstart(o)
+	B::PMOP		o
+
+B::PMOP
+PMOP_pmnext(o)
+	B::PMOP		o
+
+U16
+PMOP_pmflags(o)
+	B::PMOP		o
+
+U16
+PMOP_pmpermflags(o)
+	B::PMOP		o
+
+void
+PMOP_precomp(o)
+	B::PMOP		o
+	REGEXP *	rx = NO_INIT
+    CODE:
+	ST(0) = sv_newmortal();
+	rx = o->op_pmregexp;
+	if (rx)
+	    sv_setpvn(ST(0), rx->precomp, rx->prelen);
+
+#define SVOP_sv(o)	o->op_sv
+
+MODULE = B	PACKAGE = B::SVOP		PREFIX = SVOP_
+
+
+B::SV
+SVOP_sv(o)
+	B::SVOP	o
+
+#define GVOP_gv(o)	o->op_gv
+
+MODULE = B	PACKAGE = B::GVOP		PREFIX = GVOP_
+
+
+B::GV
+GVOP_gv(o)
+	B::GVOP	o
+
+MODULE = B	PACKAGE = B::PVOP		PREFIX = PVOP_
+
+void
+PVOP_pv(o)
+	B::PVOP	o
+    CODE:
+	/*
+	 * OP_TRANS uses op_pv to point to a table of 256 shorts
+	 * whereas other PVOPs point to a null terminated string.
+	 */
+	ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
+				   256 * sizeof(short) : 0));
+
+#define LOOP_redoop(o)	o->op_redoop
+#define LOOP_nextop(o)	o->op_nextop
+#define LOOP_lastop(o)	o->op_lastop
+
+MODULE = B	PACKAGE = B::LOOP		PREFIX = LOOP_
+
+
+B::OP
+LOOP_redoop(o)
+	B::LOOP	o
+
+B::OP
+LOOP_nextop(o)
+	B::LOOP	o
+
+B::OP
+LOOP_lastop(o)
+	B::LOOP	o
+
+#define COP_label(o)	o->cop_label
+#define COP_stash(o)	o->cop_stash
+#define COP_filegv(o)	o->cop_filegv
+#define COP_cop_seq(o)	o->cop_seq
+#define COP_arybase(o)	o->cop_arybase
+#define COP_line(o)	o->cop_line
+
+MODULE = B	PACKAGE = B::COP		PREFIX = COP_
+
+char *
+COP_label(o)
+	B::COP	o
+
+B::HV
+COP_stash(o)
+	B::COP	o
+
+B::GV
+COP_filegv(o)
+	B::COP	o
+
+U32
+COP_cop_seq(o)
+	B::COP	o
+
+I32
+COP_arybase(o)
+	B::COP	o
+
+U16
+COP_line(o)
+	B::COP	o
+
+MODULE = B	PACKAGE = B::SV		PREFIX = Sv
+
+U32
+SvREFCNT(sv)
+	B::SV	sv
+
+U32
+SvFLAGS(sv)
+	B::SV	sv
+
+MODULE = B	PACKAGE = B::IV		PREFIX = Sv
+
+IV
+SvIV(sv)
+	B::IV	sv
+
+IV
+SvIVX(sv)
+	B::IV	sv
+
+MODULE = B	PACKAGE = B::IV
+
+#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
+
+int
+needs64bits(sv)
+	B::IV	sv
+
+void
+packiv(sv)
+	B::IV	sv
+    CODE:
+	if (sizeof(IV) == 8) {
+	    U32 wp[2];
+	    IV iv = SvIVX(sv);
+	    /*
+	     * The following way of spelling 32 is to stop compilers on
+	     * 32-bit architectures from moaning about the shift count
+	     * being >= the width of the type. Such architectures don't
+	     * reach this code anyway (unless sizeof(IV) > 8 but then
+	     * everything else breaks too so I'm not fussed at the moment).
+	     */
+	    wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
+	    wp[1] = htonl(iv & 0xffffffff);
+	    ST(0) = sv_2mortal(newSVpv((char *)wp, 8));
+	} else {
+	    U32 w = htonl((U32)SvIVX(sv));
+	    ST(0) = sv_2mortal(newSVpv((char *)&w, 4));
+	}
+
+MODULE = B	PACKAGE = B::NV		PREFIX = Sv
+
+double
+SvNV(sv)
+	B::NV	sv
+
+double
+SvNVX(sv)
+	B::NV	sv
+
+MODULE = B	PACKAGE = B::RV		PREFIX = Sv
+
+B::SV
+SvRV(sv)
+	B::RV	sv
+
+MODULE = B	PACKAGE = B::PV		PREFIX = Sv
+
+void
+SvPV(sv)
+	B::PV	sv
+    CODE:
+	ST(0) = sv_newmortal();
+	sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
+
+MODULE = B	PACKAGE = B::PVMG	PREFIX = Sv
+
+void
+SvMAGIC(sv)
+	B::PVMG	sv
+	MAGIC *	mg = NO_INIT
+    PPCODE:
+	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
+	    XPUSHs(make_mg_object(sv_newmortal(), mg));
+
+MODULE = B	PACKAGE = B::PVMG
+
+B::HV
+SvSTASH(sv)
+	B::PVMG	sv
+
+#define MgMOREMAGIC(mg) mg->mg_moremagic
+#define MgPRIVATE(mg) mg->mg_private
+#define MgTYPE(mg) mg->mg_type
+#define MgFLAGS(mg) mg->mg_flags
+#define MgOBJ(mg) mg->mg_obj
+
+MODULE = B	PACKAGE = B::MAGIC	PREFIX = Mg	
+
+B::MAGIC
+MgMOREMAGIC(mg)
+	B::MAGIC	mg
+
+U16
+MgPRIVATE(mg)
+	B::MAGIC	mg
+
+char
+MgTYPE(mg)
+	B::MAGIC	mg
+
+U8
+MgFLAGS(mg)
+	B::MAGIC	mg
+
+B::SV
+MgOBJ(mg)
+	B::MAGIC	mg
+
+void
+MgPTR(mg)
+	B::MAGIC	mg
+    CODE:
+	ST(0) = sv_newmortal();
+	if (mg->mg_ptr)
+	    sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
+
+MODULE = B	PACKAGE = B::PVLV	PREFIX = Lv
+
+U32
+LvTARGOFF(sv)
+	B::PVLV	sv
+
+U32
+LvTARGLEN(sv)
+	B::PVLV	sv
+
+char
+LvTYPE(sv)
+	B::PVLV	sv
+
+B::SV
+LvTARG(sv)
+	B::PVLV sv
+
+MODULE = B	PACKAGE = B::BM		PREFIX = Bm
+
+I32
+BmUSEFUL(sv)
+	B::BM	sv
+
+U16
+BmPREVIOUS(sv)
+	B::BM	sv
+
+U8
+BmRARE(sv)
+	B::BM	sv
+
+void
+BmTABLE(sv)
+	B::BM	sv
+	STRLEN	len = NO_INIT
+	char *	str = NO_INIT
+    CODE:
+	str = SvPV(sv, len);
+	/* Boyer-Moore table is just after string and its safety-margin \0 */
+	ST(0) = sv_2mortal(newSVpv(str + len + 1, 256));
+
+MODULE = B	PACKAGE = B::GV		PREFIX = Gv
+
+void
+GvNAME(gv)
+	B::GV	gv
+    CODE:
+	ST(0) = sv_2mortal(newSVpv(GvNAME(gv), GvNAMELEN(gv)));
+
+B::HV
+GvSTASH(gv)
+	B::GV	gv
+
+B::SV
+GvSV(gv)
+	B::GV	gv
+
+B::IO
+GvIO(gv)
+	B::GV	gv
+
+B::CV
+GvFORM(gv)
+	B::GV	gv
+
+B::AV
+GvAV(gv)
+	B::GV	gv
+
+B::HV
+GvHV(gv)
+	B::GV	gv
+
+B::GV
+GvEGV(gv)
+	B::GV	gv
+
+B::CV
+GvCV(gv)
+	B::GV	gv
+
+U32
+GvCVGEN(gv)
+	B::GV	gv
+
+U16
+GvLINE(gv)
+	B::GV	gv
+
+B::GV
+GvFILEGV(gv)
+	B::GV	gv
+
+MODULE = B	PACKAGE = B::GV
+
+U32
+GvREFCNT(gv)
+	B::GV	gv
+
+U8
+GvFLAGS(gv)
+	B::GV	gv
+
+MODULE = B	PACKAGE = B::IO		PREFIX = Io
+
+long
+IoLINES(io)
+	B::IO	io
+
+long
+IoPAGE(io)
+	B::IO	io
+
+long
+IoPAGE_LEN(io)
+	B::IO	io
+
+long
+IoLINES_LEFT(io)
+	B::IO	io
+
+char *
+IoTOP_NAME(io)
+	B::IO	io
+
+B::GV
+IoTOP_GV(io)
+	B::IO	io
+
+char *
+IoFMT_NAME(io)
+	B::IO	io
+
+B::GV
+IoFMT_GV(io)
+	B::IO	io
+
+char *
+IoBOTTOM_NAME(io)
+	B::IO	io
+
+B::GV
+IoBOTTOM_GV(io)
+	B::IO	io
+
+short
+IoSUBPROCESS(io)
+	B::IO	io
+
+MODULE = B	PACKAGE = B::IO
+
+char
+IoTYPE(io)
+	B::IO	io
+
+U8
+IoFLAGS(io)
+	B::IO	io
+
+MODULE = B	PACKAGE = B::AV		PREFIX = Av
+
+SSize_t
+AvFILL(av)
+	B::AV	av
+
+SSize_t
+AvMAX(av)
+	B::AV	av
+
+#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
+
+IV
+AvOFF(av)
+	B::AV	av
+
+void
+AvARRAY(av)
+	B::AV	av
+    PPCODE:
+	if (AvFILL(av) >= 0) {
+	    SV **svp = AvARRAY(av);
+	    I32 i;
+	    for (i = 0; i <= AvFILL(av); i++)
+		XPUSHs(make_sv_object(sv_newmortal(), svp[i]));
+	}
+
+MODULE = B	PACKAGE = B::AV
+
+U8
+AvFLAGS(av)
+	B::AV	av
+
+MODULE = B	PACKAGE = B::CV		PREFIX = Cv
+
+B::HV
+CvSTASH(cv)
+	B::CV	cv
+
+B::OP
+CvSTART(cv)
+	B::CV	cv
+
+B::OP
+CvROOT(cv)
+	B::CV	cv
+
+B::GV
+CvGV(cv)
+	B::CV	cv
+
+B::GV
+CvFILEGV(cv)
+	B::CV	cv
+
+long
+CvDEPTH(cv)
+	B::CV	cv
+
+B::AV
+CvPADLIST(cv)
+	B::CV	cv
+
+B::CV
+CvOUTSIDE(cv)
+	B::CV	cv
+
+void
+CvXSUB(cv)
+	B::CV	cv
+    CODE:
+	ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
+
+
+void
+CvXSUBANY(cv)
+	B::CV	cv
+    CODE:
+	ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+
+MODULE = B	PACKAGE = B::HV		PREFIX = Hv
+
+STRLEN
+HvFILL(hv)
+	B::HV	hv
+
+STRLEN
+HvMAX(hv)
+	B::HV	hv
+
+I32
+HvKEYS(hv)
+	B::HV	hv
+
+I32
+HvRITER(hv)
+	B::HV	hv
+
+char *
+HvNAME(hv)
+	B::HV	hv
+
+B::PMOP
+HvPMROOT(hv)
+	B::HV	hv
+
+void
+HvARRAY(hv)
+	B::HV	hv
+    PPCODE:
+	if (HvKEYS(hv) > 0) {
+	    SV *sv;
+	    char *key;
+	    I32 len;
+	    (void)hv_iterinit(hv);
+	    EXTEND(sp, HvKEYS(hv) * 2);
+	    while (sv = hv_iternextsv(hv, &key, &len)) {
+		PUSHs(newSVpv(key, len));
+		PUSHs(make_sv_object(sv_newmortal(), sv));
+	    }
+	}
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
new file mode 100644
index 0000000000..3a3cf6da61
--- /dev/null
+++ b/ext/B/B/Asmdata.pm
@@ -0,0 +1,150 @@
+#
+#      Copyright (c) 1996, 1997 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 &sv_undef &sv_yes &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, "GET_comment"];
+$insn_data{nop} = [10, \&PUT_none, "GET_none"];
+$insn_data{ret} = [0, \&PUT_none, "GET_none"];
+$insn_data{ldsv} = [1, \&PUT_objindex, "GET_objindex"];
+$insn_data{ldop} = [2, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{xio_fmt_name} = [37, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_fmt_gv} = [38, \&PUT_objindex, "GET_objindex"];
+$insn_data{xio_bottom_name} = [39, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_bottom_gv} = [40, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{xcv_start} = [45, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_root} = [46, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_gv} = [47, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_filegv} = [48, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [50, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_outside} = [51, \&PUT_objindex, "GET_objindex"];
+$insn_data{xcv_flags} = [52, \&PUT_U8, "GET_U8"];
+$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [54, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [62, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [69, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{gp_hv} = [73, \&PUT_objindex, "GET_objindex"];
+$insn_data{gp_cv} = [74, \&PUT_objindex, "GET_objindex"];
+$insn_data{gp_filegv} = [75, \&PUT_objindex, "GET_objindex"];
+$insn_data{gp_io} = [76, \&PUT_objindex, "GET_objindex"];
+$insn_data{gp_form} = [77, \&PUT_objindex, "GET_objindex"];
+$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [80, \&PUT_objindex, "GET_objindex"];
+$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [82, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_sibling} = [83, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{op_last} = [91, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_other} = [92, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_true} = [93, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_false} = [94, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_children} = [95, \&PUT_U32, "GET_U32"];
+$insn_data{op_pmreplroot} = [96, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_pmreplrootgv} = [97, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_pmreplstart} = [98, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_pmnext} = [99, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{op_gv} = [104, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{op_nextop} = [108, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_lastop} = [109, \&PUT_objindex, "GET_objindex"];
+$insn_data{cop_label} = [110, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_stash} = [111, \&PUT_objindex, "GET_objindex"];
+$insn_data{cop_filegv} = [112, \&PUT_objindex, "GET_objindex"];
+$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_objindex, "GET_objindex"];
+$insn_data{main_root} = [117, \&PUT_objindex, "GET_objindex"];
+$insn_data{curpad} = [118, \&PUT_objindex, "GET_objindex"];
+
+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;
diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
new file mode 100644
index 0000000000..0729b90f28
--- /dev/null
+++ b/ext/B/B/Assembler.pm
@@ -0,0 +1,207 @@
+#      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;
diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm
new file mode 100644
index 0000000000..125c8a3c65
--- /dev/null
+++ b/ext/B/B/Bblock.pm
@@ -0,0 +1,142 @@
+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;
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
new file mode 100644
index 0000000000..447bd3700a
--- /dev/null
+++ b/ext/B/B/Bytecode.pm
@@ -0,0 +1,778 @@
+#      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;
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
new file mode 100644
index 0000000000..4158bc40ac
--- /dev/null
+++ b/ext/B/B/C.pm
@@ -0,0 +1,1201 @@
+#      C.pm
+#
+#      Copyright (c) 1996, 1997 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::C;
+use Exporter ();
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(output_all output_boilerplate output_main
+		init_sections set_callback save_unused_subs objsym);
+
+use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
+	 class cstring cchar svref_2object compile_stats comppadlist hash
+	 threadsv_names);
+use B::Asmdata qw(@specialsv_name);
+
+use FileHandle;
+use Carp;
+use strict;
+
+my $hv_index = 0;
+my $gv_index = 0;
+my $re_index = 0;
+my $pv_index = 0;
+my $anonsub_index = 0;
+
+my %symtable;
+my $warn_undefined_syms;
+my $verbose;
+my @unused_sub_packages;
+my $nullop_count;
+my $pv_copy_on_grow;
+my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
+
+my @threadsv_names;
+BEGIN {
+    @threadsv_names = threadsv_names();
+}
+
+# Code sections
+my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, $cvopsect,
+    $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
+    $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
+    $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
+    $xrvsect, $xpvbmsect, $xpviosect);
+
+sub walk_and_save_optree;
+my $saveoptree_callback = \&walk_and_save_optree;
+sub set_callback { $saveoptree_callback = shift }
+sub saveoptree { &$saveoptree_callback(@_) }
+
+sub walk_and_save_optree {
+    my ($name, $root, $start) = @_;
+    walkoptree($root, "save");
+    return objsym($start);
+}
+
+# Current workaround/fix for op_free() trying to free statically
+# defined OPs is to set op_seq = -1 and check for that in op_free().
+# Instead of hardwiring -1 in place of $op->seq, we use $op_seq
+# so that it can be changed back easily if necessary. In fact, to
+# stop compilers from moaning about a U16 being initialised with an
+# uncast -1 (the printf format is %d so we can't tweak it), we have
+# to "know" that op_seq is a U16 and use 65535. Ugh.
+my $op_seq = 65535;
+
+sub AVf_REAL () { 1 }
+
+# XXX This shouldn't really be hardcoded here but it saves
+# looking up the name of every BASEOP in B::OP
+sub OP_THREADSV () { 345 }
+
+sub savesym {
+    my ($obj, $value) = @_;
+    my $sym = sprintf("s\\_%x", $$obj);
+    $symtable{$sym} = $value;
+}
+
+sub objsym {
+    my $obj = shift;
+    return $symtable{sprintf("s\\_%x", $$obj)};
+}
+
+sub getsym {
+    my $sym = shift;
+    my $value;
+
+    return 0 if $sym eq "sym_0";	# special case
+    $value = $symtable{$sym};
+    if (defined($value)) {
+	return $value;
+    } else {
+	warn "warning: undefined symbol $sym\n" if $warn_undefined_syms;
+	return "UNUSED";
+    }
+}
+
+sub savepv {
+    my $pv = shift;
+    my $pvsym = 0;
+    my $pvmax = 0;
+    if ($pv_copy_on_grow) {
+	my $cstring = cstring($pv);
+	if ($cstring ne "0") { # sic
+	    $pvsym = sprintf("pv%d", $pv_index++);
+	    $decl->add(sprintf("static char %s[] = %s;", $pvsym, $cstring));
+	}
+    } else {
+	$pvmax = length($pv) + 1;
+    }
+    return ($pvsym, $pvmax);
+}
+
+sub B::OP::save {
+    my ($op, $level) = @_;
+    my $type = $op->type;
+    $nullop_count++ unless $type;
+    if ($type == OP_THREADSV) {
+	# saves looking up ppaddr but it's a bit naughty to hard code this
+	$init->add(sprintf("(void)find_threadsv(%s);",
+			   cstring($threadsv_names[$op->targ])));
+    }
+    $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+			 ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
+			 $type, $op_seq, $op->flags, $op->private));
+    savesym($op, sprintf("&op_list[%d]", $opsect->index));
+}
+
+sub B::FAKEOP::new {
+    my ($class, %objdata) = @_;
+    bless \%objdata, $class;
+}
+
+sub B::FAKEOP::save {
+    my ($op, $level) = @_;
+    $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x",
+			 $op->next, $op->sibling, $op->ppaddr, $op->targ,
+			 $op->type, $op_seq, $op->flags, $op->private));
+    return sprintf("&op_list[%d]", $opsect->index);
+}
+
+sub B::FAKEOP::next { $_[0]->{"next"} || 0 }
+sub B::FAKEOP::type { $_[0]->{type} || 0}
+sub B::FAKEOP::sibling { $_[0]->{sibling} || 0 }
+sub B::FAKEOP::ppaddr { $_[0]->{ppaddr} || 0 }
+sub B::FAKEOP::targ { $_[0]->{targ} || 0 }
+sub B::FAKEOP::flags { $_[0]->{flags} || 0 }
+sub B::FAKEOP::private { $_[0]->{private} || 0 }
+
+sub B::UNOP::save {
+    my ($op, $level) = @_;
+    $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}));
+    savesym($op, sprintf("(OP*)&unop_list[%d]", $unopsect->index));
+}
+
+sub B::BINOP::save {
+    my ($op, $level) = @_;
+    $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->last}));
+    savesym($op, sprintf("(OP*)&binop_list[%d]", $binopsect->index));
+}
+
+sub B::LISTOP::save {
+    my ($op, $level) = @_;
+    $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
+			     ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			     $op->targ, $op->type, $op_seq, $op->flags,
+			     $op->private, ${$op->first}, ${$op->last},
+			     $op->children));
+    savesym($op, sprintf("(OP*)&listop_list[%d]", $listopsect->index));
+}
+
+sub B::LOGOP::save {
+    my ($op, $level) = @_;
+    $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+			    ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			    $op->targ, $op->type, $op_seq, $op->flags,
+			    $op->private, ${$op->first}, ${$op->other}));
+    savesym($op, sprintf("(OP*)&logop_list[%d]", $logopsect->index));
+}
+
+sub B::CONDOP::save {
+    my ($op, $level) = @_;
+    $condopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x",
+			     ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			     $op->targ, $op->type, $op_seq, $op->flags,
+			     $op->private, ${$op->first}, ${$op->true},
+			     ${$op->false}));
+    savesym($op, sprintf("(OP*)&condop_list[%d]", $condopsect->index));
+}
+
+sub B::LOOP::save {
+    my ($op, $level) = @_;
+    #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
+    #		 peekop($op->redoop), peekop($op->nextop),
+    #		 peekop($op->lastop)); # debug
+    $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, ${$op->first}, ${$op->last},
+			   $op->children, ${$op->redoop}, ${$op->nextop},
+			   ${$op->lastop}));
+    savesym($op, sprintf("(OP*)&loop_list[%d]", $loopsect->index));
+}
+
+sub B::PVOP::save {
+    my ($op, $level) = @_;
+    $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, cstring($op->pv)));
+    savesym($op, sprintf("(OP*)&pvop_list[%d]", $pvopsect->index));
+}
+
+sub B::SVOP::save {
+    my ($op, $level) = @_;
+    my $svsym = $op->sv->save;
+    $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private, "(SV*)$svsym"));
+    savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index));
+}
+
+sub B::GVOP::save {
+    my ($op, $level) = @_;
+    my $gvsym = $op->gv->save;
+    $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
+			   ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			   $op->targ, $op->type, $op_seq, $op->flags,
+			   $op->private));
+    $init->add(sprintf("gvop_list[%d].op_gv = %s;", $gvopsect->index, $gvsym));
+    savesym($op, sprintf("(OP*)&gvop_list[%d]", $gvopsect->index));
+}
+
+sub B::COP::save {
+    my ($op, $level) = @_;
+    my $gvsym = $op->filegv->save;
+    my $stashsym = $op->stash->save;
+    warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
+	if $debug_cops;
+    $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
+			  ${$op->next}, ${$op->sibling}, $op->ppaddr,
+			  $op->targ, $op->type, $op_seq, $op->flags,
+			  $op->private, cstring($op->label), $op->cop_seq,
+			  $op->arybase, $op->line));
+    my $copix = $copsect->index;
+    $init->add(sprintf("cop_list[%d].cop_filegv = %s;", $copix, $gvsym),
+	       sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym));
+    savesym($op, "(OP*)&cop_list[$copix]");
+}
+
+sub B::PMOP::save {
+    my ($op, $level) = @_;
+    my $replroot = $op->pmreplroot;
+    my $replstart = $op->pmreplstart;
+    my $replrootfield = sprintf("s\\_%x", $$replroot);
+    my $replstartfield = sprintf("s\\_%x", $$replstart);
+    my $gvsym;
+    my $ppaddr = $op->ppaddr;
+    if ($$replroot) {
+	# OP_PUSHRE (a mutated version of OP_MATCH for the regexp
+	# argument to a split) stores a GV in op_pmreplroot instead
+	# of a substitution syntax tree. We don't want to walk that...
+	if ($ppaddr eq "pp_pushre") {
+	    $gvsym = $replroot->save;
+#	    warn "PMOP::save saving a pp_pushre with GV $gvsym\n"; # debug
+	    $replrootfield = 0;
+	} else {
+	    $replstartfield = saveoptree("*ignore*", $replroot, $replstart);
+	}
+    }
+    # pmnext handling is broken in perl itself, I think. Bad op_pmnext
+    # fields aren't noticed in perl's runtime (unless you try reset) but we
+    # segfault when trying to dereference it to find op->op_pmnext->op_type
+    $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
+			   ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
+			   $op->type, $op_seq, $op->flags, $op->private,
+			   ${$op->first}, ${$op->last}, $op->children,
+			   $replrootfield, $replstartfield,
+			   $op->pmflags, $op->pmpermflags,));
+    my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
+    my $re = $op->precomp;
+    if (defined($re)) {
+	my $resym = sprintf("re%d", $re_index++);
+	$decl->add(sprintf("static char *$resym = %s;", cstring($re)));
+	$init->add(sprintf("$pm.op_pmregexp = pregcomp($resym, $resym + %u, &$pm);",
+			   length($re)));
+    }
+    if ($gvsym) {
+	$init->add("$pm.op_pmreplroot = (OP*)$gvsym;");
+    }
+    savesym($op, sprintf("(OP*)&pmop_list[%d]", $pmopsect->index));
+}
+
+sub B::SPECIAL::save {
+    my ($sv) = @_;
+    # special case: $$sv is not the address but an index into specialsv_list
+#   warn "SPECIAL::save specialsv $$sv\n"; # debug
+    my $sym = $specialsv_name[$$sv];
+    if (!defined($sym)) {
+	confess "unknown specialsv index $$sv passed to B::SPECIAL::save";
+    }
+    return $sym;
+}
+
+sub B::OBJECT::save {}
+
+sub B::NULL::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+#   warn "Saving SVt_NULL SV\n"; # debug
+    # debug
+    #if ($$sv == 0) {
+    #	warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
+    #}
+    $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::IV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xpvivsect->add(sprintf("0, 0, 0, %d", $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %lu, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::NV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVLV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    my ($lvtarg, $lvtarg_sym);
+    $xpvlvsect->add(sprintf("%s, %u, %u, %d, %g, 0, 0, %u, %u, 0, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX, 
+			    $sv->TARGOFF, $sv->TARGLEN, cchar($sv->TYPE)));
+    $svsect->add(sprintf("&xpvlv_list[%d], %lu, 0x%x",
+			 $xpvlvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvlv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvlvsect->index, cstring($pv), $len));
+    }
+    $sv->save_magic;
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVIV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvivsect->add(sprintf("%s, %u, %u, %d", $pvsym, $len, $pvmax, $sv->IVX));
+    $svsect->add(sprintf("&xpviv_list[%d], %u, 0x%x",
+			 $xpvivsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpviv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvivsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVNV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
+			 $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvnv_list[%d].xpv_pv = savepvn(%s,%u);",
+			   $xpvnvsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::BM::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV . "\0" . $sv->TABLE;
+    my $len = length($pv);
+    $xpvbmsect->add(sprintf("0, %u, %u, %d, %s, 0, 0, %d, %u, 0x%x",
+			    $len, $len + 258, $sv->IVX, $sv->NVX,
+			    $sv->USEFUL, $sv->PREVIOUS, $sv->RARE));
+    $svsect->add(sprintf("&xpvbm_list[%d], %lu, 0x%x",
+			 $xpvbmsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    $sv->save_magic;
+    $init->add(sprintf("xpvbm_list[%d].xpv_pv = savepvn(%s, %u);",
+		       $xpvbmsect->index, cstring($pv), $len),
+	       sprintf("xpvbm_list[%d].xpv_cur = %u;",
+		       $xpvbmsect->index, $len - 257));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvsect->add(sprintf("%s, %u, %u", $pvsym, $len, $pvmax));
+    $svsect->add(sprintf("&xpv_list[%d], %lu, 0x%x",
+			 $xpvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpv_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvsect->index, cstring($pv), $len));
+    }
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub B::PVMG::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    my $pv = $sv->PV;
+    my $len = length($pv);
+    my ($pvsym, $pvmax) = savepv($pv);
+    $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
+			    $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
+			 $xpvmgsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    if (!$pv_copy_on_grow) {
+	$init->add(sprintf("xpvmg_list[%d].xpv_pv = savepvn(%s, %u);",
+			   $xpvmgsect->index, cstring($pv), $len));
+    }
+    $sym = savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+    $sv->save_magic;
+    return $sym;
+}
+
+sub B::PVMG::save_magic {
+    my ($sv) = @_;
+    #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
+    my $stash = $sv->SvSTASH;
+    if ($$stash) {
+	warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
+	    if $debug_mg;
+	# XXX Hope stash is already going to be saved.
+	$init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
+    }
+    my @mgchain = $sv->MAGIC;
+    my ($mg, $type, $obj, $ptr);
+    foreach $mg (@mgchain) {
+	$type = $mg->TYPE;
+	$obj = $mg->OBJ;
+	$ptr = $mg->PTR;
+	my $len = defined($ptr) ? length($ptr) : 0;
+	if ($debug_mg) {
+	    warn sprintf("magic %s (0x%x), obj %s (0x%x), type %s, ptr %s\n",
+			 class($sv), $$sv, class($obj), $$obj,
+			 cchar($type), cstring($ptr));
+	}
+	$init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
+			   $$sv, $$obj, cchar($type),cstring($ptr),$len));
+    }
+}
+
+sub B::RV::save {
+    my ($sv) = @_;
+    my $sym = objsym($sv);
+    return $sym if defined $sym;
+    $xrvsect->add($sv->RV->save);
+    $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
+			 $xrvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
+    return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
+}
+
+sub try_autoload {
+    my ($cvstashname, $cvname) = @_;
+    warn sprintf("No definition for sub %s::%s\n", $cvstashname, $cvname);
+    # Handle AutoLoader classes explicitly. Any more general AUTOLOAD
+    # use should be handled by the class itself.
+    no strict 'refs';
+    my $isa = \@{"$cvstashname\::ISA"};
+    if (grep($_ eq "AutoLoader", @$isa)) {
+	warn "Forcing immediate load of sub derived from AutoLoader\n";
+	# Tweaked version of AutoLoader::AUTOLOAD
+	my $dir = $cvstashname;
+	$dir =~ s(::)(/)g;
+	eval { require "auto/$dir/$cvname.al" };
+	if ($@) {
+	    warn qq(failed require "auto/$dir/$cvname.al": $@\n);
+	    return 0;
+	} else {
+	    return 1;
+	}
+    }
+}
+
+sub B::CV::save {
+    my ($cv) = @_;
+    my $sym = objsym($cv);
+    if (defined($sym)) {
+#	warn sprintf("CV 0x%x already saved as $sym\n", $$cv); # debug
+	return $sym;
+    }
+    # Reserve a place in svsect and xpvcvsect and record indices
+    my $sv_ix = $svsect->index + 1;
+    $svsect->add("svix$sv_ix");
+    my $xpvcv_ix = $xpvcvsect->index + 1;
+    $xpvcvsect->add("xpvcvix$xpvcv_ix");
+    # Save symbol now so that GvCV() doesn't recurse back to us via CvGV()
+    $sym = savesym($cv, "&sv_list[$sv_ix]");
+    warn sprintf("saving CV 0x%x as $sym\n", $$cv) if $debug_cv;
+    my $gv = $cv->GV;
+    my $cvstashname = $gv->STASH->NAME;
+    my $cvname = $gv->NAME;
+    my $root = $cv->ROOT;
+    my $cvxsub = $cv->XSUB;
+    if (!$$root && !$cvxsub) {
+	if (try_autoload($cvstashname, $cvname)) {
+	    # Recalculate root and xsub
+	    $root = $cv->ROOT;
+	    $cvxsub = $cv->XSUB;
+	    if ($$root || $cvxsub) {
+		warn "Successful forced autoload\n";
+	    }
+	}
+    }
+    my $startfield = 0;
+    my $padlist = $cv->PADLIST;
+    my $pv = $cv->PV;
+    my $xsub = 0;
+    my $xsubany = "Nullany";
+    if ($$root) {
+	warn sprintf("saving op tree for CV 0x%x, root = 0x%x\n",
+		     $$cv, $$root) if $debug_cv;
+	my $ppname = "";
+	if ($$gv) {
+	    my $stashname = $gv->STASH->NAME;
+	    my $gvname = $gv->NAME;
+	    if ($gvname ne "__ANON__") {
+		$ppname = (${$gv->FORM} == $$cv) ? "pp_form_" : "pp_sub_";
+		$ppname .= ($stashname eq "main") ?
+			    $gvname : "$stashname\::$gvname";
+		$ppname =~ s/::/__/g;
+	    }
+	}
+	if (!$ppname) {
+	    $ppname = "pp_anonsub_$anonsub_index";
+	    $anonsub_index++;
+	}
+	$startfield = saveoptree($ppname, $root, $cv->START, $padlist->ARRAY);
+	warn sprintf("done saving op tree for CV 0x%x, name %s, root 0x%x\n",
+		     $$cv, $ppname, $$root) if $debug_cv;
+	if ($$padlist) {
+	    warn sprintf("saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	    $padlist->save;
+	    warn sprintf("done saving PADLIST 0x%x for CV 0x%x\n",
+			 $$padlist, $$cv) if $debug_cv;
+	}
+    }
+    elsif ($cvxsub) {
+	$xsubany = sprintf("ANYINIT((void*)0x%x)", $cv->XSUBANY);
+	# Try to find out canonical name of XSUB function from EGV.
+	# XXX Doesn't work for XSUBs with PREFIX set (or anyone who
+	# calls newXS() manually with weird arguments).
+	my $egv = $gv->EGV;
+	my $stashname = $egv->STASH->NAME;
+	$stashname =~ s/::/__/g;
+	$xsub = sprintf("XS_%s_%s", $stashname, $egv->NAME);
+	$decl->add("void $xsub _((CV*));");
+    }
+    else {
+	warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
+		     $cvstashname, $cvname); # debug
+    }
+    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0",
+			  $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
+			  $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
+			  $$padlist, ${$cv->OUTSIDE}));
+    if ($$gv) {
+	$gv->save;
+	$init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
+	warn sprintf("done saving GV 0x%x for CV 0x%x\n",
+		     $$gv, $$cv) if $debug_cv;
+    }
+    my $filegv = $cv->FILEGV;
+    if ($$filegv) {
+	$filegv->save;
+	$init->add(sprintf("CvFILEGV(s\\_%x) = s\\_%x;", $$cv, $$filegv));
+	warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n",
+		     $$filegv, $$cv) if $debug_cv;
+    }
+    my $stash = $cv->STASH;
+    if ($$stash) {
+	$stash->save;
+	$init->add(sprintf("CvSTASH(s\\_%x) = s\\_%x;", $$cv, $$stash));
+	warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
+		     $$stash, $$cv) if $debug_cv;
+    }
+    $symsect->add(sprintf("svix%d\t(XPVCV*)&xpvcv_list[%u], %lu, 0x%x",
+			  $sv_ix, $xpvcv_ix, $cv->REFCNT + 1, $cv->FLAGS));
+    return $sym;
+}
+
+sub B::GV::save {
+    my ($gv) = @_;
+    my $sym = objsym($gv);
+    if (defined($sym)) {
+	#warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
+	return $sym;
+    } else {
+	my $ix = $gv_index++;
+	$sym = savesym($gv, "gv_list[$ix]");
+	#warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
+    }
+    my $gvname = $gv->NAME;
+    my $name = cstring($gv->STASH->NAME . "::" . $gvname);
+    #warn "GV name is $name\n"; # debug
+    my $egv = $gv->EGV;
+    my $egvsym;
+    if ($$gv != $$egv) {
+	#warn(sprintf("EGV name is %s, saving it now\n",
+	#	     $egv->STASH->NAME . "::" . $egv->NAME)); # debug
+	$egvsym = $egv->save;
+    }
+    $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
+	       sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS),
+	       sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS),
+	       sprintf("GvLINE($sym) = %u;", $gv->LINE));
+    # Shouldn't need to do save_magic since gv_fetchpv handles that
+    #$gv->save_magic;
+    my $refcnt = $gv->REFCNT + 1;
+    $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1;
+    my $gvrefcnt = $gv->GvREFCNT;
+    if ($gvrefcnt > 1) {
+	$init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
+    }
+    if (defined($egvsym)) {
+	# Shared glob *foo = *bar
+	$init->add("gp_free($sym);",
+		   "GvGP($sym) = GvGP($egvsym);");
+    } elsif ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
+	# Don't save subfields of special GVs (*_, *1, *# and so on)
+#	warn "GV::save saving subfields\n"; # debug
+	my $gvsv = $gv->SV;
+	if ($$gvsv) {
+	    $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
+#	    warn "GV::save \$$name\n"; # debug
+	    $gvsv->save;
+	}
+	my $gvav = $gv->AV;
+	if ($$gvav) {
+	    $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
+#	    warn "GV::save \@$name\n"; # debug
+	    $gvav->save;
+	}
+	my $gvhv = $gv->HV;
+	if ($$gvhv) {
+	    $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
+#	    warn "GV::save \%$name\n"; # debug
+	    $gvhv->save;
+	}
+	my $gvcv = $gv->CV;
+	if ($$gvcv) {
+	    $init->add(sprintf("GvCV($sym) = (CV*)s\\_%x;", $$gvcv));
+#	    warn "GV::save &$name\n"; # debug
+	    $gvcv->save;
+	}
+	my $gvfilegv = $gv->FILEGV;
+	if ($$gvfilegv) {
+	    $init->add(sprintf("GvFILEGV($sym) = s\\_%x;",$$gvfilegv));
+#	    warn "GV::save GvFILEGV(*$name)\n"; # debug
+	    $gvfilegv->save;
+	}
+	my $gvform = $gv->FORM;
+	if ($$gvform) {
+	    $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
+#	    warn "GV::save GvFORM(*$name)\n"; # debug
+	    $gvform->save;
+	}
+	my $gvio = $gv->IO;
+	if ($$gvio) {
+	    $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
+#	    warn "GV::save GvIO(*$name)\n"; # debug
+	    $gvio->save;
+	}
+    }
+    return $sym;
+}
+sub B::AV::save {
+    my ($av) = @_;
+    my $sym = objsym($av);
+    return $sym if defined $sym;
+    my $avflags = $av->AvFLAGS;
+    $xpvavsect->add(sprintf("0, -1, -1, 0, 0.0, 0, Nullhv, 0, 0, 0x%x",
+			    $avflags));
+    $svsect->add(sprintf("&xpvav_list[%d], %lu, 0x%x",
+			 $xpvavsect->index, $av->REFCNT + 1, $av->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my $fill = $av->FILL;
+    $av->save_magic;
+    warn sprintf("saving AV 0x%x FILL=$fill AvFLAGS=0x%x", $$av, $avflags)
+	if $debug_av;
+    # XXX AVf_REAL is wrong test: need to save comppadlist but not stack
+    #if ($fill > -1 && ($avflags & AVf_REAL)) {
+    if ($fill > -1) {
+	my @array = $av->ARRAY;
+	if ($debug_av) {
+	    my $el;
+	    my $i = 0;
+	    foreach $el (@array) {
+		warn sprintf("AV 0x%x[%d] = %s 0x%x\n",
+			     $$av, $i++, class($el), $$el);
+	    }
+	}
+	my @names = map($_->save, @array);
+	# XXX Better ways to write loop?
+	# Perhaps svp[0] = ...; svp[1] = ...; svp[2] = ...;
+	# Perhaps I32 i = 0; svp[i++] = ...; svp[i++] = ...; svp[i++] = ...;
+	$init->add("{",
+		   "\tSV **svp;",
+		   "\tAV *av = (AV*)&sv_list[$sv_list_index];",
+		   "\tav_extend(av, $fill);",
+		   "\tsvp = AvARRAY(av);",
+	       map("\t*svp++ = (SV*)$_;", @names),
+		   "\tAvFILLp(av) = $fill;",
+		   "}");
+    } else {
+	my $max = $av->MAX;
+	$init->add("av_extend((AV*)&sv_list[$sv_list_index], $max);")
+	    if $max > -1;
+    }
+    return savesym($av, "(AV*)&sv_list[$sv_list_index]");
+}
+
+sub B::HV::save {
+    my ($hv) = @_;
+    my $sym = objsym($hv);
+    return $sym if defined $sym;
+    my $name = $hv->NAME;
+    if ($name) {
+	# It's a stash
+
+	# A perl bug means HvPMROOT isn't altered when a PMOP is freed. Usually
+	# the only symptom is that sv_reset tries to reset the PMf_USED flag of
+	# a trashed op but we look at the trashed op_type and segfault.
+	#my $adpmroot = ${$hv->PMROOT};
+	my $adpmroot = 0;
+	$decl->add("static HV *hv$hv_index;");
+	# XXX Beware of weird package names containing double-quotes, \n, ...?
+	$init->add(qq[hv$hv_index = gv_stashpv("$name", TRUE);]);
+	if ($adpmroot) {
+	    $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)s\\_%x;",
+			       $adpmroot));
+	}
+	$sym = savesym($hv, "hv$hv_index");
+	$hv_index++;
+	return $sym;
+    }
+    # It's just an ordinary HV
+    $xpvhvsect->add(sprintf("0, 0, %d, 0, 0.0, 0, Nullhv, %d, 0, 0, 0",
+			    $hv->MAX, $hv->RITER));
+    $svsect->add(sprintf("&xpvhv_list[%d], %lu, 0x%x",
+			 $xpvhvsect->index, $hv->REFCNT + 1, $hv->FLAGS));
+    my $sv_list_index = $svsect->index;
+    my @contents = $hv->ARRAY;
+    if (@contents) {
+	my $i;
+	for ($i = 1; $i < @contents; $i += 2) {
+	    $contents[$i] = $contents[$i]->save;
+	}
+	$init->add("{", "\tHV *hv = (HV*)&sv_list[$sv_list_index];");
+	while (@contents) {
+	    my ($key, $value) = splice(@contents, 0, 2);
+	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
+			       cstring($key),length($key),$value, hash($key)));
+	}
+	$init->add("}");
+    }
+    return savesym($hv, "(HV*)&sv_list[$sv_list_index]");
+}
+
+sub B::IO::save {
+    my ($io) = @_;
+    my $sym = objsym($io);
+    return $sym if defined $sym;
+    my $pv = $io->PV;
+    my $len = length($pv);
+    $xpviosect->add(sprintf("0, %u, %u, %d, %s, 0, 0, 0, 0, 0, %d, %d, %d, %d, %s, Nullgv, %s, Nullgv, %s, Nullgv, %d, %s, 0x%x",
+			    $len, $len+1, $io->IVX, $io->NVX, $io->LINES,
+			    $io->PAGE, $io->PAGE_LEN, $io->LINES_LEFT,
+			    cstring($io->TOP_NAME), cstring($io->FMT_NAME), 
+			    cstring($io->BOTTOM_NAME), $io->SUBPROCESS,
+			    cchar($io->IoTYPE), $io->IoFLAGS));
+    $svsect->add(sprintf("&xpvio_list[%d], %lu, 0x%x",
+			 $xpviosect->index, $io->REFCNT + 1, $io->FLAGS));
+    $sym = savesym($io, sprintf("(IO*)&sv_list[%d]", $svsect->index));
+    my ($field, $fsym);
+    foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
+      	$fsym = $io->$field();
+	if ($$fsym) {
+	    $init->add(sprintf("Io$field($sym) = (GV*)s\\_%x;", $$fsym));
+	    $fsym->save;
+	}
+    }
+    $io->save_magic;
+    return $sym;
+}
+
+sub B::SV::save {
+    my $sv = shift;
+    # This is where we catch an honest-to-goodness Nullsv (which gets
+    # blessed into B::SV explicitly) and any stray erroneous SVs.
+    return 0 unless $$sv;
+    confess sprintf("cannot save that type of SV: %s (0x%x)\n",
+		    class($sv), $$sv);
+}
+
+sub output_all {
+    my $init_name = shift;
+    my $section;
+    my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
+		    $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect,
+		    $cvopsect, $loopsect, $copsect, $svsect, $xpvsect,
+		    $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
+		    $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
+    $symsect->output(\*STDOUT, "#define %s\n");
+    print "\n";
+    output_declarations();
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    print "Static $typename ${name}_list[$lines];\n";
+	}
+    }
+    $decl->output(\*STDOUT, "%s\n");
+    print "\n";
+    foreach $section (@sections) {
+	my $lines = $section->index + 1;
+	if ($lines) {
+	    my $name = $section->name;
+	    my $typename = ($name eq "xpvcv") ? "XPVCV_or_similar" : uc($name);
+	    printf "static %s %s_list[%u] = {\n", $typename, $name, $lines;
+	    $section->output(\*STDOUT, "\t{ %s },\n");
+	    print "};\n\n";
+	}
+    }
+
+    print <<"EOT";
+static int $init_name()
+{
+	dTHR;
+EOT
+    $init->output(\*STDOUT, "\t%s\n");
+    print "\treturn 0;\n}\n";
+    if ($verbose) {
+	warn compile_stats();
+	warn "NULLOP count: $nullop_count\n";
+    }
+}
+
+sub output_declarations {
+    print <<'EOT';
+#ifdef BROKEN_STATIC_REDECL
+#define Static extern
+#else
+#define Static static
+#endif /* BROKEN_STATIC_REDECL */
+
+#ifdef BROKEN_UNION_INIT
+/*
+ * Cribbed from cv.h with ANY (a union) replaced by void*.
+ * Some pre-Standard compilers can't cope with initialising unions. Ho hum.
+ */
+typedef struct {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xp_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xof_off;	/* integer value */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    HV *	xcv_stash;
+    OP *	xcv_start;
+    OP *	xcv_root;
+    void      (*xcv_xsub) _((CV*));
+    void *	xcv_xsubany;
+    GV *	xcv_gv;
+    GV *	xcv_filegv;
+    long	xcv_depth;		/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+#ifdef USE_THREADS
+    perl_mutex *xcv_mutexp;
+    struct perl_thread *xcv_owner;	/* current owner thread */
+#endif /* USE_THREADS */
+    U8		xcv_flags;
+} XPVCV_or_similar;
+#define ANYINIT(i) i
+#else
+#define XPVCV_or_similar XPVCV
+#define ANYINIT(i) {i}
+#endif /* BROKEN_UNION_INIT */
+#define Nullany ANYINIT(0)
+
+#define UNUSED 0
+#define sym_0 0
+
+EOT
+    print "static GV *gv_list[$gv_index];\n" if $gv_index;
+    print "\n";
+}
+
+
+sub output_boilerplate {
+    print <<'EOT';
+#include "EXTERN.h"
+#include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+
+/* Workaround for mapstart: the only op which needs a different ppaddr */
+#undef pp_mapstart
+#define pp_mapstart pp_grepstart
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+EOT
+}
+
+sub output_main {
+    print <<'EOT';
+int
+#ifndef CAN_PROTOTYPE
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#else  /* def(CAN_PROTOTYPE) */
+main(int argc, char **argv, char **env)
+#endif  /* def(CAN_PROTOTYPE) */
+{
+    int exitstatus;
+    int i;
+    char **fakeargv;
+
+    PERL_SYS_INIT(&argc,&argv);
+ 
+    perl_init_i18nl10n(1);
+
+    if (!do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+    }
+
+#ifdef CSH
+    if (!cshlen) 
+      cshlen = strlen(cshname);
+#endif
+
+#ifdef ALLOW_PERL_OPTIONS
+#define EXTRA_OPTIONS 2
+#else
+#define EXTRA_OPTIONS 3
+#endif /* ALLOW_PERL_OPTIONS */
+    New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+    fakeargv[0] = argv[0];
+    fakeargv[1] = "-e";
+    fakeargv[2] = "";
+#ifndef ALLOW_PERL_OPTIONS
+    fakeargv[3] = "--";
+#endif /* ALLOW_PERL_OPTIONS */
+    for (i = 1; i < argc; i++)
+	fakeargv[i + EXTRA_OPTIONS] = argv[i];
+    fakeargv[argc + EXTRA_OPTIONS] = 0;
+    
+    exitstatus = perl_parse(my_perl, xs_init, argc + EXTRA_OPTIONS,
+			    fakeargv, NULL);
+    if (exitstatus)
+	exit( exitstatus );
+
+    sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
+    main_cv = compcv;
+    compcv = 0;
+
+    exitstatus = perl_init();
+    if (exitstatus)
+	exit( exitstatus );
+
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    exit( exitstatus );
+}
+
+static void
+xs_init()
+{
+}
+EOT
+}
+
+sub dump_symtable {
+    # For debugging
+    my ($sym, $val);
+    warn "----Symbol table:\n";
+    while (($sym, $val) = each %symtable) {
+	warn "$sym => $val\n";
+    }
+    warn "---End of symbol table\n";
+}
+
+sub save_object {
+    my $sv;
+    foreach $sv (@_) {
+	svref_2object($sv)->save;
+    }
+}
+
+sub B::GV::savecv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    my $name = $gv->NAME;
+    if ($$cv && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) {
+	if ($debug_cv) {
+	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+			 $gv->STASH->NAME, $name, $$cv, $$gv);
+	}
+	$gv->save;
+    }
+}
+
+sub save_unused_subs {
+    my %search_pack;
+    map { $search_pack{$_} = 1 } @_;
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "savecv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return 1 if exists $search_pack{$package};
+	#warn "    (nothing explicit)\n";#debug
+	# Omit the packages which we use (and which cause grief
+	# because of fancy "goto &$AUTOLOAD" stuff).
+	# XXX Surely there must be a nicer way to do this.
+	if ($package eq "FileHandle"
+	    || $package eq "Config"
+	    || $package eq "SelectSaver") {
+	    return 0;
+	}
+	my $m;
+	foreach $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
+	    if (defined(&{$package."::$m"})) {
+		warn "$package has method $m: -u$package assumed\n";#debug
+		return 1;
+	    }
+	}
+	return 0;
+    });
+}
+
+sub save_main {
+    my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+    walkoptree(main_root, "save");
+    warn "done main optree, walking symtable for extras\n" if $debug_cv;
+    save_unused_subs(@unused_sub_packages);
+
+    $init->add(sprintf("main_root = s\\_%x;", ${main_root()}),
+	       sprintf("main_start = s\\_%x;", ${main_start()}),
+	       "curpad = AvARRAY($curpad_sym);");
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    print "\n";
+    output_main();
+}
+
+sub init_sections {
+    my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
+		    binop => \$binopsect, condop => \$condopsect,
+		    cop => \$copsect, cvop => \$cvopsect, gvop => \$gvopsect,
+		    listop => \$listopsect, logop => \$logopsect,
+		    loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
+		    pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
+		    sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
+		    xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
+		    xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
+		    xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
+		    xrv => \$xrvsect, xpvbm => \$xpvbmsect,
+		    xpvio => \$xpviosect);
+    my ($name, $sectref);
+    while (($name, $sectref) = splice(@sections, 0, 2)) {
+	$$sectref = new B::Section $name, \%symtable, 0;
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	}
+	if ($opt eq "w") {
+	    $warn_undefined_syms = 1;
+	} elsif ($opt eq "D") {
+	    $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "c") {
+		    $debug_cops = 1;
+		} elsif ($arg eq "A") {
+		    $debug_av = 1;
+		} elsif ($arg eq "C") {
+		    $debug_cv = 1;
+		} elsif ($arg eq "M") {
+		    $debug_mg = 1;
+		} else {
+		    warn "ignoring unknown debug option: $arg\n";
+		}
+	    }
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "v") {
+	    $verbose = 1;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    if ($arg eq "cog") {
+		$pv_copy_on_grow = 1;
+	    } elsif ($arg eq "no-cog") {
+		$pv_copy_on_grow = 0;
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    $pv_copy_on_grow = 0;
+	    if ($arg >= 1) {
+		# Optimisations for -O1
+		$pv_copy_on_grow = 1;
+	    }
+	}
+    }
+    init_sections();
+    if (@options) {
+	return sub {
+	    my $objname;
+	    foreach $objname (@options) {
+		eval "save_object(\\$objname)";
+	    }
+	    output_all();
+	}
+    } else {
+	return sub { save_main() };
+    }
+}
+
+1;
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
new file mode 100644
index 0000000000..fc7cf6dad2
--- /dev/null
+++ b/ext/B/B/CC.pm
@@ -0,0 +1,1528 @@
+#      CC.pm
+#
+#      Copyright (c) 1996, 1997 Malcolm Beattie
+#
+#      You may distribute under the terms of either the GNU General Public
+#      License or the Artistic License, as specified in the README file.
+#
+package B::CC;
+use strict;
+use B qw(main_start main_root class comppadlist peekop svref_2object
+	timing_info);
+use B::C qw(save_unused_subs objsym init_sections
+	    output_all output_boilerplate output_main);
+use B::Bblock qw(find_leaders);
+use B::Stackobj qw(:types :flags);
+
+# These should probably be elsewhere
+# Flags for $op->flags
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_MOD () { 32 }
+sub OPf_STACKED () { 64 }
+sub OPf_SPECIAL () { 128 }
+# op-specific flags for $op->private 
+sub OPpASSIGN_BACKWARDS () { 64 }
+sub OPpLVAL_INTRO () { 128 }
+sub OPpDEREF_AV () { 32 }
+sub OPpDEREF_HV () { 64 }
+sub OPpDEREF () { OPpDEREF_AV|OPpDEREF_HV }
+sub OPpFLIP_LINENUM () { 64 }
+sub G_ARRAY () { 1 }
+# cop.h
+sub CXt_NULL () { 0 }
+sub CXt_SUB () { 1 }
+sub CXt_EVAL () { 2 }
+sub CXt_LOOP () { 3 }
+sub CXt_SUBST () { 4 }
+sub CXt_BLOCK () { 5 }
+
+my $module;		# module name (when compiled with -m)
+my %done;		# hash keyed by $$op of leaders of basic blocks
+			# which have already been done.
+my $leaders;		# ref to hash of basic block leaders. Keys are $$op
+			# addresses, values are the $op objects themselves.
+my @bblock_todo;	# list of leaders of basic blocks that need visiting
+			# sometime.
+my @cc_todo;		# list of tuples defining what PP code needs to be
+			# saved (e.g. CV, main or PMOP repl code). Each tuple
+			# is [$name, $root, $start, @padlist]. PMOP repl code
+			# tuples inherit padlist.
+my @stack;		# shadows perl's stack when contents are known.
+			# Values are objects derived from class B::Stackobj
+my @pad;		# Lexicals in current pad as Stackobj-derived objects
+my @padlist;		# Copy of current padlist so PMOP repl code can find it
+my @cxstack;		# Shadows the (compile-time) cxstack for next,last,redo
+my $jmpbuf_ix = 0;	# Next free index for dynamically allocated jmpbufs
+my %constobj;		# OP_CONST constants as Stackobj-derived objects
+			# keyed by $$sv.
+my $need_freetmps = 0;	# We may postpone FREETMPS to the end of each basic
+			# block or even to the end of each loop of blocks,
+			# depending on optimisation options.
+my $know_op = 0;	# Set when C variable op already holds the right op
+			# (from an immediately preceding DOOP(ppname)).
+my $errors = 0;		# Number of errors encountered
+my %skip_stack;		# Hash of PP names which don't need write_back_stack
+my %skip_lexicals;	# Hash of PP names which don't need write_back_lexicals
+my %skip_invalidate;	# Hash of PP names which don't need invalidate_lexicals
+my %ignore_op;		# Hash of ops which do nothing except returning op_next
+
+BEGIN {
+    foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
+	$ignore_op{$_} = 1;
+    }
+}
+
+my @unused_sub_packages; # list of packages (given by -u options) to search
+			 # explicitly and save every sub we find there, even
+			 # if apparently unused (could be only referenced from
+			 # an eval "" or from a $SIG{FOO} = "bar").
+
+my ($module_name);
+my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
+    $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
+
+# Optimisation options. On the command line, use hyphens instead of
+# underscores for compatibility with gcc-style options. We use
+# underscores here because they are OK in (strict) barewords.
+my ($freetmps_each_bblock, $freetmps_each_loop, $omit_taint);
+my %optimise = (freetmps_each_bblock	=> \$freetmps_each_bblock,
+		freetmps_each_loop	=> \$freetmps_each_loop,
+		omit_taint		=> \$omit_taint);
+# perl patchlevel to generate code for (defaults to current patchlevel)
+my $patchlevel = int(0.5 + 1000 * ($]  - 5));
+
+# Could rewrite push_runtime() and output_runtime() to use a
+# temporary file if memory is at a premium.
+my $ppname;		# name of current fake PP function
+my $runtime_list_ref;
+my $declare_ref;	# Hash ref keyed by C variable type of declarations.
+
+my @pp_list;		# list of [$ppname, $runtime_list_ref, $declare_ref]
+			# tuples to be written out.
+
+my ($init, $decl);
+
+sub init_hash { map { $_ => 1 } @_ }
+
+#
+# Initialise the hashes for the default PP functions where we can avoid
+# either write_back_stack, write_back_lexicals or invalidate_lexicals.
+#
+%skip_lexicals = init_hash qw(pp_enter pp_enterloop);
+%skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+
+sub debug {
+    if ($debug_runtime) {
+	warn(@_);
+    } else {
+	runtime(map { chomp; "/* $_ */"} @_);
+    }
+}
+
+sub declare {
+    my ($type, $var) = @_;
+    push(@{$declare_ref->{$type}}, $var);
+}
+
+sub push_runtime {
+    push(@$runtime_list_ref, @_);
+    warn join("\n", @_) . "\n" if $debug_runtime;
+}
+
+sub save_runtime {
+    push(@pp_list, [$ppname, $runtime_list_ref, $declare_ref]);
+}
+
+sub output_runtime {
+    my $ppdata;
+    print qq(#include "cc_runtime.h"\n);
+    foreach $ppdata (@pp_list) {
+	my ($name, $runtime, $declare) = @$ppdata;
+	print "\nstatic\nPP($name)\n{\n";
+	my ($type, $varlist, $line);
+	while (($type, $varlist) = each %$declare) {
+	    print "\t$type ", join(", ", @$varlist), ";\n";
+	}
+	foreach $line (@$runtime) {
+	    print $line, "\n";
+	}
+	print "}\n";
+    }
+}
+
+sub runtime {
+    my $line;
+    foreach $line (@_) {
+	push_runtime("\t$line");
+    }
+}
+
+sub init_pp {
+    $ppname = shift;
+    $runtime_list_ref = [];
+    $declare_ref = {};
+    runtime("djSP;");
+    declare("I32", "oldsave");
+    declare("SV", "**svp");
+    map { declare("SV", "*$_") } qw(sv src dst left right);
+    declare("MAGIC", "*mg");
+    $decl->add("static OP * $ppname _((ARGSproto));");
+    debug "init_pp: $ppname\n" if $debug_queue;
+}
+
+# Initialise runtime_callback function for Stackobj class
+BEGIN { B::Stackobj::set_callback(\&runtime) }
+
+# Initialise saveoptree_callback for B::C class
+sub cc_queue {
+    my ($name, $root, $start, @pl) = @_;
+    debug "cc_queue: name $name, root $root, start $start, padlist (@pl)\n"
+	if $debug_queue;
+    if ($name eq "*ignore*") {
+	$name = 0;
+    } else {
+	push(@cc_todo, [$name, $root, $start, (@pl ? @pl : @padlist)]);
+    }
+    my $fakeop = new B::FAKEOP ("next" => 0, sibling => 0, ppaddr => $name);
+    $start = $fakeop->save;
+    debug "cc_queue: name $name returns $start\n" if $debug_queue;
+    return $start;
+}
+BEGIN { B::C::set_callback(\&cc_queue) }
+
+sub valid_int { $_[0]->{flags} & VALID_INT }
+sub valid_double { $_[0]->{flags} & VALID_DOUBLE }
+sub valid_numeric { $_[0]->{flags} & (VALID_INT | VALID_DOUBLE) }
+sub valid_sv { $_[0]->{flags} & VALID_SV }
+
+sub top_int { @stack ? $stack[-1]->as_int : "TOPi" }
+sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
+sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
+sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
+sub top_bool { @stack ? $stack[-1]->as_numeric : "SvTRUE(TOPs)" }
+
+sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
+sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
+sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" }
+sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
+sub pop_bool {
+    if (@stack) {
+	return ((pop @stack)->as_numeric);
+    } else {
+	# Careful: POPs has an auto-decrement and SvTRUE evaluates
+	# its argument more than once.
+	runtime("sv = POPs;");
+	return "SvTRUE(sv)";
+    }
+}
+
+sub write_back_lexicals {
+    my $avoid = shift || 0;
+    debug "write_back_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->write_back unless $lex->{flags} & $avoid;
+    }
+}
+
+sub write_back_stack {
+    my $obj;
+    return unless @stack;
+    runtime(sprintf("EXTEND(sp, %d);", scalar(@stack)));
+    foreach $obj (@stack) {
+	runtime(sprintf("PUSHs((SV*)%s);", $obj->as_sv));
+    }
+    @stack = ();
+}
+
+sub invalidate_lexicals {
+    my $avoid = shift || 0;
+    debug "invalidate_lexicals($avoid) called from @{[(caller(1))[3]]}\n"
+	if $debug_shadow;
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	$lex->invalidate unless $lex->{flags} & $avoid;
+    }
+}
+
+sub reload_lexicals {
+    my $lex;
+    foreach $lex (@pad) {
+	next unless ref($lex);
+	my $type = $lex->{type};
+	if ($type == T_INT) {
+	    $lex->as_int;
+	} elsif ($type == T_DOUBLE) {
+	    $lex->as_double;
+	} else {
+	    $lex->as_sv;
+	}
+    }
+}
+
+{
+    package B::Pseudoreg;
+    #
+    # This class allocates pseudo-registers (OK, so they're C variables).
+    #
+    my %alloc;		# Keyed by variable name. A value of 1 means the
+			# variable has been declared. A value of 2 means
+			# it's in use.
+    
+    sub new_scope { %alloc = () }
+    
+    sub new ($$$) {
+	my ($class, $type, $prefix) = @_;
+	my ($ptr, $i, $varname, $status, $obj);
+	$prefix =~ s/^(\**)//;
+	$ptr = $1;
+	$i = 0;
+	do {
+	    $varname = "$prefix$i";
+	    $status = $alloc{$varname};
+	} while $status == 2;
+	if ($status != 1) {
+	    # Not declared yet
+	    B::CC::declare($type, "$ptr$varname");
+	    $alloc{$varname} = 2;	# declared and in use
+	}
+	$obj = bless \$varname, $class;
+	return $obj;
+    }
+    sub DESTROY {
+	my $obj = shift;
+	$alloc{$$obj} = 1; # no longer in use but still declared
+    }
+}
+{
+    package B::Shadow;
+    #
+    # This class gives a standard API for a perl object to shadow a
+    # C variable and only generate reloads/write-backs when necessary.
+    #
+    # Use $obj->load($foo) instead of runtime("shadowed_c_var = foo").
+    # Use $obj->write_back whenever shadowed_c_var needs to be up to date.
+    # Use $obj->invalidate whenever an unknown function may have
+    # set shadow itself.
+
+    sub new {
+	my ($class, $write_back) = @_;
+	# Object fields are perl shadow variable, validity flag
+	# (for *C* variable) and callback sub for write_back
+	# (passed perl shadow variable as argument).
+	bless [undef, 1, $write_back], $class;
+    }
+    sub load {
+	my ($obj, $newval) = @_;
+	$obj->[1] = 0;		# C variable no longer valid
+	$obj->[0] = $newval;
+    }
+    sub write_back {
+	my $obj = shift;
+	if (!($obj->[1])) {
+	    $obj->[1] = 1;	# C variable will now be valid
+	    &{$obj->[2]}($obj->[0]);
+	}
+    }
+    sub invalidate { $_[0]->[1] = 0 } # force C variable to be invalid
+}
+my $curcop = new B::Shadow (sub {
+    my $opsym = shift->save;
+    runtime("curcop = (COP*)$opsym;");
+});
+
+#
+# Context stack shadowing. Mimics stuff in pp_ctl.c, cop.h and so on.
+#
+sub dopoptoloop {
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP) {
+	$cxix--;
+    }
+    debug "dopoptoloop: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub dopoptolabel {
+    my $label = shift;
+    my $cxix = $#cxstack;
+    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP
+	   && $cxstack[$cxix]->{label} ne $label) {
+	$cxix--;
+    }
+    debug "dopoptolabel: returning $cxix" if $debug_cxstack;
+    return $cxix;
+}
+
+sub error {
+    my $format = shift;
+    my $file = $curcop->[0]->filegv->SV->PV;
+    my $line = $curcop->[0]->line;
+    $errors++;
+    if (@_) {
+	warn sprintf("%s:%d: $format\n", $file, $line, @_);
+    } else {
+	warn sprintf("%s:%d: %s\n", $file, $line, $format);
+    }
+}
+
+#
+# Load pad takes (the elements of) a PADLIST as arguments and loads
+# up @pad with Stackobj-derived objects which represent those lexicals.
+# If/when perl itself can generate type information (my int $foo) then
+# we'll take advantage of that here. Until then, we'll use various hacks
+# to tell the compiler when we want a lexical to be a particular type
+# or to be a register.
+#
+sub load_pad {
+    my ($namelistav, $valuelistav) = @_;
+    @padlist = @_;
+    my @namelist = $namelistav->ARRAY;
+    my @valuelist = $valuelistav->ARRAY;
+    my $ix;
+    @pad = ();
+    debug "load_pad: $#namelist names, $#valuelist values\n" if $debug_pad;
+    # Temporary lexicals don't get named so it's possible for @valuelist
+    # to be strictly longer than @namelist. We count $ix up to the end of
+    # @valuelist but index into @namelist for the name. Any temporaries which
+    # run off the end of @namelist will make $namesv undefined and we treat
+    # that the same as having an explicit SPECIAL sv_undef object in @namelist.
+    # [XXX If/when @_ becomes a lexical, we must start at 0 here.]
+    for ($ix = 1; $ix < @valuelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	my $type = T_UNKNOWN;
+	my $flags = 0;
+	my $name = "tmp$ix";
+	my $class = class($namesv);
+	if (!defined($namesv) || $class eq "SPECIAL") {
+	    # temporaries have &sv_undef instead of a PVNV for a name
+	    $flags = VALID_SV|TEMPORARY|REGISTER;
+	} else {
+	    if ($namesv->PV =~ /^\$(.*)_([di])(r?)$/) {
+		$name = $1;
+		if ($2 eq "i") {
+		    $type = T_INT;
+		    $flags = VALID_SV|VALID_INT;
+		} elsif ($2 eq "d") {
+		    $type = T_DOUBLE;
+		    $flags = VALID_SV|VALID_DOUBLE;
+		}
+		$flags |= REGISTER if $3;
+	    }
+	}
+	$pad[$ix] = new B::Stackobj::Padsv ($type, $flags, $ix,
+					    "i_$name", "d_$name");
+	declare("IV", $type == T_INT ? "i_$name = 0" : "i_$name");
+	declare("double", $type == T_DOUBLE ? "d_$name = 0" : "d_$name");
+	debug sprintf("curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
+    }
+}
+
+#
+# Debugging stuff
+#
+sub peek_stack { sprintf "stack = %s\n", join(" ", map($_->minipeek, @stack)) }
+
+#
+# OP stuff
+#
+
+sub label {
+    my $op = shift;
+    # XXX Preserve original label name for "real" labels?
+    return sprintf("lab_%x", $$op);
+}
+
+sub write_label {
+    my $op = shift;
+    push_runtime(sprintf("  %s:", label($op)));
+}
+
+sub loadop {
+    my $op = shift;
+    my $opsym = $op->save;
+    runtime("op = $opsym;") unless $know_op;
+    return $opsym;
+}
+
+sub doop {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    my $sym = loadop($op);
+    runtime("DOOP($ppname);");
+    $know_op = 1;
+    return $sym;
+}
+
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
+}
+
+#
+# Code generation for PP code
+#
+
+sub pp_null {
+    my $op = shift;
+    return $op->next;
+}
+
+sub pp_stub {
+    my $op = shift;
+    my $gimme = gimme($op);
+    if ($gimme != 1) {
+	# XXX Change to push a constant sv_undef Stackobj onto @stack
+	write_back_stack();
+	runtime("if ($gimme != G_ARRAY) XPUSHs(&sv_undef);");
+    }
+    return $op->next;
+}
+
+sub pp_unstack {
+    my $op = shift;
+    @stack = ();
+    runtime("PP_UNSTACK;");
+    return $op->next;
+}
+
+sub pp_and {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $bool = pop_bool();
+	write_back_stack();
+	runtime(sprintf("if (!$bool) goto %s;", label($next)));
+    } else {
+	runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_or {
+    my $op = shift;
+    my $next = $op->next;
+    reload_lexicals();
+    unshift(@bblock_todo, $next);
+    if (@stack >= 1) {
+	my $obj = pop @stack;
+	write_back_stack();
+	runtime(sprintf("if (%s) { XPUSHs(%s); goto %s; }",
+			$obj->as_numeric, $obj->as_sv, label($next)));
+    } else {
+	runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
+		"*sp--;");
+    }
+    return $op->other;
+}
+	    
+sub pp_cond_expr {
+    my $op = shift;
+    my $false = $op->false;
+    unshift(@bblock_todo, $false);
+    reload_lexicals();
+    my $bool = pop_bool();
+    write_back_stack();
+    runtime(sprintf("if (!$bool) goto %s;", label($false)));
+    return $op->true;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    my $ix = $op->targ;
+    push(@stack, $pad[$ix]);
+    if ($op->flags & OPf_MOD) {
+	my $private = $op->private;
+	if ($private & OPpLVAL_INTRO) {
+	    runtime("SAVECLEARSV(curpad[$ix]);");
+	} elsif ($private & OPpDEREF) {
+	    runtime(sprintf("vivify_ref(curpad[%d], %d);",
+			    $ix, $private & OPpDEREF));
+	    $pad[$ix]->invalidate;
+	}
+    }
+    return $op->next;
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    my $obj = $constobj{$$sv};
+    if (!defined($obj)) {
+	$obj = $constobj{$$sv} = new B::Stackobj::Const ($sv);
+    }
+    push(@stack, $obj);
+    return $op->next;
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $curcop->load($op);
+    @stack = ();
+    debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno;
+    runtime("TAINT_NOT;") unless $omit_taint;
+    runtime("sp = stack_base + cxstack[cxstack_ix].blk_oldsp;");
+    if ($freetmps_each_bblock || $freetmps_each_loop) {
+	$need_freetmps = 1;
+    } else {
+	runtime("FREETMPS;");
+    }
+    return $op->next;
+}
+
+sub pp_dbstate {
+    my $op = shift;
+    $curcop->invalidate; # XXX?
+    return default_pp($op);
+}
+
+sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+sub pp_bless { $curcop->write_back; default_pp(@_) }
+sub pp_repeat { $curcop->write_back; default_pp(@_) }
+# The following subs need $curcop->write_back if we decide to support arybase:
+# pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
+sub pp_sort { $curcop->write_back; default_pp(@_) }
+sub pp_caller { $curcop->write_back; default_pp(@_) }
+sub pp_reset { $curcop->write_back; default_pp(@_) }
+
+sub pp_gv {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    write_back_stack();
+    runtime("XPUSHs((SV*)$gvsym);");
+    return $op->next;
+}
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    write_back_stack();
+    if ($op->private & OPpLVAL_INTRO) {
+	runtime("XPUSHs(save_scalar($gvsym));");
+    } else {
+	runtime("XPUSHs(GvSV($gvsym));");
+    }
+    return $op->next;
+}
+
+sub pp_aelemfast {
+    my $op = shift;
+    my $gvsym = $op->gv->save;
+    my $ix = $op->private;
+    my $flag = $op->flags & OPf_MOD;
+    write_back_stack();
+    runtime("svp = av_fetch(GvAV($gvsym), $ix, $flag);",
+	    "PUSHs(svp ? *svp : &sv_undef);");
+    return $op->next;
+}
+
+sub int_binop {
+    my ($op, $operator) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_int();
+	if (@stack >= 1) {
+	    my $left = top_int();
+	    $stack[-1]->set_int(&$operator($left, $right));
+	} else {
+	    runtime(sprintf("sv_setiv(TOPs, %s);",&$operator("TOPi", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	my $right = new B::Pseudoreg ("IV", "riv");
+	my $left = new B::Pseudoreg ("IV", "liv");
+	runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int));
+	$targ->set_int(&$operator($$left, $$right));
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub INTS_CLOSED () { 0x1 }
+sub INT_RESULT () { 0x2 }
+sub NUMERIC_RESULT () { 0x4 }
+
+sub numeric_binop {
+    my ($op, $operator, $flags) = @_;
+    my $force_int = 0;
+    $force_int ||= ($flags & INT_RESULT);
+    $force_int ||= ($flags & INTS_CLOSED && @stack >= 2
+		    && valid_int($stack[-2]) && valid_int($stack[-1]));
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_numeric();
+	if (@stack >= 1) {
+	    my $left = top_numeric();
+	    if ($force_int) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } else {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    }
+	} else {
+	    if ($force_int) {
+		runtime(sprintf("sv_setiv(TOPs, %s);",
+				&$operator("TOPi", $right)));
+	    } else {
+		runtime(sprintf("sv_setnv(TOPs, %s);",
+				&$operator("TOPn", $right)));
+	    }
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	$force_int ||= ($targ->{type} == T_INT);
+	if ($force_int) {
+	    my $right = new B::Pseudoreg ("IV", "riv");
+	    my $left = new B::Pseudoreg ("IV", "liv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_int(&$operator($$left, $$right));
+	} else {
+	    my $right = new B::Pseudoreg ("double", "rnv");
+	    my $left = new B::Pseudoreg ("double", "lnv");
+	    runtime(sprintf("$$right = %s; $$left = %s;",
+			    pop_numeric(), pop_numeric));
+	    $targ->set_numeric(&$operator($$left, $$right));
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+
+sub sv_binop {
+    my ($op, $operator, $flags) = @_;
+    if ($op->flags & OPf_STACKED) {
+	my $right = pop_sv();
+	if (@stack >= 1) {
+	    my $left = top_sv();
+	    if ($flags & INT_RESULT) {
+		$stack[-1]->set_int(&$operator($left, $right));
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$stack[-1]->set_numeric(&$operator($left, $right));
+	    } else {
+		# XXX Does this work?
+		runtime(sprintf("sv_setsv($left, %s);",
+				&$operator($left, $right)));
+		$stack[-1]->invalidate;
+	    }
+	} else {
+	    my $f;
+	    if ($flags & INT_RESULT) {
+		$f = "sv_setiv";
+	    } elsif ($flags & NUMERIC_RESULT) {
+		$f = "sv_setnv";
+	    } else {
+		$f = "sv_setsv";
+	    }
+	    runtime(sprintf("%s(TOPs, %s);", $f, &$operator("TOPs", $right)));
+	}
+    } else {
+	my $targ = $pad[$op->targ];
+	runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv));
+	if ($flags & INT_RESULT) {
+	    $targ->set_int(&$operator("left", "right"));
+	} elsif ($flags & NUMERIC_RESULT) {
+	    $targ->set_numeric(&$operator("left", "right"));
+	} else {
+	    # XXX Does this work?
+	    runtime(sprintf("sv_setsv(%s, %s);",
+			    $targ->as_sv, &$operator("left", "right")));
+	    $targ->invalidate;
+	}
+	push(@stack, $targ);
+    }
+    return $op->next;
+}
+    
+sub bool_int_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("IV", "riv");
+    my $left = new B::Pseudoreg ("IV", "liv");
+    runtime(sprintf("$$right = %s; $$left = %s;", pop_int(), pop_int()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_int(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_numeric_binop {
+    my ($op, $operator) = @_;
+    my $right = new B::Pseudoreg ("double", "rnv");
+    my $left = new B::Pseudoreg ("double", "lnv");
+    runtime(sprintf("$$right = %s; $$left = %s;",
+		    pop_numeric(), pop_numeric()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator($$left, $$right));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub bool_sv_binop {
+    my ($op, $operator) = @_;
+    runtime(sprintf("right = %s; left = %s;", pop_sv(), pop_sv()));
+    my $bool = new B::Stackobj::Bool (new B::Pseudoreg ("int", "b"));
+    $bool->set_numeric(&$operator("left", "right"));
+    push(@stack, $bool);
+    return $op->next;
+}
+
+sub infix_op {
+    my $opname = shift;
+    return sub { "$_[0] $opname $_[1]" }
+}
+
+sub prefix_op {
+    my $opname = shift;
+    return sub { sprintf("%s(%s)", $opname, join(", ", @_)) }
+}
+
+BEGIN {
+    my $plus_op = infix_op("+");
+    my $minus_op = infix_op("-");
+    my $multiply_op = infix_op("*");
+    my $divide_op = infix_op("/");
+    my $modulo_op = infix_op("%");
+    my $lshift_op = infix_op("<<");
+    my $rshift_op = infix_op("<<");
+    my $ncmp_op = sub { "($_[0] > $_[1] ? 1 : ($_[0] < $_[1]) ? -1 : 0)" };
+    my $scmp_op = prefix_op("sv_cmp");
+    my $seq_op = prefix_op("sv_eq");
+    my $sne_op = prefix_op("!sv_eq");
+    my $slt_op = sub { "sv_cmp($_[0], $_[1]) < 0" };
+    my $sgt_op = sub { "sv_cmp($_[0], $_[1]) > 0" };
+    my $sle_op = sub { "sv_cmp($_[0], $_[1]) <= 0" };
+    my $sge_op = sub { "sv_cmp($_[0], $_[1]) >= 0" };
+    my $eq_op = infix_op("==");
+    my $ne_op = infix_op("!=");
+    my $lt_op = infix_op("<");
+    my $gt_op = infix_op(">");
+    my $le_op = infix_op("<=");
+    my $ge_op = infix_op(">=");
+
+    #
+    # XXX The standard perl PP code has extra handling for
+    # some special case arguments of these operators.
+    #
+    sub pp_add { numeric_binop($_[0], $plus_op, INTS_CLOSED) }
+    sub pp_subtract { numeric_binop($_[0], $minus_op, INTS_CLOSED) }
+    sub pp_multiply { numeric_binop($_[0], $multiply_op, INTS_CLOSED) }
+    sub pp_divide { numeric_binop($_[0], $divide_op) }
+    sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
+    sub pp_ncmp { numeric_binop($_[0], $ncmp_op, INT_RESULT) }
+
+    sub pp_left_shift { int_binop($_[0], $lshift_op) }
+    sub pp_right_shift { int_binop($_[0], $rshift_op) }
+    sub pp_i_add { int_binop($_[0], $plus_op) }
+    sub pp_i_subtract { int_binop($_[0], $minus_op) }
+    sub pp_i_multiply { int_binop($_[0], $multiply_op) }
+    sub pp_i_divide { int_binop($_[0], $divide_op) }
+    sub pp_i_modulo { int_binop($_[0], $modulo_op) }
+
+    sub pp_eq { bool_numeric_binop($_[0], $eq_op) }
+    sub pp_ne { bool_numeric_binop($_[0], $ne_op) }
+    sub pp_lt { bool_numeric_binop($_[0], $lt_op) }
+    sub pp_gt { bool_numeric_binop($_[0], $gt_op) }
+    sub pp_le { bool_numeric_binop($_[0], $le_op) }
+    sub pp_ge { bool_numeric_binop($_[0], $ge_op) }
+
+    sub pp_i_eq { bool_int_binop($_[0], $eq_op) }
+    sub pp_i_ne { bool_int_binop($_[0], $ne_op) }
+    sub pp_i_lt { bool_int_binop($_[0], $lt_op) }
+    sub pp_i_gt { bool_int_binop($_[0], $gt_op) }
+    sub pp_i_le { bool_int_binop($_[0], $le_op) }
+    sub pp_i_ge { bool_int_binop($_[0], $ge_op) }
+
+    sub pp_scmp { sv_binop($_[0], $scmp_op, INT_RESULT) }
+    sub pp_slt { bool_sv_binop($_[0], $slt_op) }
+    sub pp_sgt { bool_sv_binop($_[0], $sgt_op) }
+    sub pp_sle { bool_sv_binop($_[0], $sle_op) }
+    sub pp_sge { bool_sv_binop($_[0], $sge_op) }
+    sub pp_seq { bool_sv_binop($_[0], $seq_op) }
+    sub pp_sne { bool_sv_binop($_[0], $sne_op) }
+}
+
+
+sub pp_sassign {
+    my $op = shift;
+    my $backwards = $op->private & OPpASSIGN_BACKWARDS;
+    my ($dst, $src);
+    if (@stack >= 2) {
+	$dst = pop @stack;
+	$src = pop @stack;
+	($src, $dst) = ($dst, $src) if $backwards;
+	my $type = $src->{type};
+	if ($type == T_INT) {
+	    $dst->set_int($src->as_int);
+	} elsif ($type == T_DOUBLE) {
+	    $dst->set_numeric($src->as_numeric);
+	} else {
+	    $dst->set_sv($src->as_sv);
+	}
+	push(@stack, $dst);
+    } elsif (@stack == 1) {
+	if ($backwards) {
+	    my $src = pop @stack;
+	    my $type = $src->{type};
+	    runtime("if (tainting && tainted) TAINT_NOT;");
+	    if ($type == T_INT) {
+		runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
+	    } elsif ($type == T_DOUBLE) {
+		runtime sprintf("sv_setnv(TOPs, %s);", $src->as_double);
+	    } else {
+		runtime sprintf("sv_setsv(TOPs, %s);", $src->as_sv);
+	    }
+	    runtime("SvSETMAGIC(TOPs);");
+	} else {
+	    my $dst = pop @stack;
+	    my $type = $dst->{type};
+	    runtime("sv = POPs;");
+	    runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
+	    if ($type == T_INT) {
+		$dst->set_int("SvIV(sv)");
+	    } elsif ($type == T_DOUBLE) {
+		$dst->set_double("SvNV(sv)");
+	    } else {
+		runtime("SvSetSV($dst->{sv}, sv);");
+		$dst->invalidate;
+	    }
+	}
+    } else {
+	if ($backwards) {
+	    runtime("src = POPs; dst = TOPs;");
+	} else {
+	    runtime("dst = POPs; src = TOPs;");
+	}
+	runtime("MAYBE_TAINT_SASSIGN_SRC(src);",
+		"SvSetSV(dst, src);",
+		"SvSETMAGIC(dst);",
+		"SETs(dst);");
+    }
+    return $op->next;
+}
+
+sub pp_preinc {
+    my $op = shift;
+    if (@stack >= 1) {
+	my $obj = $stack[-1];
+	my $type = $obj->{type};
+	if ($type == T_INT || $type == T_DOUBLE) {
+	    $obj->set_int($obj->as_int . " + 1");
+	} else {
+	    runtime sprintf("PP_PREINC(%s);", $obj->as_sv);
+	    $obj->invalidate();
+	}
+    } else {
+	runtime sprintf("PP_PREINC(TOPs);");
+    }
+    return $op->next;
+}
+
+sub pp_pushmark {
+    my $op = shift;
+    write_back_stack();
+    runtime("PUSHMARK(sp);");
+    return $op->next;
+}
+
+sub pp_list {
+    my $op = shift;
+    write_back_stack();
+    my $gimme = gimme($op);
+    if ($gimme == 1) { # sic
+	runtime("POPMARK;"); # need this even though not a "full" pp_list
+    } else {
+	runtime("PP_LIST($gimme);");
+    }
+    return $op->next;
+}
+
+sub pp_entersub {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    runtime("if (op != ($sym)->op_next) op = (*op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_enterwrite {
+    my $op = shift;
+    pp_entersub($op);
+}
+
+sub pp_leavewrite {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    # XXX Is this the right way to distinguish between it returning
+    # CvSTART(cv) (via doform) and pop_return()?
+    runtime("if (op) op = (*op->op_ppaddr)(ARGS);");
+    runtime("SPAGAIN;");
+    $know_op = 0;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub doeval {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = loadop($op);
+    my $ppaddr = $op->ppaddr;
+    runtime("PP_EVAL($ppaddr, ($sym)->op_next);");
+    $know_op = 1;
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_entereval { doeval(@_) }
+sub pp_require { doeval(@_) }
+sub pp_dofile { doeval(@_) }
+
+sub pp_entertry {
+    my $op = shift;
+    $curcop->write_back;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    my $sym = doop($op);
+    my $jmpbuf = sprintf("jmpbuf%d", $jmpbuf_ix++);
+    declare("Sigjmp_buf", $jmpbuf);
+    runtime(sprintf("PP_ENTERTRY(%s,%s);", $jmpbuf, label($op->other->next)));
+    invalidate_lexicals(REGISTER|TEMPORARY);
+    return $op->next;
+}
+
+sub pp_grepstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the grepwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    doop($op);
+    return $op->next->other;
+}
+
+sub pp_mapstart {
+    my $op = shift;
+    if ($need_freetmps && $freetmps_each_loop) {
+	runtime("FREETMPS;"); # otherwise the mapwhile loop messes things up
+	$need_freetmps = 0;
+    }
+    write_back_stack();
+    doop($op);
+    return $op->next->other;
+}
+
+sub pp_grepwhile {
+    my $op = shift;
+    my $next = $op->next;
+    unshift(@bblock_todo, $next);
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    # pp_grepwhile can return either op_next or op_other and we need to
+    # be able to distinguish the two at runtime. Since it's possible for
+    # both ops to be "inlined", the fields could both be zero. To get
+    # around that, we hack op_next to be our own op (purely because we
+    # know it's a non-NULL pointer and can't be the same as op_other).
+    $init->add("((LOGOP*)$sym)->op_next = $sym;");
+    runtime(sprintf("if (op == ($sym)->op_next) goto %s;", label($next)));
+    $know_op = 0;
+    return $op->other;
+}
+
+sub pp_mapwhile {
+    pp_grepwhile(@_);
+}
+
+sub pp_return {
+    my $op = shift;
+    write_back_lexicals(REGISTER|TEMPORARY);
+    write_back_stack();
+    doop($op);
+    runtime("PUTBACK;", "return 0;");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub nyi {
+    my $op = shift;
+    warn sprintf("%s not yet implemented properly\n", $op->ppaddr);
+    return default_pp($op);
+}
+
+sub pp_range {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_KNOW)) {
+	error("context of range unknown at compile-time");
+    }
+    write_back_lexicals();
+    write_back_stack();
+    if (!($flags & OPf_LIST)) {
+	# We need to save our UNOP structure since pp_flop uses
+	# it to find and adjust out targ. We don't need it ourselves.
+	$op->save;
+	runtime sprintf("if (SvTRUE(curpad[%d])) goto %s;",
+			$op->targ, label($op->false));
+	unshift(@bblock_todo, $op->false);
+    }
+    return $op->true;
+}
+
+sub pp_flip {
+    my $op = shift;
+    my $flags = $op->flags;
+    if (!($flags & OPf_KNOW)) {
+	error("context of flip unknown at compile-time");
+    }
+    if ($flags & OPf_LIST) {
+	return $op->first->false;
+    }
+    write_back_lexicals();
+    write_back_stack();
+    # We need to save our UNOP structure since pp_flop uses
+    # it to find and adjust out targ. We don't need it ourselves.
+    $op->save;
+    my $ix = $op->targ;
+    my $rangeix = $op->first->targ;
+    runtime(($op->private & OPpFLIP_LINENUM) ?
+	    "if (last_in_gv && SvIV(TOPs) == IoLINES(GvIOp(last_in_gv))) {"
+	  : "if (SvTRUE(TOPs)) {");
+    runtime("\tsv_setiv(curpad[$rangeix], 1);");
+    if ($op->flags & OPf_SPECIAL) {
+	runtime("sv_setiv(curpad[$ix], 1);");
+    } else {
+	runtime("\tsv_setiv(curpad[$ix], 0);",
+		"\tsp--;",
+		sprintf("\tgoto %s;", label($op->first->false)));
+    }
+    runtime("}",
+	  qq{sv_setpv(curpad[$ix], "");},
+	    "SETs(curpad[$ix]);");
+    $know_op = 0;
+    return $op->next;
+}
+
+sub pp_flop {
+    my $op = shift;
+    default_pp($op);
+    $know_op = 0;
+    return $op->next;
+}
+
+sub enterloop {
+    my $op = shift;
+    my $nextop = $op->nextop;
+    my $lastop = $op->lastop;
+    my $redoop = $op->redoop;
+    $curcop->write_back;
+    debug "enterloop: pushing on cxstack" if $debug_cxstack;
+    push(@cxstack, {
+	type => CXt_LOOP,
+	op => $op,
+	"label" => $curcop->[0]->label,
+	nextop => $nextop,
+	lastop => $lastop,
+	redoop => $redoop
+    });
+    $nextop->save;
+    $lastop->save;
+    $redoop->save;
+    return default_pp($op);
+}
+
+sub pp_enterloop { enterloop(@_) }
+sub pp_enteriter { enterloop(@_) }
+
+sub pp_leaveloop {
+    my $op = shift;
+    if (!@cxstack) {
+	die "panic: leaveloop";
+    }
+    debug "leaveloop: popping from cxstack" if $debug_cxstack;
+    pop(@cxstack);
+    return default_pp($op);
+}
+
+sub pp_next {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"next" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "next %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $nextop = $cxstack[$cxix]->{nextop};
+    push(@bblock_todo, $nextop);
+    runtime(sprintf("goto %s;", label($nextop)));
+    return $op->next;
+}
+
+sub pp_redo {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"redo" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "redo %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $redoop = $cxstack[$cxix]->{redoop};
+    push(@bblock_todo, $redoop);
+    runtime(sprintf("goto %s;", label($redoop)));
+    return $op->next;
+}
+
+sub pp_last {
+    my $op = shift;
+    my $cxix;
+    if ($op->flags & OPf_SPECIAL) {
+	$cxix = dopoptoloop();
+	if ($cxix < 0) {
+	    error('"last" used outside loop');
+	    return $op->next; # ignore the op
+	}
+    } else {
+	$cxix = dopoptolabel($op->pv);
+	if ($cxix < 0) {
+	    error('Label not found at compile time for "last %s"', $op->pv);
+	    return $op->next; # ignore the op
+	}
+	# XXX Add support for "last" to leave non-loop blocks
+	if ($cxstack[$cxix]->{type} != CXt_LOOP) {
+	    error('Use of "last" for non-loop blocks is not yet implemented');
+	    return $op->next; # ignore the op
+	}
+    }
+    default_pp($op);
+    my $lastop = $cxstack[$cxix]->{lastop}->next;
+    push(@bblock_todo, $lastop);
+    runtime(sprintf("goto %s;", label($lastop)));
+    return $op->next;
+}
+
+sub pp_subst {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    my $sym = doop($op);
+    my $replroot = $op->pmreplroot;
+    if ($$replroot) {
+	runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplroot) goto %s;",
+			$sym, label($replroot));
+	$op->pmreplstart->save;
+	push(@bblock_todo, $replroot);
+    }
+    invalidate_lexicals();
+    return $op->next;
+}
+
+sub pp_substcont {
+    my $op = shift;
+    write_back_lexicals();
+    write_back_stack();
+    doop($op);
+    my $pmop = $op->other;
+    warn sprintf("substcont: op = %s, pmop = %s\n",
+		 peekop($op), peekop($pmop));#debug
+#    my $pmopsym = objsym($pmop);
+    my $pmopsym = $pmop->save; # XXX can this recurse?
+    warn "pmopsym = $pmopsym\n";#debug
+    runtime sprintf("if (op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
+		    $pmopsym, label($pmop->pmreplstart));
+    invalidate_lexicals();
+    return $pmop->next;
+}
+
+sub default_pp {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    doop($op);
+    # XXX If the only way that ops can write to a TEMPORARY lexical is
+    # when it's named in $op->targ then we could call
+    # invalidate_lexicals(TEMPORARY) and avoid having to write back all
+    # the temporaries. For now, we'll play it safe and write back the lot.
+    invalidate_lexicals() unless $skip_invalidate{$ppname};
+    return $op->next;
+}
+
+sub compile_op {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    if (exists $ignore_op{$ppname}) {
+	return $op->next;
+    }
+    debug peek_stack() if $debug_stack;
+    if ($debug_op) {
+	debug sprintf("%s [%s]\n",
+		     peekop($op),
+		     $op->flags & OPf_STACKED ? "OPf_STACKED" : $op->targ);
+    }
+    no strict 'refs';
+    if (defined(&$ppname)) {
+	$know_op = 0;
+	return &$ppname($op);
+    } else {
+	return default_pp($op);
+    }
+}
+
+sub compile_bblock {
+    my $op = shift;
+    #warn "compile_bblock: ", peekop($op), "\n"; # debug
+    write_label($op);
+    $know_op = 0;
+    do {
+	$op = compile_op($op);
+    } while (defined($op) && $$op && !exists($leaders->{$$op}));
+    write_back_stack(); # boo hoo: big loss
+    reload_lexicals();
+    return $op;
+}
+
+sub cc {
+    my ($name, $root, $start, @padlist) = @_;
+    my $op;
+    init_pp($name);
+    load_pad(@padlist);
+    B::Pseudoreg->new_scope;
+    @cxstack = ();
+    if ($debug_timings) {
+	warn sprintf("Basic block analysis at %s\n", timing_info);
+    }
+    $leaders = find_leaders($root, $start);
+    @bblock_todo = ($start, values %$leaders);
+    if ($debug_timings) {
+	warn sprintf("Compilation at %s\n", timing_info);
+    }
+    while (@bblock_todo) {
+	$op = shift @bblock_todo;
+	#warn sprintf("Considering basic block %s\n", peekop($op)); # debug
+	next if !defined($op) || !$$op || $done{$$op};
+	#warn "...compiling it\n"; # debug
+	do {
+	    $done{$$op} = 1;
+	    $op = compile_bblock($op);
+	    if ($need_freetmps && $freetmps_each_bblock) {
+		runtime("FREETMPS;");
+		$need_freetmps = 0;
+	    }
+	} while defined($op) && $$op && !$done{$$op};
+	if ($need_freetmps && $freetmps_each_loop) {
+	    runtime("FREETMPS;");
+	    $need_freetmps = 0;
+	}
+	if (!$$op) {
+	    runtime("PUTBACK;", "return 0;");
+	} elsif ($done{$$op}) {
+	    runtime(sprintf("goto %s;", label($op)));
+	}
+    }
+    if ($debug_timings) {
+	warn sprintf("Saving runtime at %s\n", timing_info);
+    }
+    save_runtime();
+}
+
+sub cc_recurse {
+    my $ccinfo;
+    my $start;
+    $start = cc_queue(@_) if @_;
+    while ($ccinfo = shift @cc_todo) {
+	cc(@$ccinfo);
+    }
+    return $start;
+}    
+
+sub cc_obj {
+    my ($name, $cvref) = @_;
+    my $cv = svref_2object($cvref);
+    my @padlist = $cv->PADLIST->ARRAY;
+    my $curpad_sym = $padlist[1]->save;
+    cc_recurse($name, $cv->ROOT, $cv->START, @padlist);
+}
+
+sub cc_main {
+    my @comppadlist = comppadlist->ARRAY;
+    my $curpad_sym = $comppadlist[1]->save;
+    my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
+    save_unused_subs(@unused_sub_packages);
+    cc_recurse();
+
+    return if $errors;
+    if (!defined($module)) {
+	$init->add(sprintf("main_root = s\\_%x;", ${main_root()}),
+		   "main_start = $start;",
+		   "curpad = AvARRAY($curpad_sym);");
+    }
+    output_boilerplate();
+    print "\n";
+    output_all("perl_init");
+    output_runtime();
+    print "\n";
+    output_main();
+    if (defined($module)) {
+	my $cmodule = $module;
+	$cmodule =~ s/::/__/g;
+	print <<"EOT";
+
+#include "XSUB.h"
+XS(boot_$cmodule)
+{
+    dXSARGS;
+    perl_init();
+    ENTER;
+    SAVETMPS;
+    SAVESPTR(curpad);
+    SAVESPTR(op);
+    curpad = AvARRAY($curpad_sym);
+    op = $start;
+    pp_main(ARGS);
+    FREETMPS;
+    LEAVE;
+    ST(0) = &sv_yes;
+    XSRETURN(1);
+}
+EOT
+    }
+    if ($debug_timings) {
+	warn sprintf("Done at %s\n", timing_info);
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "n") {
+	    $arg ||= shift @options;
+	    $module_name = $arg;
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "f") {
+	    $arg ||= shift @options;
+	    my $value = $arg !~ s/^no-//;
+	    $arg =~ s/-/_/g;
+	    my $ref = $optimise{$arg};
+	    if (defined($ref)) {
+		$$ref = $value;
+	    } else {
+		warn qq(ignoring unknown optimisation option "$arg"\n);
+	    }
+	} elsif ($opt eq "O") {
+	    $arg = 1 if $arg eq "";
+	    my $ref;
+	    foreach $ref (values %optimise) {
+		$$ref = 0;
+	    }
+	    if ($arg >= 2) {
+		$freetmps_each_loop = 1;
+	    }
+	    if ($arg >= 1) {
+		$freetmps_each_bblock = 1 unless $freetmps_each_loop;
+	    }
+	} elsif ($opt eq "m") {
+	    $arg ||= shift @options;
+	    $module = $arg;
+	    push(@unused_sub_packages, $arg);
+	} elsif ($opt eq "p") {
+	    $arg ||= shift @options;
+	    $patchlevel = $arg;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "s") {
+		    $debug_stack = 1;
+		} elsif ($arg eq "c") {
+		    $debug_cxstack = 1;
+		} elsif ($arg eq "p") {
+		    $debug_pad = 1;
+		} elsif ($arg eq "r") {
+		    $debug_runtime = 1;
+		} elsif ($arg eq "S") {
+		    $debug_shadow = 1;
+		} elsif ($arg eq "q") {
+		    $debug_queue = 1;
+		} elsif ($arg eq "l") {
+		    $debug_lineno = 1;
+		} elsif ($arg eq "t") {
+		    $debug_timings = 1;
+		}
+	    }
+	}
+    }
+    init_sections();
+    $init = B::Section->get("init");
+    $decl = B::Section->get("decl");
+
+    if (@options) {
+	return sub {
+	    my ($objname, $ppname);
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		($ppname = $objname) =~ s/^.*?:://;
+		eval "cc_obj(qq(pp_sub_$ppname), \\&$objname)";
+		die "cc_obj(qq(pp_sub_$ppname, \\&$objname) failed: $@" if $@;
+		return if $errors;
+	    }
+	    output_boilerplate();
+	    print "\n";
+	    output_all($module_name || "init_module");
+	    output_runtime();
+	}
+    } else {
+	return sub { cc_main() };
+    }
+}
+
+1;
diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm
new file mode 100644
index 0000000000..d88cef3780
--- /dev/null
+++ b/ext/B/B/Debug.pm
@@ -0,0 +1,263 @@
+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;
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
new file mode 100644
index 0000000000..9802cb4350
--- /dev/null
+++ b/ext/B/B/Deparse.pm
@@ -0,0 +1,102 @@
+package B::Deparse;
+use strict;
+use B qw(peekop class main_root);
+
+my $debug;
+
+sub compile {
+    my $opt = shift;
+    if ($opt eq "-d") {
+	$debug = 1;
+    }
+    return sub { print deparse(main_root), "\n" }
+}
+
+sub ppname {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    warn sprintf("ppname %s\n", peekop($op)) if $debug;
+    no strict "refs";
+    return defined(&$ppname) ? &$ppname($op) : 0;
+}
+
+sub deparse {
+    my $op = shift;
+    my $expr;
+    warn sprintf("deparse %s\n", peekop($op)) if $debug;
+    while (ref($expr = ppname($op))) {
+	$op = $expr;
+	warn sprintf("Redirecting to %s\n", peekop($op)) if $debug;
+    }
+    return $expr;
+}
+
+sub pp_leave {
+    my $op = shift;
+    my ($child, $expr);
+    for ($child = $op->first; !$expr; $child = $child->sibling) {
+	$expr = ppname($child);
+    }
+    return $expr;
+}
+
+sub SWAP_CHILDREN () { 1 }
+
+sub binop {
+    my ($op, $opname, $flags) = @_;
+    my $left = $op->first;
+    my $right = $op->last;
+    if ($flags & SWAP_CHILDREN) {
+	($left, $right) = ($right, $left);
+    }
+    warn sprintf("binop deparsing first %s\n", peekop($op->first)) if $debug;
+    $left = deparse($left);
+    warn sprintf("binop deparsing last %s\n", peekop($op->last)) if $debug;
+    $right = deparse($right);
+    return "($left $opname $right)";
+}
+
+sub pp_add { binop($_[0], "+") }
+sub pp_multiply { binop($_[0], "*") }
+sub pp_subtract { binop($_[0], "-") }
+sub pp_divide { binop($_[0], "/") }
+sub pp_modulo { binop($_[0], "%") }
+sub pp_eq { binop($_[0], "==") }
+sub pp_ne { binop($_[0], "!=") }
+sub pp_lt { binop($_[0], "<") }
+sub pp_gt { binop($_[0], ">") }
+sub pp_ge { binop($_[0], ">=") }
+
+sub pp_sassign { binop($_[0], "=", SWAP_CHILDREN) }
+
+sub pp_null {
+    my $op = shift;
+    warn sprintf("Skipping null op %s\n", peekop($op)) if $debug;
+    return $op->first;
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    if (class($sv) eq "IV") {
+	return $sv->IV;
+    } elsif (class($sv) eq "NV") {
+	return $sv->NV;
+    } else {
+	return $sv->PV;
+    }
+}
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv = $op->gv;
+    my $stash = $gv->STASH->NAME;
+    if ($stash eq "main") {
+	$stash = "";
+    } else {
+	$stash = $stash . "::";
+    }
+    return sprintf('$%s%s', $stash, $gv->NAME);
+}
+
+1;
diff --git a/ext/B/B/Disassembler.pm b/ext/B/B/Disassembler.pm
new file mode 100644
index 0000000000..36db354849
--- /dev/null
+++ b/ext/B/B/Disassembler.pm
@@ -0,0 +1,144 @@
+#      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;
diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm
new file mode 100644
index 0000000000..d34bd7792b
--- /dev/null
+++ b/ext/B/B/Lint.pm
@@ -0,0 +1,367 @@
+package B::Lint;
+
+=head1 NAME
+
+B::Lint - Perl lint
+
+=head1 SYNOPSIS
+
+perl -MO=Lint[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Lint module is equivalent to an extended version of the B<-w>
+option of B<perl>. It is named after the program B<lint> which carries
+out a similar process for C programs.
+
+=head1 OPTIONS AND LINT CHECKS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options. Following any options
+(indicated by a leading B<->) come lint check arguments. Each such
+argument (apart from the special B<all> and B<none> options) is a
+word representing one possible lint check (turning on that check) or
+is B<no-foo> (turning off that check). Before processing the check
+arguments, a standard list of checks is turned on. Later options
+override earlier ones. Available options are:
+
+=over 8
+
+=item B<context>
+
+Produces a warning whenever an array is used in an implicit scalar
+context. For example, both of the lines
+
+    $foo = length(@bar);
+    $foo = @bar;
+will elicit a warning. Using an explicit B<scalar()> silences the
+warning. For example,
+
+    $foo = scalar(@bar);
+
+=item B<implicit-read> and B<implicit-write>
+
+These options produce a warning whenever an operation implicitly
+reads or (respectively) writes to one of Perl's special variables.
+For example, B<implicit-read> will warn about these:
+
+    /foo/;
+
+and B<implicit-write> will warn about these:
+
+    s/foo/bar/;
+
+Both B<implicit-read> and B<implicit-write> warn about this:
+
+    for (@a) { ... }
+
+=item B<dollar-underscore>
+
+This option warns whenever $_ is used either explicitly anywhere or
+as the implicit argument of a B<print> statement.
+
+=item B<private-names>
+
+This option warns on each use of any variable, subroutine or
+method name that lives in a non-current package but begins with
+an underscore ("_"). Warnings aren't issued for the special case
+of the single character name "_" by itself (e.g. $_ and @_).
+
+=item B<undefined-subs>
+
+This option warns whenever an undefined subroutine is invoked.
+This option will only catch explicitly invoked subroutines such
+as C<foo()> and not indirect invocations such as C<&$subref()>
+or C<$obj-E<gt>meth()>. Note that some programs or modules delay
+definition of subs until runtime by means of the AUTOLOAD
+mechanism.
+
+=item B<regexp-variables>
+
+This option warns whenever one of the regexp variables $', $& or
+$' is used. Any occurrence of any of these variables in your
+program can slow your whole program down. See L<perlre> for
+details.
+
+=item B<all>
+
+Turn all warnings on.
+
+=item B<none>
+
+Turn all warnings off.
+
+=back
+
+=head1 NON LINT-CHECK OPTIONS
+
+=over 8
+
+=item B<-u Package>
+
+Normally, Lint only checks the main code of the program together
+with all subs defined in package main. The B<-u> option lets you
+include other package names whose subs are then checked by Lint.
+
+=back
+
+=head1 BUGS
+
+This is only a very preliminary version.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(walkoptree_slow main_root walksymtable svref_2object parents);
+
+# Constants (should probably be elsewhere)
+sub G_ARRAY () { 1 }
+sub OPf_LIST () { 1 }
+sub OPf_KNOW () { 2 }
+sub OPf_STACKED () { 64 }
+
+my $file = "unknown";		# shadows current filename
+my $line = 0;			# shadows current line number
+my $curstash = "main";		# shadows current stash
+
+# Lint checks
+my %check;
+my %implies_ok_context;
+BEGIN {
+    map($implies_ok_context{$_}++,
+	qw(pp_scalar pp_av2arylen pp_aelem pp_aslice pp_helem pp_hslice
+	   pp_keys pp_values pp_hslice pp_defined pp_undef pp_delete));
+}
+
+# Lint checks turned on by default
+my @default_checks = qw(context);
+
+my %valid_check;
+# All valid checks
+BEGIN {
+    map($valid_check{$_}++,
+	qw(context implicit_read implicit_write dollar_underscore
+	   private_names undefined_subs regexp_variables));
+}
+
+# Debugging options
+my ($debug_op);
+
+my %done_cv;		# used to mark which subs have already been linted
+my @extra_packages;	# Lint checks mainline code and all subs which are
+			# in main:: or in one of these packages.
+
+sub warning {
+    my $format = (@_ < 2) ? "%s" : shift;
+    warn sprintf("$format at %s line %d\n", @_, $file, $line);
+}
+
+# This gimme can't cope with context that's only determined
+# at runtime via dowantarray().
+sub gimme {
+    my $op = shift;
+    my $flags = $op->flags;
+    if ($flags & OPf_KNOW) {
+	return(($flags & OPf_LIST) ? 1 : 0);
+    }
+    return undef;
+}
+
+sub B::OP::lint {}
+
+sub B::COP::lint {
+    my $op = shift;
+    if ($op->ppaddr eq "pp_nextstate") {
+	$file = $op->filegv->SV->PV;
+	$line = $op->line;
+	$curstash = $op->stash->NAME;
+    }
+}
+
+sub B::UNOP::lint {
+    my $op = shift;
+    my $ppaddr = $op->ppaddr;
+    if ($check{context} && ($ppaddr eq "pp_rv2av" || $ppaddr eq "pp_rv2hv")) {
+	my $parent = parents->[0];
+	my $pname = $parent->ppaddr;
+	return if gimme($op) || $implies_ok_context{$pname};
+	# Two special cases to deal with: "foreach (@foo)" and "delete $a{$b}"
+	# null out the parent so we have to check for a parent of pp_null and
+	# a grandparent of pp_enteriter or pp_delete
+	if ($pname eq "pp_null") {
+	    my $gpname = parents->[1]->ppaddr;
+	    return if $gpname eq "pp_enteriter" || $gpname eq "pp_delete";
+	}
+	warning("Implicit scalar context for %s in %s",
+		$ppaddr eq "pp_rv2av" ? "array" : "hash", $parent->desc);
+    }
+    if ($check{private_names} && $ppaddr eq "pp_method") {
+	my $methop = $op->first;
+	if ($methop->ppaddr eq "pp_const") {
+	    my $method = $methop->sv->PV;
+	    if ($method =~ /^_/ && !defined(&{"$curstash\::$method"})) {
+		warning("Illegal reference to private method name $method");
+	    }
+	}
+    }
+}
+
+sub B::PMOP::lint {
+    my $op = shift;
+    if ($check{implicit_read}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_match" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit match on $_');
+	}
+    }
+    if ($check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_subst" && !($op->flags & OPf_STACKED)) {
+	    warning('Implicit substitution on $_');
+	}
+    }
+}
+
+sub B::LOOP::lint {
+    my $op = shift;
+    if ($check{implicit_read} || $check{implicit_write}) {
+	my $ppaddr = $op->ppaddr;
+	if ($ppaddr eq "pp_enteriter") {
+	    my $last = $op->last;
+	    if ($last->ppaddr eq "pp_gv" && $last->gv->NAME eq "_") {
+		warning('Implicit use of $_ in foreach');
+	    }
+	}
+    }
+}
+
+sub B::GVOP::lint {
+    my $op = shift;
+    if ($check{dollar_underscore} && $op->ppaddr eq "pp_gvsv"
+	&& $op->gv->NAME eq "_")
+    {
+	warning('Use of $_');
+    }
+    if ($check{private_names}) {
+	my $ppaddr = $op->ppaddr;
+	my $gv = $op->gv;
+	if (($ppaddr eq "pp_gv" || $ppaddr eq "pp_gvsv")
+	    && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash)
+	{
+	    warning('Illegal reference to private name %s', $gv->NAME);
+	}
+    }
+    if ($check{undefined_subs}) {
+	if ($op->ppaddr eq "pp_gv" && $op->next->ppaddr eq "pp_entersub") {
+	    my $gv = $op->gv;
+	    my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
+	    no strict 'refs';
+	    if (!defined(&$subname)) {
+		$subname =~ s/^main:://;
+		warning('Undefined subroutine %s called', $subname);
+	    }
+	}
+    }
+    if ($check{regexp_variables} && $op->ppaddr eq "pp_gvsv") {
+	my $name = $op->gv->NAME;
+	if ($name =~ /^[&'`]$/) {
+	    warning('Use of regexp variable $%s', $name);
+	}
+    }
+}
+
+sub B::GV::lintcv {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    #warn sprintf("lintcv: %s::%s (done=%d)\n",
+    #		 $gv->STASH->NAME, $gv->NAME, $done_cv{$$cv});#debug
+    return if !$$cv || $done_cv{$$cv}++;
+    my $root = $cv->ROOT;
+    #warn "    root = $root (0x$$root)\n";#debug
+    walkoptree_slow($root, "lint") if $$root;
+}
+
+sub do_lint {
+    my %search_pack;
+    walkoptree_slow(main_root, "lint") if ${main_root()};
+    
+    # Now do subs in main
+    no strict qw(vars refs);
+    my $sym;
+    local(*glob);
+    while (($sym, *glob) = each %{"main::"}) {
+	#warn "Trying $sym\n";#debug
+	svref_2object(\*glob)->EGV->lintcv unless $sym =~ /::$/;
+    }
+
+    # Now do subs in non-main packages given by -u options
+    map { $search_pack{$_} = 1 } @extra_packages;
+    walksymtable(\%{"main::"}, "lintcv", sub {
+	my $package = shift;
+	$package =~ s/::$//;
+	#warn "Considering $package\n";#debug
+	return exists $search_pack{$package};
+    });
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+    # Turn on default lint checks
+    for $opt (@default_checks) {
+	$check{$opt} = 1;
+    }
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		}
+	    }
+	} elsif ($opt eq "u") {
+	    $arg ||= shift @options;
+	    push(@extra_packages, $arg);
+	}
+    }
+    foreach $opt (@default_checks, @options) {
+	$opt =~ tr/-/_/;
+	if ($opt eq "all") {
+	    %check = %valid_check;
+	}
+	elsif ($opt eq "none") {
+	    %check = ();
+	}
+	else {
+	    if ($opt =~ s/^no-//) {
+		$check{$opt} = 0;
+	    }
+	    else {
+		$check{$opt} = 1;
+	    }
+	    warn "No such check: $opt\n" unless defined $valid_check{$opt};
+	}
+    }
+    # Remaining arguments are things to check
+    
+    return \&do_lint;
+}
+
+1;
diff --git a/ext/B/B/Showlex.pm b/ext/B/B/Showlex.pm
new file mode 100644
index 0000000000..9cf8ecc564
--- /dev/null
+++ b/ext/B/B/Showlex.pm
@@ -0,0 +1,58 @@
+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;
diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
new file mode 100644
index 0000000000..8be047f19f
--- /dev/null
+++ b/ext/B/B/Stackobj.pm
@@ -0,0 +1,281 @@
+#      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 => "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} ? &sv_yes : &sv_no)";
+    $obj->{flags} |= VALID_SV;
+}
+
+# XXX Might want to handle as_double/set_double/load_double?
+
+sub B::Stackobj::Bool::invalidate {}
+
+1;
diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
new file mode 100644
index 0000000000..6489dc0afe
--- /dev/null
+++ b/ext/B/B/Terse.pm
@@ -0,0 +1,132 @@
+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;
diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
new file mode 100644
index 0000000000..0102856919
--- /dev/null
+++ b/ext/B/B/Xref.pm
@@ -0,0 +1,392 @@
+package B::Xref;
+
+=head1 NAME
+
+B::Xref - Generates cross reference reports for Perl programs
+
+=head1 SYNOPSIS
+
+perl -MO=Xref[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+The B::Xref module is used to generate a cross reference listing of all
+definitions and uses of variables, subroutines and formats in a Perl program.
+It is implemented as a backend for the Perl compiler.
+
+The report generated is in the following format:
+
+    File filename1
+      Subroutine subname1
+	Package package1
+	  object1        C<line numbers>
+	  object2        C<line numbers>
+	  ...
+	Package package2
+	...
+
+Each B<File> section reports on a single file. Each B<Subroutine> section
+reports on a single subroutine apart from the special cases
+"(definitions)" and "(main)". These report, respectively, on subroutine
+definitions found by the initial symbol table walk and on the main part of
+the program or module external to all subroutines.
+
+The report is then grouped by the B<Package> of each variable,
+subroutine or format with the special case "(lexicals)" meaning
+lexical variables. Each B<object> name (implicitly qualified by its
+containing B<Package>) includes its type character(s) at the beginning
+where possible. Lexical variables are easier to track and even
+included dereferencing information where possible.
+
+The C<line numbers> are a comma separated list of line numbers (some
+preceded by code letters) where that object is used in some way.
+Simple uses aren't preceded by a code letter. Introductions (such as
+where a lexical is first defined with C<my>) are indicated with the
+letter "i". Subroutine and method calls are indicated by the character
+"&".  Subroutine definitions are indicated by "s" and format
+definitions by "f".
+
+=head1 OPTIONS
+
+Option words are separated by commas (not whitespace) and follow the
+usual conventions of compiler backend options.
+
+=over 8
+
+=item C<-oFILENAME>
+
+Directs output to C<FILENAME> instead of standard output.
+
+=item C<-r>
+
+Raw output. Instead of producing a human-readable report, outputs a line
+in machine-readable form for each definition/use of a variable/sub/format.
+
+=item C<-D[tO]>
+
+(Internal) debug options, probably only useful if C<-r> included.
+The C<t> option prints the object on the top of the stack as it's
+being tracked. The C<O> option prints each operator as it's being
+processed in the execution order of the program.
+
+=back
+
+=head1 BUGS
+
+Non-lexical variables are quite difficult to track through a program.
+Sometimes the type of a non-lexical variable's use is impossible to
+determine. Introductions of non-lexical non-scalars don't seem to be
+reported properly.
+
+=head1 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+use strict;
+use B qw(peekop class comppadlist main_start svref_2object walksymtable);
+
+# Constants (should probably be elsewhere)
+sub OPpLVAL_INTRO () { 128 }
+sub SVf_POK () { 0x40000 }
+
+sub UNKNOWN { ["?", "?", "?"] }
+
+my @pad;			# lexicals in current pad
+				# as ["(lexical)", type, name]
+my %done;			# keyed by $$op: set when each $op is done
+my $top = UNKNOWN;		# shadows top element of stack as
+				# [pack, type, name] (pack can be "(lexical)")
+my $file;			# shadows current filename
+my $line;			# shadows current line number
+my $subname;			# shadows current sub name
+my %table;			# Multi-level hash to record all uses etc.
+my @todo = ();			# List of CVs that need processing
+
+my %code = (intro => "i", used => "",
+	    subdef => "s", subused => "&",
+	    formdef => "f", meth => "->");
+
+
+# Options
+my ($debug_op, $debug_top, $nodefs, $raw);
+
+sub process {
+    my ($var, $event) = @_;
+    my ($pack, $type, $name) = @$var;
+    if ($type eq "*") {
+	if ($event eq "used") {
+	    return;
+	} elsif ($event eq "subused") {
+	    $type = "&";
+	}
+    }
+    $type =~ s/(.)\*$/$1/g;
+    if ($raw) {
+	printf "%-16s %-12s %5d %-12s %4s %-16s %s\n",
+	    $file, $subname, $line, $pack, $type, $name, $event;
+    } else {
+	# Wheee
+	push(@{$table{$file}->{$subname}->{$pack}->{$type.$name}->{$event}},
+	    $line);
+    }
+}
+
+sub load_pad {
+    my $padlist = shift;
+    my ($namelistav, @namelist, $ix);
+    @pad = ();
+    return if class($padlist) eq "SPECIAL";
+    ($namelistav) = $padlist->ARRAY;
+    @namelist = $namelistav->ARRAY;
+    for ($ix = 1; $ix < @namelist; $ix++) {
+	my $namesv = $namelist[$ix];
+	next if class($namesv) eq "SPECIAL";
+	my ($type, $name) = $namesv->PV =~ /^(.)(.*)$/;
+	$pad[$ix] = ["(lexical)", $type, $name];
+    }
+}
+
+sub xref {
+    my $start = shift;
+    my $op;
+    for ($op = $start; $$op; $op = $op->next) {
+	last if $done{$$op}++;
+	warn sprintf("top = [%s, %s, %s]\n", @$top) if $debug_top;
+	warn peekop($op), "\n" if $debug_op;
+	my $ppname = $op->ppaddr;
+	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile)$/) {
+	    xref($op->other);
+	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} elsif ($ppname eq "pp_substcont") {
+	    xref($op->other->pmreplstart);
+	    $op = $op->other;
+	    redo;
+	} elsif ($ppname eq "pp_cond_expr") {
+	    # pp_cond_expr never returns op_next
+	    xref($op->true);
+	    $op = $op->false;
+	    redo;
+	} elsif ($ppname eq "pp_enterloop") {
+	    xref($op->redoop);
+	    xref($op->nextop);
+	    xref($op->lastop);
+	} elsif ($ppname eq "pp_subst") {
+	    xref($op->pmreplstart);
+	} else {
+	    no strict 'refs';
+	    &$ppname($op) if defined(&$ppname);
+	}
+    }
+}
+
+sub xref_cv {
+    my $cv = shift;
+    my $pack = $cv->GV->STASH->NAME;
+    $subname = ($pack eq "main" ? "" : "$pack\::") . $cv->GV->NAME;
+    load_pad($cv->PADLIST);
+    xref($cv->START);
+    $subname = "(main)";
+}
+
+sub xref_object {
+    my $cvref = shift;
+    xref_cv(svref_2object($cvref));
+}
+
+sub xref_main {
+    $subname = "(main)";
+    load_pad(comppadlist);
+    xref(main_start);
+    while (@todo) {
+	xref_cv(shift @todo);
+    }
+}
+
+sub pp_nextstate {
+    my $op = shift;
+    $file = $op->filegv->SV->PV;
+    $line = $op->line;
+    $top = UNKNOWN;
+}
+
+sub pp_padsv {
+    my $op = shift;
+    $top = $pad[$op->targ];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_padav { pp_padsv(@_) }
+sub pp_padhv { pp_padsv(@_) }
+
+sub deref {
+    my ($var, $as) = @_;
+    $var->[1] = $as . $var->[1];
+    process($var, "used");
+}
+
+sub pp_rv2cv { deref($top, "&"); }
+sub pp_rv2hv { deref($top, "%"); }
+sub pp_rv2sv { deref($top, "\$"); }
+sub pp_rv2av { deref($top, "\@"); }
+sub pp_rv2gv { deref($top, "*"); }
+
+sub pp_gvsv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, '$', $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_gv {
+    my $op = shift;
+    my $gv = $op->gv;
+    $top = [$gv->STASH->NAME, "*", $gv->NAME];
+    process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+}
+
+sub pp_const {
+    my $op = shift;
+    my $sv = $op->sv;
+    $top = ["?", "",
+	    (class($sv) ne "SPECIAL" && $sv->FLAGS & SVf_POK) ? $sv->PV : "?"];
+}
+
+sub pp_method {
+    my $op = shift;
+    $top = ["(method)", "->".$top->[1], $top->[2]];
+}
+
+sub pp_entersub {
+    my $op = shift;
+    if ($top->[1] eq "m") {
+	process($top, "meth");
+    } else {
+	process($top, "subused");
+    }
+    $top = UNKNOWN;
+}
+
+#
+# Stuff for cross referencing definitions of variables and subs
+#
+
+sub B::GV::xref {
+    my $gv = shift;
+    my $cv = $gv->CV;
+    if ($$cv) {
+	#return if $done{$$cv}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "&", $gv->NAME], "subdef");
+	push(@todo, $cv);
+    }
+    my $form = $gv->FORM;
+    if ($$form) {
+	return if $done{$$form}++;
+	$file = $gv->FILEGV->SV->PV;
+	$line = $gv->LINE;
+	process([$gv->STASH->NAME, "", $gv->NAME], "formdef");
+    }
+}
+
+sub xref_definitions {
+    my ($pack, %exclude);
+    return if $nodefs;
+    $subname = "(definitions)";
+    foreach $pack (qw(B O AutoLoader DynaLoader Config DB VMS
+		      strict vars FileHandle Exporter Carp)) {
+        $exclude{$pack."::"} = 1;
+    }
+    no strict qw(vars refs);
+    walksymtable(\%{"main::"}, "xref", sub { !defined($exclude{$_[0]}) });
+}
+
+sub output {
+    return if $raw;
+    my ($file, $subname, $pack, $name, $ev, $perfile, $persubname,
+	$perpack, $pername, $perev);
+    foreach $file (sort(keys(%table))) {
+	$perfile = $table{$file};
+	print "File $file\n";
+	foreach $subname (sort(keys(%$perfile))) {
+	    $persubname = $perfile->{$subname};
+	    print "  Subroutine $subname\n";
+	    foreach $pack (sort(keys(%$persubname))) {
+		$perpack = $persubname->{$pack};
+		print "    Package $pack\n";
+		foreach $name (sort(keys(%$perpack))) {
+		    $pername = $perpack->{$name};
+		    my @lines;
+		    foreach $ev (qw(intro formdef subdef meth subused used)) {
+			$perev = $pername->{$ev};
+			if (defined($perev) && @$perev) {
+			    my $code = $code{$ev};
+			    push(@lines, map("$code$_", @$perev));
+			}
+		    }
+		    printf "      %-16s  %s\n", $name, join(", ", @lines);
+		}
+	    }
+	}
+    }
+}
+
+sub compile {
+    my @options = @_;
+    my ($option, $opt, $arg);
+  OPTION:
+    while ($option = shift @options) {
+	if ($option =~ /^-(.)(.*)/) {
+	    $opt = $1;
+	    $arg = $2;
+	} else {
+	    unshift @options, $option;
+	    last OPTION;
+	}
+	if ($opt eq "-" && $arg eq "-") {
+	    shift @options;
+	    last OPTION;
+	} elsif ($opt eq "o") {
+	    $arg ||= shift @options;
+	    open(STDOUT, ">$arg") or return "$arg: $!\n";
+	} elsif ($opt eq "d") {
+	    $nodefs = 1;
+	} elsif ($opt eq "r") {
+	    $raw = 1;
+	} elsif ($opt eq "D") {
+            $arg ||= shift @options;
+	    foreach $arg (split(//, $arg)) {
+		if ($arg eq "o") {
+		    B->debug(1);
+		} elsif ($arg eq "O") {
+		    $debug_op = 1;
+		} elsif ($arg eq "t") {
+		    $debug_top = 1;
+		}
+	    }
+	}
+    }
+    if (@options) {
+	return sub {
+	    my $objname;
+	    xref_definitions();
+	    foreach $objname (@options) {
+		$objname = "main::$objname" unless $objname =~ /::/;
+		eval "xref_object(\\&$objname)";
+		die "xref_object(\\&$objname) failed: $@" if $@;
+	    }
+	    output();
+	}
+    } else {
+	return sub {
+	    xref_definitions();
+	    xref_main();
+	    output();
+	}
+    }
+}
+
+1;
diff --git a/ext/B/B/assemble b/ext/B/B/assemble
new file mode 100755
index 0000000000..43cc5bc4b3
--- /dev/null
+++ b/ext/B/B/assemble
@@ -0,0 +1,30 @@
+use B::Assembler qw(assemble_fh);
+use FileHandle;
+
+my ($filename, $fh, $out);
+
+if ($ARGV[0] eq "-d") {
+    B::Assembler::debug(1);
+    shift;
+}
+
+$out = \*STDOUT;
+
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+    $filename = "-";
+} elsif (@ARGV == 1) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+} elsif (@ARGV == 2) {
+    $filename = $ARGV[0];
+    $fh = new FileHandle "<$filename";
+    $out = new FileHandle ">$ARGV[1]";
+} else {
+    die "Usage: assemble [filename] [outfilename]\n";
+}
+
+binmode $out;
+$SIG{__WARN__} = sub { warn "$filename:@_" };
+$SIG{__DIE__} = sub { die "$filename: @_" };
+assemble_fh($fh, sub { print $out @_ });
diff --git a/ext/B/B/cc_harness b/ext/B/B/cc_harness
new file mode 100644
index 0000000000..79f8727a8f
--- /dev/null
+++ b/ext/B/B/cc_harness
@@ -0,0 +1,12 @@
+use Config;
+
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
+
+if (!grep(/^-[cS]$/, @ARGV)) {
+    $linkargs = sprintf("%s $libdir/$Config{libperl} %s",
+			@Config{qw(ldflags libs)});
+}
+
+$cccmd = "$Config{cc} $Config{ccflags} -I$libdir @ARGV $linkargs";
+print "$cccmd\n";
+exec $cccmd;
diff --git a/ext/B/B/disassemble b/ext/B/B/disassemble
new file mode 100755
index 0000000000..6530b80950
--- /dev/null
+++ b/ext/B/B/disassemble
@@ -0,0 +1,22 @@
+use B::Disassembler qw(disassemble_fh);
+use FileHandle;
+
+my $fh;
+if (@ARGV == 0) {
+    $fh = \*STDIN;
+} elsif (@ARGV == 1) {
+    $fh = new FileHandle "<$ARGV[0]";
+} else {
+    die "Usage: disassemble [filename]\n";
+}
+
+sub print_insn {
+    my ($insn, $arg) = @_;
+    if (defined($arg)) {
+	printf "%s %s\n", $insn, $arg;
+    } else {
+	print $insn, "\n";
+    }
+}
+
+disassemble_fh($fh, \&print_insn);
diff --git a/ext/B/B/makeliblinks b/ext/B/B/makeliblinks
new file mode 100644
index 0000000000..82560783c0
--- /dev/null
+++ b/ext/B/B/makeliblinks
@@ -0,0 +1,54 @@
+use File::Find;
+use Config;
+
+if (@ARGV != 2) {
+    warn <<"EOT";
+Usage: makeliblinks libautodir targetdir
+where libautodir is the architecture-dependent auto directory
+(e.g. $Config::Config{archlib}/auto).
+EOT
+    exit 2;
+}
+
+my ($libautodir, $targetdir) = @ARGV;
+
+# Calculate relative path prefix from $targetdir to $libautodir
+sub relprefix {
+    my ($to, $from) = @_;
+    my $up;
+    for ($up = 0; substr($to, 0, length($from)) ne $from; $up++) {
+	$from =~ s(
+		   [^/]+	(?# a group of non-slashes) 
+		   /*		(?# maybe with some trailing slashes)
+		   $		(?# at the end of the path)
+                  )()x;
+    }
+    return (("../" x $up) . substr($to, length($from)));
+}
+
+my $relprefix = relprefix($libautodir, $targetdir);
+
+my ($dlext, $lib_ext) = @Config::Config{qw(dlext lib_ext)};
+
+sub link_if_library {
+    if (/\.($dlext|$lib_ext)$/o) {
+	my $ext = $1;
+	my $name = $File::Find::name;
+	if (substr($name, 0, length($libautodir) + 1) ne "$libautodir/") {
+	    die "directory of $name doesn't match $libautodir\n";
+	}
+	substr($name, 0, length($libautodir) + 1) = '';
+	my @parts = split(m(/), $name);
+	if ($parts[-1] ne "$parts[-2].$ext") {
+	    die "module name $_ doesn't match its directory $libautodir\n";
+	}
+	pop @parts;
+	my $libpath = "$targetdir/lib" . join("__", @parts) . ".$ext";
+	print "$libpath -> $relprefix/$name\n";
+	symlink("$relprefix/$name", $libpath)
+	    or warn "above link failed with error: $!\n";
+    }
+}
+
+find(\&link_if_library, $libautodir);
+exit 0;
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
new file mode 100644
index 0000000000..bc42a34d33
--- /dev/null
+++ b/ext/B/Makefile.PL
@@ -0,0 +1,54 @@
+use ExtUtils::MakeMaker;
+use Config;
+
+my $e = $Config{'exe_ext'};
+my $o = $Config{'obj_ext'};
+my $exeout_flag = '-o ';
+my @extras = ();
+if ($^O eq 'MSWin32') {
+    if ($Config{'cc'} =~ /^cl/i) {
+	$exeout_flag = '-Fe';
+    }
+    elsif ($Config{'cc'} =~ /^bcc/i) {
+	$exeout_flag = '-e';
+    }
+    # XXX this probably applies to everyone else
+    @extras = (
+    OBJECT	=> "B$o byterun$o",
+    depend	=> {
+	"B$o"		=> "B.c ../../bytecode.h ../../byterun.h",
+	"byterun$o"	=> "../../byterun.c ../../bytecode.h ../../byterun.h",
+    });
+}
+
+WriteMakefile(
+    NAME	=> "B",
+    VERSION	=> "a5",
+    @extras,
+    clean	=> {
+	FILES		=> "perl byteperl$e *$o B.c *~"
+    }
+);
+
+sub MY::post_constants {
+    "\nLIBS = $Config{libs}\n"
+}
+
+# Leave out doing byteperl for now. Probably should be built in the
+# core directory or somewhere else rather than here
+#sub MY::top_targets {
+#    my $self = shift;
+#    my $targets = $self->MM::top_targets();
+#    $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
+#    return <<"EOT" . $targets;
+
+#
+# byteperl is *not* a standard perl+XSUB executable. It's a special
+# program for running standalone bytecode executables. It isn't an XSUB
+# at the moment because a standlone Perl program needs to set up curpad
+# which is overwritten on exit from an XSUB.
+#
+#byteperl$e : byteperl$o B$o \$(PERL_SRC)/byterun$o
+#	\$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS)
+#EOT
+#}
diff --git a/ext/B/NOTES b/ext/B/NOTES
new file mode 100644
index 0000000000..ee10ba03e9
--- /dev/null
+++ b/ext/B/NOTES
@@ -0,0 +1,168 @@
+C backend invocation
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	-v		Verbose (currently gives a few compilation statistics)
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed
+		c	COPs, prints COPs as processed (incl. file & line num)
+		A	prints AV information on saving
+		C	prints CV information on saving
+		M	prints MAGIC information on saving
+	-f		Force optimisations on or off one at a time.
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 and higher set -fcog.
+
+Examples
+	perl -MO=C foo.pl > foo.c
+	perl cc_harness -o foo foo.c
+
+	perl -MO=C,-v,-DcA bar.pl > /dev/null
+
+CC backend invocation
+	If there are any non-option arguments, they are taken to be names of
+	subs to be saved. Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT
+	--		Force end of options
+	-uPackname	Force apparently unused subs from package Packname to
+			be compiled. This allows programs to use eval "foo()"
+			even when sub foo is never seen to be used at compile
+			time. The down side is that any subs which really are
+			never used also have code generated. This option is
+			necessary, for example, if you have a signal handler
+			foo which you initialise with $SIG{BAR} = "foo".
+			A better fix, though, is just to change it to
+			$SIG{BAR} = \&foo. You can have multiple -u options.
+	-mModulename	Instead of generating source for a runnable executable,
+			generate source for an XSUB module. The
+			boot_Modulename function (which DynaLoader can look
+			for) does the appropriate initialisation and runs the
+			main part of the Perl source that is being compiled.
+	-pn		Generate code for perl patchlevel n (e.g. 3 or 4).
+			The default is to generate C code which will link
+			with the currently executing version of perl.
+			running the perl compiler.
+	-D		Debug options (concat or separate flags like perl -D)
+		r	Writes debugging output to STDERR just as it's about
+			to write to the program's runtime (otherwise writes
+			debugging info as comments in its C output).
+		O	Outputs each OP as it's compiled
+		s	Outputs the contents of the shadow stack at each OP
+		p	Outputs the contents of the shadow pad of lexicals as
+			it's loaded for each sub or the main program.
+		q	Outputs the name of each fake PP function in the queue
+			as it's about to processes.
+		l	Output the filename and line number of each original
+			line of Perl code as it's processed (pp_nextstate).
+		t	Outputs timing information of compilation stages
+	-f		Force optimisations on or off one at a time.
+		[
+		cog	Copy-on-grow: PVs declared and initialised statically
+		no-cog	No copy-on-grow
+		These two not in CC yet.
+		]
+		freetmps-each-bblock	Delays FREETMPS from the end of each
+					statement to the end of the each basic
+					block.
+		freetmps-each-loop	Delays FREETMPS from the end of each
+					statement to the end of the group of
+					basic blocks forming a loop. At most
+					one of the freetmps-each-* options can
+					be used.
+		omit-taint		Omits generating code for handling
+					perl's tainting mechanism.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			Currently, -O1 sets -ffreetmps-each-bblock and -O2
+			sets -ffreetmps-each-loop.
+
+Example
+	perl -MO=CC,-O2,-ofoo.c foo.pl
+	perl cc_harness -o foo foo.c
+
+	perl -MO=CC,-mFoo,-oFoo.c Foo.pm
+	perl cc_harness -shared -c -o Foo.so Foo.c
+
+
+Bytecode backend invocation
+
+	If there are any non-option arguments, they are taken to be
+	names of objects to be saved (probably doesn't work properly yet).
+	Without extra arguments, it saves the main program.
+	-ofilename	Output to filename instead of STDOUT.
+	--		Force end of options.
+	-f		Force optimisations on or off one at a time.
+			Each can be preceded by no- to turn the option off.
+		compress-nullops
+			Only fills in the necessary fields of ops which have
+			been optimised away by perl's internal compiler.
+		omit-sequence-numbers
+			Leaves out code to fill in the op_seq field of all ops
+			which is only used by perl's internal compiler.
+		bypass-nullops
+			If op->op_next ever points to a NULLOP, replaces the
+			op_next field with the first non-NULLOP in the path
+			of execution.
+		strip-syntax-tree
+			Leaves out code to fill in the pointers which link the
+			internal syntax tree together. They're not needed at
+			run-time but leaving them out will make it impossible
+			to recompile or disassemble the resulting program.
+			It will also stop "goto label" statements from working.
+	-On		Optimisation level (n = 0, 1, 2, ...). -O means -O1.
+			-O1 sets -fcompress-nullops -fomit-sequence numbers.
+			-O6 adds -fstrip-syntax-tree.
+	-D		Debug options (concat or separate flags like perl -D)
+		o	OPs, prints each OP as it's processed.
+		b	print debugging information about bytecompiler progress
+		a	tells the assembler to include source assembler lines
+			in its output as bytecode comments.
+		C	prints each CV taken from the final symbol tree walk.
+	-S		Output assembler source rather than piping it
+			through the assembler and outputting bytecode.
+	-m		Compile as a module rather than a standalone program.
+			Currently this just means that the bytecodes for
+			initialising main_start, main_root and curpad are
+			omitted.
+
+Example
+	perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+
+	perl -MO=Bytecode,-S foo.pl > foo.S
+	assemble foo.S > foo.plc
+	byteperl foo.plc
+
+	perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm
+
+Backends for debugging
+	perl -MO=Terse,exec foo.pl
+	perl -MO=Debug bar.pl
+
+O module
+	Used with "perl -MO=Backend,foo,bar prog.pl" to invoke the backend
+	B::Backend with options foo and bar. O invokes the sub
+	B::Backend::compile() with arguments foo and bar at BEGIN time.
+	That compile() sub must do any inital argument processing replied.
+	If unsuccessful, it should return a string which O arranges to be
+	printed as an error message followed by a clean error exit. In the
+	normal case where any option processing in compile() is successful,
+	it should return a sub ref (usually a closure) to perform the
+	actual compilation. When O regains control, it ensures that the
+	"-c" option is forced (so that the program being compiled doesn't
+	end up running) and registers an END block to call back the sub ref
+	returned from the backend's compile(). Perl then continues by
+	parsing prog.pl (just as it would with "perl -c prog.pl") and after
+	doing so, assuming there are no parse-time errors, the END block
+	of O gets called and the actual backend compilation happens. Phew.
diff --git a/ext/B/O.pm b/ext/B/O.pm
new file mode 100644
index 0000000000..40d336e122
--- /dev/null
+++ b/ext/B/O.pm
@@ -0,0 +1,21 @@
+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;
+
diff --git a/ext/B/README b/ext/B/README
new file mode 100644
index 0000000000..4e4ed25fdc
--- /dev/null
+++ b/ext/B/README
@@ -0,0 +1,325 @@
+		  Perl Compiler Kit, Version alpha4
+
+		 Copyright (c) 1996, 1997, Malcolm Beattie
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of either:
+
+	a) the GNU General Public License as published by the Free
+	Software Foundation; either version 1, or (at your option) any
+	later version, or
+
+	b) the "Artistic License" which comes with this kit.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
+    the GNU General Public License or the Artistic License for more details.
+
+    You should have received a copy of the Artistic License with this kit,
+    in the file named "Artistic".  If not, you can get one from the Perl
+    distribution. You should also have received a copy of the GNU General
+    Public License, in the file named "Copying". If not, you can get one
+    from the Perl distribution or else write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+CHANGES
+
+New since alpha3
+    Anonymous subs work properly with C and CC.
+    Heuristics for forcing compilation of apparently unused subs/methods.
+    Subs which use the AutoLoader module are forcibly loaded at compile-time.
+    Slightly faster compilation.
+    Handles slightly more complex code within a BEGIN { }.
+    Minor bug fixes.
+
+New since alpha2
+    CC backend now supports ".." and s//e.
+    Xref backend generates cross-reference reports
+    Cleanups to fix benign but irritating "-w" warnings
+    Minor cxstack fix
+New since alpha1
+    Working CC backend
+    Shared globs and pre-initialised hash support
+    Some XSUB support
+    Assorted bug fixes
+
+INSTALLATION
+
+(1) You need perl5.002 or later.
+
+(2) If you want to compile and run programs with the C or CC backends
+which undefine (or redefine) subroutines, then you need to apply a
+one-line patch to perl itself. One or two of the programs in perl's
+own test suite do this. The patch is in file op.patch. It prevents
+perl from calling free() on OPs with the magic sequence number (U16)-1.
+The compiler declares all OPs as static structures and uses that magic
+sequence number.
+
+(3) Type
+    perl Makefile.PL
+to write a personalised Makefile for your system. If you want the
+bytecode modules to support reading bytecode from strings (instead of
+just from files) then add the option
+    -DINDIRECT_BGET_MACROS
+into the middle of the definition of the CCCMD macro in the Makefile.
+Your C compiler may need to be able to cope with Standard C for this.
+I haven't tested this option yet with an old pre-Standard compiler.
+
+(4) If your platform supports dynamic loading then just type
+    make
+and you can then use
+    perl -Iblib/arch -MO=foo bar
+to use the compiler modules (see later for details).
+If you need/want instead to make a statically linked perl which
+contains the appropriate modules, then type
+    make perl
+    make byteperl
+and you can then use
+    ./perl -MO=foo bar
+to use the compiler modules.    
+In both cases, the byteperl executable is required for running standalone
+bytecode programs. It is *not* a standard perl+XSUB perl executable.
+
+USAGE
+
+As of the alpha3 release, the Bytecode, C and CC backends are now all
+functional enough to compile almost the whole of the main perl test
+suite. In the case of the CC backend, any failures are all due to
+differences and/or known bugs documented below. See the file TESTS.
+In the following examples, you'll need to replace "perl" by
+    perl -Iblib/arch
+if you have built the extensions for a dynamic loading platform but
+haven't installed the extensions completely. You'll need to replace
+"perl" by
+    ./perl
+if you have built the extensions into a statically linked perl binary.
+
+(1) To compile perl program foo.pl with the C backend, do
+    perl -MO=C,-ofoo.c foo.pl
+Then use the cc_harness perl program to compile the resulting C source:
+    perl cc_harness -O2 -o foo foo.c
+
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+pre-declaring static arrays, then add -DBROKEN_STATIC_REDECL to the
+options you use:
+    perl cc_harness -O2 -o foo -DBROKEN_STATIC_REDECL foo.c
+If you are using a non-ANSI pre-Standard C compiler that can't handle
+static initialisation of structures with union members then add
+-DBROKEN_UNION_INIT to the options you use. If you want command line
+arguments passed to your executable to be interpreted by perl (e.g. -Dx)
+then compile foo.c with -DALLOW_PERL_OPTIONS. Otherwise, all command line
+arguments passed to foo will appear directly in @ARGV.  The resulting
+executable foo is the compiled version of foo.pl. See the file NOTES for
+extra options you can pass to -MO=C.
+
+There are some constraints on the contents on foo.pl if you want to be
+able to compile it successfully. Some problems can be fixed fairly easily
+by altering foo.pl; some problems with the compiler are known to be
+straightforward to solve and I'll do so soon. The file Todo lists a
+number of known problems. See the XSUB section lower down for information
+about compiling programs which use XSUBs.
+
+(2) To compile foo.pl with the CC backend (which generates actual
+optimised C code for the execution path of your perl program), use
+    perl -MO=CC,-ofoo.c foo.pl
+
+and proceed just as with the C backend. You should almost certainly
+use an option such as -O2 with the subsequent cc_harness invocation
+so that your C compiler uses optimisation. The C code generated by
+the Perl compiler's CC backend looks ugly to humans but is easily
+optimised by C compilers.
+
+To make the most of this compiler backend, you need to tell the
+compiler when you're using int or double variables so that it can
+optimise appropriately (although this part of the compiler is the most
+buggy). You currently do that by naming lexical variables ending in
+"_i" for ints, "_d" for doubles, "_ir" for int "register" variables or
+"_dr" for double "register" variables. Here "register" is a promise
+that you won't pass a reference to the variable into a sub which then
+modifies the variable. The compiler ought to catch attempts to use
+"\$i" just as C compilers catch attempts to do "&i" for a register int
+i but it doesn't at the moment. Bugs in the CC backend may make your
+program fail in mysterious ways and give wrong answers rather than just
+crash in boring ways. But, hey, this is an alpha release so you knew
+that anyway. See the XSUB section lower down for information about
+compiling programs which use XSUBs.
+
+If your program uses classes which define methods (or other subs which
+are not exported and not apparently used until runtime) then you'll
+need to use -u compile-time options (see the NOTES file) to force the
+subs to be compiled. Future releases will probably default the other
+way, do more auto-detection and provide more fine-grained control.
+
+Since compiled executables need linking with libperl, you may want
+to turn libperl.a into a shared library if your platform supports
+it. For example, with Digital UNIX, do something like
+    ld -shared -o libperl.so -all libperl.a -none -lc
+and with Linux/ELF, rebuild the perl .c files with -fPIC (and I
+also suggest -fomit-frame-pointer for Linux on Intel architetcures),
+do "make libperl.a" and then do
+    gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a`
+and then
+    # cp libperl.so.5.3 /usr/lib
+    # cd /usr/lib
+    # ln -s libperl.so.5.3 libperl.so.5
+    # ln -s libperl.so.5 libperl.so
+    # ldconfig
+When you compile perl executables with cc_harness, append -L/usr/lib
+otherwise the -L for the perl source directory will override it. For
+example,
+    perl -Iblib/arch -MO=CC,-O2,-ofoo3.c foo3.bench
+    perl cc_harness -o foo3 -O2 foo3.c -L/usr/lib
+    ls -l foo3
+    -rwxr-xr-x   1 mbeattie xzdg        11218 Jul  1 15:28 foo3
+You'll probably also want to link your main perl executable against
+libperl.so; it's nice having an 11K perl executable.
+
+(3) To compile foo.pl into bytecode do
+    perl -MO=Bytecode,-ofoo foo.pl
+To run the resulting bytecode file foo as a standalone program, you
+use the program byteperl which should have been built along with the
+extensions.
+    ./byteperl foo
+Any extra arguments are passed in as @ARGV; they are not interpreted
+as perl options. If you want to load chunks of bytecode into an already
+running perl program then use the -m option and investigate the
+byteload_fh and byteload_string functions exported by the B module.
+See the NOTES file for details of these and other options (including
+optimisation options and ways of getting at the intermediate "assembler"
+code that the Bytecode backend uses).
+
+(3) There are little Bourne shell scripts and perl programs to aid with
+some common operations: assemble, disassemble, run_bytecode_test,
+run_test, cc_harness, test_harness, test_harness_bytecode.
+
+(4) Walk the op tree in execution order printing terse info about each op
+    perl -MO=Terse,exec foo.pl
+
+(5) Walk the op tree in syntax order printing lengthier debug info about
+each op. You can also append ",exec" to walk in execution order, but the
+formatting is designed to look nice with Terse rather than Debug.
+    perl -MO=Debug foo.pl
+
+(6) Produce a cross-reference report of the line numbers at which all
+variables, subs and formats are defined and used.
+    perl -MO=Xref foo.pl
+
+XSUBS
+
+The C and CC backends can successfully compile some perl programs which
+make use of XSUB extensions. [I'll add more detail to this section in a
+later release.] As a prerequisite, such extensions must not need to do
+anything in their BOOT: section which needs to be done at runtime rather
+than compile time. Normally, the only code in the boot_Foo() function is
+a list of newXS() calls which xsubpp puts there and the compiler handles
+saving those XS subs itself. For each XSUB used, the C and CC compiler
+will generate an initialiser in their C output which refers to the name
+of the relevant C function (XS_Foo_somesub). What is not yet automated
+is the necessary commands and cc command-line options (e.g. via
+"perl cc_harness") which link against the extension libraries. For now,
+you need the XSUB extension to have installed files in the right format
+for using as C libraries (e.g. Foo.a or Foo.so). As the Foo.so files (or
+your platform's version) aren't suitable for linking against, you will
+have to reget the extension source and rebuild it as a static extension
+to force the generation of a suitable Foo.a file. Then you need to make
+a symlink (or copy or rename) of that file into a libFoo.a suitable for
+cc linking. Then add the appropriate -L and -l options to your
+"perl cc_harness" command line to find and link against those libraries.
+You may also need to fix up some platform-dependent environment variable
+to ensure that linked-against .so files are found at runtime too.
+
+DIFFERENCES
+
+The result of running a compiled Perl program can sometimes be different
+from running the same program with standard perl. Think of the compiler
+as having a slightly different implementation of the language Perl.
+Unfortunately, since Perl has had a single implementation until now,
+there are no formal standards or documents defining what behaviour is
+guaranteed of Perl the language and what just "happens to work".
+Some of the differences below are almost impossible to change because of
+the way the compiler works. Others can be changed to produce "standard"
+perl behaviour if it's deemed proper and the resulting performance hit
+is accepted. I'll use "standard perl" to mean the result of running a
+Perl program using the perl executable from the perl distribution.
+I'll use "compiled Perl program" to mean running an executable produced
+by this compiler kit ("the compiler") with the CC backend.
+
+Loops
+    Standard perl calculates the target of "next", "last", and "redo"
+    at run-time. The compiler calculates the targets at compile-time.
+    For example, the program
+
+        sub skip_on_odd { next NUMBER if $_[0] % 2 }
+        NUMBER: for ($i = 0; $i < 5; $i++) {
+            skip_on_odd($i);
+            print $i;
+        }
+
+    produces the output
+        024
+    with standard perl but gives a compile-time error with the compiler.
+
+Context of ".."
+    The context (scalar or array) of the ".." operator determines whether
+    it behaves as a range or a flip/flop. Standard perl delays until
+    runtime the decision of which context it is in but the compiler needs
+    to know the context at compile-time. For example,
+	@a = (4,6,1,0,0,1);
+	sub range { (shift @a)..(shift @a) }
+	print range();
+	while (@a) { print scalar(range()) }
+    generates the output
+        456123E0
+    with standard Perl but gives a compile-time error with compiled Perl.
+
+Arithmetic
+    Compiled Perl programs use native C arithemtic much more frequently
+    than standard perl. Operations on large numbers or on boundary
+    cases may produce different behaviour.
+
+Deprecated features
+    Features of standard perl such as $[ which have been deprecated
+    in standard perl since version 5 was released have not been
+    implemented in the compiler.
+
+Others
+    I'll add to this list as I remember what they are.
+
+BUGS
+
+Here are some things which may cause the compiler problems.
+
+The following render the compiler useless (without serious hacking):
+* Use of the DATA filehandle (via __END__ or __DATA__ tokens)
+* Operator overloading with %OVERLOAD
+* The (deprecated) magic array-offset variable $[ does not work
+* The following operators are not yet implemented for CC
+    goto
+    sort with a non-default comparison (i.e. a named sub or inline block)
+* You can't use "last" to exit from a non-loop block.
+
+The following may give significant problems:
+* BEGIN blocks containing complex initialisation code
+* Code which is only ever referred to at runtime (e.g. via eval "..." or
+  via method calls): see the -u option for the C and CC backends.
+* Run-time lookups of lexical variables in "outside" closures
+
+The following may cause problems (not thoroughly tested):
+* Dependencies on whether values of some "magic" Perl variables are
+  determined at compile-time or runtime.
+* For the C and CC backends: compile-time strings which are longer than
+  your C compiler can cope with in a single line or definition.
+* Reliance on intimate details of global destruction
+* For the Bytecode backend: high -On optimisation numbers with code
+  that has complex flow of control.
+* Any "-w" option in the first line of your perl program is seen and
+  acted on by perl itself before the compiler starts. The compiler
+  itself then runs with warnings turned on. This may cause perl to
+  print out warnings about the compiler itself since I haven't tested
+  it thoroughly with warnings turned on.
+
+There is a terser but more complete list in the Todo file.
+
+Malcolm Beattie
+2 September 1996
diff --git a/ext/B/TESTS b/ext/B/TESTS
new file mode 100644
index 0000000000..e050f6cfdd
--- /dev/null
+++ b/ext/B/TESTS
@@ -0,0 +1,78 @@
+Test results from compiling t/*/*.t
+		C		Bytecode	CC
+
+base/cond.t	OK		ok		OK
+base/if.t	OK		ok		OK
+base/lex.t	OK		ok		OK
+base/pat.t	OK		ok		OK
+base/term.t	OK		ok		OK
+cmd/elsif.t	OK		ok		OK
+cmd/for.t	OK		ok		ok 1, 2, 3, panic: pp_iter
+cmd/mod.t	OK		ok		ok
+cmd/subval.t	OK		ok		1..34, not ok 27,28 (simply
+						because filename changes).
+cmd/switch.t	OK		ok		ok
+cmd/while.t	OK		ok		ok
+io/argv.t	OK		ok		ok
+io/dup.t	OK		ok		ok
+io/fs.t		OK		ok		ok
+io/inplace.t	OK		ok		ok
+io/pipe.t	OK		ok		ok with -umain
+io/print.t	OK		ok		ok
+io/tell.t	OK		ok		ok
+op/append.t	OK		ok		OK
+op/array.t	OK		ok		1..36, not ok 7,10 (no $[)
+op/auto.t	OK		ok		OK
+op/chop.t	OK		ok		OK
+op/cond.t	OK		ok		OK
+op/delete.t	OK		ok		OK
+op/do.t		OK		ok		OK
+op/each.t	OK		ok		OK
+op/eval.t	OK		ok		ok 1-6 of 16 then exits
+op/exec.t	OK		ok		OK
+op/exp.t	OK		ok		OK
+op/flip.t	OK		ok		OK
+op/fork.t	OK		ok		OK
+op/glob.t	OK		ok		OK
+op/goto.t	OK		ok		1..9, Can't find label label1.
+op/groups.t	OK (s/ucb/bin/ under Linux)	OK 1..0 for now.
+op/index.t	OK		ok		OK
+op/int.t	OK		ok		OK
+op/join.t	OK		ok		OK
+op/list.t	OK		ok		OK
+op/local.t	OK		ok		OK
+op/magic.t	OK		ok		OK
+op/misc.t	no DATA filehandle so succeeds trivially with 1..0
+op/mkdir.t	OK		ok		OK
+op/my.t		OK		ok		OK
+op/oct.t	OK		ok		OK (C large const warnings)
+op/ord.t	OK		ok		OK
+op/overload.t	Mostly not ok	Mostly not ok	C errors.
+op/pack.t	OK		ok		OK
+op/pat.t	omit 26 (reset)	ok		[lots of memory for compile]
+op/push.t	OK		ok		OK
+op/quotemeta.t	OK		ok		OK
+op/rand.t	OK		ok		
+op/range.t	OK		ok		OK
+op/read.t	OK		ok		OK
+op/readdir.t	OK		ok		OK (substcont works too)
+op/ref.t	omits "ok 40" (lex destruction)	ok (Bytecode)
+						CC: need -u for OBJ,BASEOBJ,
+						UNIVERSAL,WHATEVER,main.
+						1..41, ok1-33,36-38,
+						then ok 41, ok 39.DESTROY probs
+op/regexp.t	OK		ok		ok (trivially all eval'd)
+op/repeat.t	OK		ok		ok
+op/sleep.t	OK		ok		ok
+op/sort.t	OK		ok		1..10, ok 1, Out of memory!
+op/split.t	OK		ok		ok
+op/sprintf.t	OK		ok		ok
+op/stat.t	OK		ok		ok
+op/study.t	OK		ok		ok
+op/subst.t	OK		ok		ok
+op/substr.t	OK		ok		ok1-22 except 7-9,11 (all $[)
+op/time.t	OK		ok		ok
+op/undef.t	omit 21		ok		ok
+op/unshift.t	OK		ok		ok
+op/vec.t	OK		ok		ok
+op/write.t	not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang
diff --git a/ext/B/Todo b/ext/B/Todo
new file mode 100644
index 0000000000..495be2ef3d
--- /dev/null
+++ b/ext/B/Todo
@@ -0,0 +1,37 @@
+* Fixes
+
+CC backend: goto, sort with non-default comparison. last for non-loop blocks.
+Version checking
+improve XSUB handling (both static and dynamic)
+sv_magic can do SvREFCNT_inc(obj) which messes up precalculated refcounts
+allocation of XPV[INAHC]V structures needs fixing: Perl tries to free
+them whereas the compiler expects them to be linked to a xpv[inahc]v_root
+list the same as X[IPR]V structures.
+ref counts
+perl_parse replacement
+fix cstring for long strings
+compile-time initialisation of AvARRAYs
+signed/unsigned problems with NV (and IV?) initialisation and elsewhere?
+CvOUTSIDE for ordinary subs
+DATA filehandle for standalone Bytecode program (easy)
+DATA filehandle for multiple bytecode-compiled modules (harder)
+DATA filehandle for C-compiled program (yet harder)
+
+* Features
+
+type checking
+compile time v. runtime initialisation
+save PMOPs in compiled form
+selection of what to dump
+options for cutting out line info etc.
+comment output
+shared constants
+module dependencies
+
+* Optimisations
+collapse LISTOPs to UNOPs or BASEOPs
+compile-time qw(), constant subs
+global analysis of variables, type hints etc.
+demand-loaded bytecode (leader of each basic block replaced by an op
+which loads in bytecode for its block)
+fast sub calls for CC backend
diff --git a/ext/B/byteperl.c b/ext/B/byteperl.c
new file mode 100644
index 0000000000..c4bf6d7dd8
--- /dev/null
+++ b/ext/B/byteperl.c
@@ -0,0 +1,103 @@
+#include "EXTERN.h"
+#include "perl.h"
+#ifndef PATCHLEVEL
+#include "patchlevel.h"
+#endif
+#include "byterun.h"
+
+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 (!do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+    }
+
+#ifdef CSH
+    if (!cshlen) 
+      cshlen = strlen(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]);
+	    exit(1);
+	}
+	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]);
+    main_cv = compcv;
+    compcv = 0;
+
+#ifdef INDIRECT_BGET_MACROS
+    bs.data = fp;
+    bs.fgetc = (int(*) _((void*)))fgetc;
+    bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
+    bs.freadpv = freadpv;
+    byterun(bs);
+#else    
+    byterun(fp);
+#endif /* INDIRECT_BGET_MACROS */
+    
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    exit( exitstatus );
+}
+
+static void
+xs_init()
+{
+}
diff --git a/ext/B/ramblings/cc.notes b/ext/B/ramblings/cc.notes
new file mode 100644
index 0000000000..47bd65a09d
--- /dev/null
+++ b/ext/B/ramblings/cc.notes
@@ -0,0 +1,32 @@
+At entry to each basic block, the following can be assumed (and hence
+must be forced where necessary at the end of each basic block):
+
+The shadow stack @stack is empty.
+For each lexical object in @pad, VALID_IV holds for each T_INT,
+VALID_DOUBLE holds for each T_DOUBLE and VALID_SV holds otherwise.
+The C shadow variable sp holds the stack pointer (not necessarily stack_sp).
+
+write_back_stack
+    Writes the contents of the shadow stack @stack back to the real stack.
+    A write-back of each object in the stack is forced so that its
+    backing SV contains the right value and that SV is then pushed onto the
+    real stack. On return, @stack is empty.
+
+write_back_lexicals
+    Forces a write-back (i.e. achieves VALID_SV), where necessary, for each
+    lexical object in @pad. Objects with the TEMPORARY flag are skipped. If
+    write_back_lexicals is called with an (optional) argument, then it is
+    taken to be a bitmask of more flags: any lexical object with one of those
+    flags set is also skipped and not written back to its SV.
+
+invalidate_lexicals($avoid)
+    The VALID_INT and VALID_DOUBLE flags are turned off for each lexical
+    object in @pad whose flags field doesn't overlap with $avoid.
+
+reload_lexicals
+    For each necessary lexical object in @pad, makes sure that VALID_IV
+    holds for objects of type T_INT, VALID_DOUBLE holds for objects for
+    type T_DOUBLE, and VALID_SV holds for other objects. An object is
+    considered for reloading if its flags field does not overlap with the
+    (optional) argument passed to reload_lexicals.
+
diff --git a/ext/B/ramblings/curcop.runtime b/ext/B/ramblings/curcop.runtime
new file mode 100644
index 0000000000..9b8b7d52e7
--- /dev/null
+++ b/ext/B/ramblings/curcop.runtime
@@ -0,0 +1,39 @@
+PP code uses of curcop
+----------------------
+
+pp_rv2gv
+	when a new glob is created for an OPpLVAL_INTRO,
+	curcop->cop_line is stored as GvLINE() in the new GP.
+pp_bless
+	curcop->cop_stash is used as the stash in the one-arg form of bless
+
+pp_repeat
+	tests (curcop != &compiling) to warn "Can't x= to readonly value"
+
+pp_pos
+pp_substr
+pp_index
+pp_rindex
+pp_aslice
+pp_lslice
+pp_splice
+	curcop->cop_arybase
+
+pp_sort
+	curcop->cop_stash used to determine whether to gv_fetchpv $a and $b
+
+pp_caller
+	tests (curcop->cop_stash == debstash) to determine whether
+	to set DB::args
+
+pp_reset
+	resets vars in curcop->cop_stash
+
+pp_dbstate
+	sets curcop = (COP*)op
+
+doeval
+	compiles into curcop->cop_stash
+
+pp_nextstate
+	sets curcop = (COP*)op
diff --git a/ext/B/ramblings/flip-flop b/ext/B/ramblings/flip-flop
new file mode 100644
index 0000000000..183d541b98
--- /dev/null
+++ b/ext/B/ramblings/flip-flop
@@ -0,0 +1,51 @@
+PP(pp_range)
+{
+    if (GIMME == G_ARRAY)
+        return cCONDOP->op_true;
+    return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
+}
+
+pp_range is a CONDOP.
+In array context, it just returns op_true.
+In scalar context it checks the truth of targ and returns
+op_false if true, op_true if false.
+
+flip is an UNOP.
+It "looks after" its child which is always a pp_range CONDOP.
+In array context, it just returns the child's op_false.
+In scalar context, there are three possible outcomes:
+  (1) set child's targ to 1, our targ to 1 and return op_next.
+  (2) set child's targ to 1, our targ to 0, sp-- and return child's op_false.
+  (3) Blank targ and  TOPs and return op_next.
+Case 1 happens for a "..." with a matching lineno... or true TOPs.
+Case 2 happens for a ".." with a matching lineno... or true TOPs.
+Case 3 happens for a non-matching lineno or false TOPs.
+
+               $a = lhs..rhs;
+
+        ,------->  range
+        ^         /     \
+        |    true/       \false
+        |       /         \
+   first|     lhs        rhs
+        |      \   first   /
+        ^--- flip <----- flop
+                 \       /
+                  \     /
+                  sassign
+
+
+/* range */
+if (SvTRUE(curpad[op->op_targ]))
+    goto label(op_false);
+/* op_true */
+...
+/* flip */
+/* For "..." returns op_next. For ".." returns op_next or op_first->op_false */
+/* end of basic block */
+goto out;
+label(range op_false):
+...
+/* flop */
+out:
+...
diff --git a/ext/B/ramblings/magic b/ext/B/ramblings/magic
new file mode 100644
index 0000000000..e41930a0f0
--- /dev/null
+++ b/ext/B/ramblings/magic
@@ -0,0 +1,93 @@
+sv_magic()
+----------
+av.c
+av_store()
+	Storing a non-undef element into an SMAGICAL array, av,
+	assigns the equivalent lowercase form of magic (of the first
+	MAGIC in the chain) to the value (with obj = av, name = 0 and
+	namlen = array index).
+
+gv.c
+gv_init()
+	Initialising gv assigns '*' magic to it with obj = gv, name =
+	GvNAME and namlen = GvNAMELEN.
+gv_fetchpv()
+	@ISA gets 'I' magic with obj = gv, zero name and namlen.
+	%OVERLOAD gets 'A' magic with obj = gv, zero name and namlen.
+	$1 to $9, $&, $`, $', $+ get '\0' magic with obj = gv,
+	name = GvNAME and namlen = len ( = 1 presumably).
+Gv_AMupdate()
+	Stashes for overload magic seem to get 'c' magic with obj = 0,
+	name = &amt and namlen = sizeof(amt).
+hv_magic(hv, gv, how)
+	Gives magic how to hv with obj = gv and zero name and namlen.
+
+mg.c
+mg_copy(sv, nsv, key, klen)
+	Traverses the magic chain of sv. Upper case forms of magic
+	(only) are copied across to nsv, preserving obj but using
+	name = key and namlen = klen.
+magic_setpos()
+	LvTARG of a PVLV gets 'g' magic with obj = name = 0 and namlen = pos.
+
+op.c
+mod()
+	PVLV operators give magic to their targs with
+	obj = name = namlen = 0. OP_POS gives '.', OP_VEC gives 'v'
+	and OP_SUBSTR gives 'x'.
+
+perl.c
+magicname(sym, name, namlen)
+	Fetches/creates a GV with name sym and gives it '\0' magic
+	with obj = gv, name and namlen as passed.
+init_postdump_symbols()
+	Elements of the environment get given SVs with 'e' magic.
+	obj = sv and name and namlen point to the actual string
+	within env.
+
+pp.c
+pp_av2arylen()
+	$#foo gives '#' magic to the new SV with obj = av and
+	name = namlen = 0.
+pp_study()
+	SV gets 'g' magic with obj = name = namlen = 0.
+pp_substr()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+pp_vec()
+	PVLV gets 'x' magic with obj = name = namlen = 0.
+
+pp_hot.c
+pp_match()
+	m//g gets 'g' magic with obj = name = namlen = 0.
+
+pp_sys.c
+pp_tie()
+	sv gets magic with obj = sv and name = namlen = 0.
+	If an HV or an AV, it gets 'P' magic, otherwise 'q' magic.
+pp_dbmopen()
+	'P' magic for the HV just as with pp_tie().
+pp_sysread()
+	If tainting, the buffer SV gets 't' magic with
+	obj = name = namlen = 0.
+
+sv.c
+sv_setsv()
+	Doing sv_setsv(dstr, gv) gives '*' magic to dstr with
+	obj = dstr, name = GvNAME, namlen = GvNAMELEN.
+
+util.c
+fbm_compile()
+	The PVBM gets 'B' magic with obj = name = namlen = 0 and SvVALID
+	is set to indicate that the Boyer-Moore table is valid.
+	magic_setbm() just clears the SvVALID flag.
+
+hv_magic()
+----------
+
+gv.c
+gv_fetchfile()
+	With perldb, the HV of a gvfile gv gets 'L' magic with obj = gv.
+gv_fetchpv()
+	%SIG gets 'S' magic with obj = siggv.
+init_postdump_symbols()
+	%ENV gets 'E' magic with obj = envgv.
diff --git a/ext/B/ramblings/reg.alloc b/ext/B/ramblings/reg.alloc
new file mode 100644
index 0000000000..7fd69f2ebe
--- /dev/null
+++ b/ext/B/ramblings/reg.alloc
@@ -0,0 +1,32 @@
+while ($i--) {
+    foo();
+}
+exit
+
+    PP code			if i an int register	if i an int but not a
+				(i.e. can't be		register (i.e. can be
+				implicitly invalidated)	implicitly invalidated)
+    nextstate
+    enterloop
+
+							
+  loop:
+    gvsv  GV (0xe6078) *i	validates i		validates i
+    postdec			invalidates $i		invalidates $i
+    and if_false goto out;
+				i valid; $i invalid	i valid; $i invalid
+
+				i valid; $i invalid	i valid; $i invalid
+    nextstate
+    pushmark
+    gv  GV (0xe600c) *foo
+    entersub						validates $i; invals i
+
+    unstack
+    goto loop:
+
+				i valid; $i invalid
+  out:
+    leaveloop
+    nextstate
+    exit
diff --git a/ext/B/ramblings/runtime.porting b/ext/B/ramblings/runtime.porting
new file mode 100644
index 0000000000..4699b255cf
--- /dev/null
+++ b/ext/B/ramblings/runtime.porting
@@ -0,0 +1,350 @@
+Notes on porting the perl runtime PP engine.
+Importance: 1 = who cares?, 10 = vital
+Difficulty: 1 = trivial, 10 = very difficult. Level assumes a
+reasonable implementation of the SV and OP API already ported.
+
+OP		Import	Diff	Comments
+null		10	1
+stub		10	1
+scalar		10	1
+pushmark	10	1	PUSHMARK
+wantarray	7	3	cxstack, dopoptosub
+const		10	1	
+gvsv		10	1	save_scalar
+gv		10	1	
+gelem		3	3	
+padsv		10	2	SAVECLEARSV, provide_ref
+padav		10	2
+padhv		10	2
+padany		1	1
+pushre		7	3	pushes an op. Blech.
+rv2gv		6	5
+rv2sv		10	4
+av2arylen	7	3	sv_magic	
+rv2cv		8	5	sv_2cv
+anoncode	7	6	cv_clone
+prototype	4	4	sv_2cv
+refgen		8	3
+srefgen		8	2
+ref		8	3
+bless		7	3
+backtick	5	4
+glob		5	2	do_readline
+readline	8	2	do_readline	
+rcatline	8	2
+regcmaybe	8	1
+regcomp		8	9	pregcomp
+match		8	10
+subst		8	10
+substcont	8	7
+trans		7	4	do_trans
+sassign		10	3	mg_find, SvSETMAGIC
+aassign		10	5	
+chop		8	3	do_chop
+schop		8	3	do_chop
+chomp		8	3	do_chomp
+schomp		8	3	do_chomp
+defined		10	2
+undef		10	3
+study		4	5
+pos		8	3	PVLV, mg_find
+preinc		10	2	sv_inc, SvSETMAGIC
+i_preinc
+predec		10	2	sv_dec, SvSETMAGIC
+i_predec
+postinc		10	2	sv_dec, SvSETMAGIC
+i_postinc
+postdec		10	2	sv_dec, SvSETMAGIC
+i_postdec
+pow		10	1
+multiply	10	1
+i_multiply	10	1
+divide		10	2
+i_divide	10	1
+modulo		10	2
+i_modulo	10	1
+repeat		6	4
+add		10	1
+i_add		10	1
+subtract	10	1
+i_subtract	10	1
+concat		10	2	mg_get
+stringify	10	2	sv_setpvn
+left_shift	10	1
+right_shift	10	1
+lt		10	1
+i_lt		10	1
+gt		10	1
+i_gt		10	1
+le		10	1
+i_le		10	1
+ge		10	1
+i_ge		10	1
+eq		10	1
+i_eq		10	1
+ne		10	1
+i_ne		10	1
+ncmp		10	1
+i_ncmp		10	1
+slt		10	2
+sgt		10	2
+sle		10	2
+sge		10	2
+seq		10	2	sv_eq
+sne		10	2
+scmp		10	2
+bit_and		10	2
+bit_xor		10	2
+bit_or		10	2
+negate		10	3
+i_negate	10	1
+not		10	1
+complement	10	3
+atan2		6	1
+sin		6	1
+cos		6	1
+rand		5	2
+srand		5	2
+exp		6	1
+log		6	2
+sqrt		6	2
+int		10	2
+hex		9	2
+oct		9	2
+abs		10	1
+length		10	1
+substr		10	4	PVLV
+vec		5	4
+index		9	3
+rindex		9	3
+sprintf		9	4	do_sprintf
+formline	6	7
+ord		6	2	
+chr		6	2
+crypt		3	2
+ucfirst		6	2
+lcfirst		6	2
+uc		6	2
+lc		6	2
+quotemeta	6	3
+rv2av		10	3	save_svref, mg_get, save_ary
+aelemfast	10	2	av_fetch
+aelem		10	3
+aslice		9	4
+each		10	3	hv_iternext
+values		10	3	do_kv
+keys		10	3	do_kv
+delete		10	3
+exists		10	3
+rv2hv		10	3	save_svref, mg_get, save_ary, do_kv
+helem		10	3	save_svref, provide_ref
+hslice		9	4
+unpack		9	6	lengthy
+pack		9	6	lengthy
+split		9	9
+join		10	4	do_join
+list		10	2
+lslice		9	4
+anonlist	10	2
+anonhash	10	3
+splice		9	6
+push		10	2
+pop		10	2
+shift		10	2
+unshift		10	2
+sort		6	7
+reverse		9	4
+grepstart	6	5	modifies flow of control
+grepwhile	6	5	modifies flow of control
+mapstart	1	1
+mapwhile	6	5	modifies flow of control
+range		7	3	modifies flow of control
+flip		7	4	modifies flow of control
+flop		7	4	modifies flow of control
+and		10	3	modifies flow of control
+or		10	3	modifies flow of control
+xor
+cond_expr	10	3	modifies flow of control
+andassign	7	3	modifies flow of control
+orassign	7	3	modifies flow of control
+method		8	5
+entersub	10	7
+leavesub	10	5
+caller		2	8
+warn		9	3
+die		9	3
+reset		2	2
+lineseq		1	1
+nextstate	10	1	Update stack_sp from cxstack. FREETMPS.
+dbstate		3	7		
+unstack
+enter		10	3	cxstack, ENTER, SAVETMPS, PUSHBLOCK
+leave		10	3	cxstack, SAVETMPS, LEAVE, POPBLOCK
+scope		1	1
+enteriter	9	4	cxstack
+iter		9	3	cxstack
+enterloop	10	4
+leaveloop	10	4
+return		10	5
+last		9	6
+next		9	6
+redo		9	6
+dump		1	9	pp_goto
+goto		6	9
+exit		9	2	my_exit
+open		9	5	do_open
+close		9	3	do_close
+pipe_op		7	4
+fileno		9	2
+umask		4	2
+binmode		4	2
+tie		5	5	pp_entersub
+untie		5	2	sv_unmagic
+tied		5	2
+dbmopen		4	5
+dbmclose	4	2
+sselect		4	4
+select		7	3
+getc		7	2
+read		8	2	pp_sysread
+enterwrite	4	4	doform
+leavewrite	4	5
+prtf		4	4	do_sprintf
+print		8	6
+sysopen		8	2
+sysread		8	4
+syswrite	8	4	pp_send
+send		8	4
+recv		8	4	pp_sysread
+eof		9	2
+tell		9	3
+seek		9	2
+truncate	8	3
+fcntl		8	4	pp_ioctl
+ioctl		8	4
+flock		8	2
+socket		5	3
+sockpair	5	3
+bind		5	3
+connect		5	3
+listen		5	3
+accept		5	3
+shutdown	5	2
+gsockopt	5	3	pp_ssockopt
+ssockopt	5	3
+getsockname	5	3	pp_getpeername
+getpeername	5	3
+lstat		5	4	pp_stat
+stat		5	4	lengthy
+ftrread		5	2	cando
+ftrwrite	5	2	cando
+ftrexec		5	2	cando
+fteread		5	2	cando
+ftewrite	5	2	cando
+fteexec		5	2	cando
+ftis		5	2	cando
+fteowned	5	2	cando
+ftrowned	5	2	cando
+ftzero		5	2	cando
+ftsize		5	2	cando
+ftmtime		5	2	cando
+ftatime		5	2	cando
+ftctime		5	2	cando
+ftsock		5	2	cando
+ftchr		5	2	cando
+ftblk		5	2	cando
+ftfile		5	2	cando
+ftdir		5	2	cando
+ftpipe		5	2	cando
+ftlink		5	2	cando
+ftsuid		5	2	cando
+ftsgid		5	2	cando
+ftsvtx		5	2	cando
+fttty		5	2	cando
+fttext		5	4
+ftbinary	5	4	fttext
+chdir
+chown
+chroot
+unlink
+chmod
+utime
+rename
+link
+symlink
+readlink
+mkdir
+rmdir
+open_dir
+readdir
+telldir
+seekdir
+rewinddir
+closedir
+fork
+wait
+waitpid
+system
+exec
+kill
+getppid
+getpgrp
+setpgrp
+getpriority
+setpriority
+time
+tms
+localtime
+gmtime
+alarm
+sleep
+shmget
+shmctl
+shmread
+shmwrite
+msgget
+msgctl
+msgsnd
+msgrcv
+semget
+semctl
+semop
+require		6	9	doeval
+dofile		6	9	doeval
+entereval	6	9	doeval
+leaveeval	6	5
+entertry	7	4	modifies flow of control
+leavetry	7	3
+ghbyname
+ghbyaddr
+ghostent
+gnbyname
+gnbyaddr
+gnetent
+gpbyname
+gpbynumber
+gprotoent
+gsbyname
+gsbyport
+gservent
+shostent
+snetent
+sprotoent
+sservent
+ehostent
+enetent
+eprotoent
+eservent
+gpwnam
+gpwuid
+gpwent
+spwent
+epwent
+ggrnam
+ggrgid
+ggrent
+sgrent
+egrent
+getlogin
+syscall
+	
+\ No newline at end of file
diff --git a/ext/B/typemap b/ext/B/typemap
new file mode 100644
index 0000000000..7206a6a2e1
--- /dev/null
+++ b/ext/B/typemap
@@ -0,0 +1,69 @@
+TYPEMAP
+
+B::OP		T_OP_OBJ
+B::UNOP		T_OP_OBJ
+B::BINOP	T_OP_OBJ
+B::LOGOP	T_OP_OBJ
+B::CONDOP	T_OP_OBJ
+B::LISTOP	T_OP_OBJ
+B::PMOP		T_OP_OBJ
+B::SVOP		T_OP_OBJ
+B::GVOP		T_OP_OBJ
+B::PVOP		T_OP_OBJ
+B::CVOP		T_OP_OBJ
+B::LOOP		T_OP_OBJ
+B::COP		T_OP_OBJ
+
+B::SV		T_SV_OBJ
+B::PV		T_SV_OBJ
+B::IV		T_SV_OBJ
+B::NV		T_SV_OBJ
+B::PVMG		T_SV_OBJ
+B::PVLV		T_SV_OBJ
+B::BM		T_SV_OBJ
+B::RV		T_SV_OBJ
+B::GV		T_SV_OBJ
+B::CV		T_SV_OBJ
+B::HV		T_SV_OBJ
+B::AV		T_SV_OBJ
+B::IO		T_SV_OBJ
+
+B::MAGIC	T_MG_OBJ
+SSize_t		T_IV
+STRLEN		T_IV
+
+INPUT
+T_OP_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_SV_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+T_MG_OBJ
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+
+OUTPUT
+T_OP_OBJ
+	sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var);
+
+T_SV_OBJ
+	make_sv_object(($arg), (SV*)($var));
+
+
+T_MG_OBJ
+	sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)$var);
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 91b4dc2ad5..b6da38609d 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -533,6 +533,14 @@ DB_File db ;
     DBT_flags(key) ;
     DBT_flags(value) ;
     RETVAL = do_SEQ(db, key, value, R_LAST) ;
+    if (RETVAL < 0 && errno == EBADF)
+     {                
+      recno_t oops = -1;
+      key.data = &oops; 
+      key.size = sizeof(oops);
+      db_get(db, key, value, 0);
+      RETVAL = do_SEQ(db, key, value, R_LAST) ;
+     }
     if (RETVAL == 0)
         RETVAL = *(I32 *)key.data ;
     else /* No key means empty file */
diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm
index 48ca3047b9..cf7069c45d 100644
--- a/ext/Thread/Thread.pm
+++ b/ext/Thread/Thread.pm
@@ -8,6 +8,38 @@ $VERSION = "1.0";
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
 
+=head1 NAME
+
+Thread - multithreading
+
+=head1 SYNOPSIS
+
+    use Thread;
+
+    my $t = new Thread \&start_sub, @start_args;
+
+    $t->join;
+
+    my $tid = Thread->self->tid; 
+
+    my $tlist = Thread->list;
+
+    lock($scalar);
+
+    use Thread 'async';
+
+    use Thread 'eval';
+
+=head1 DESCRIPTION
+
+The C<Threads> module provides multithreading.
+
+=head1 SEE ALSO
+
+L<attrs>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>.
+
+=cut
+
 #
 # Methods
 #
diff --git a/ext/Thread/Thread/Queue.pm b/ext/Thread/Thread/Queue.pm
index 4eef978bd6..9821773aa4 100644
--- a/ext/Thread/Thread/Queue.pm
+++ b/ext/Thread/Thread/Queue.pm
@@ -1,6 +1,19 @@
 package Thread::Queue;
 use Thread qw(cond_wait cond_broadcast);
 
+=head1 NAME
+
+Thread::Queue - thread-safe queues
+
+=head1 SYNOPSIS
+
+    use Thread::Queue;
+    my $q = new Thread::Queue;
+    $q->enqueue("foo", "bar");
+    my $foo = $q->dequeue;	# The "bar" is still in the queue.
+
+=cut
+
 sub new {
     my $class = shift;
     return bless [@_], $class;
diff --git a/ext/Thread/Thread/Semaphore.pm b/ext/Thread/Thread/Semaphore.pm
index 9e5852f15c..4e1bb7ddbc 100644
--- a/ext/Thread/Thread/Semaphore.pm
+++ b/ext/Thread/Thread/Semaphore.pm
@@ -1,6 +1,25 @@
 package Thread::Semaphore;
 use Thread qw(cond_wait cond_broadcast);
 
+=head1 NAME
+
+Thread::Semaphore - thread-safe semaphores
+
+=head1 SYNOPSIS
+
+    use Thread::Semaphore;
+    my $s = new Thread::Semaphore;
+    $s->up;	# Also known as the semaphore V -operation.
+    # The guarded section is here
+    $s->down;	# Also known as the semaphore P -operation.
+
+    # The default semaphore value is 1.
+    my $s = new Thread::Semaphore($initial_value);
+    $s->up($up_value);
+    $s->down($up_value);
+
+=cut
+
 sub new {
     my $class = shift;
     my $val = @_ ? shift : 1;
diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm
index ec56539e40..c3591f4b94 100644
--- a/ext/Thread/Thread/Specific.pm
+++ b/ext/Thread/Thread/Specific.pm
@@ -1,5 +1,16 @@
 package Thread::Specific;
 
+=head1 NAME
+
+Thread::Specific - thread-specific keys
+
+=head1 SYNOPSIS
+
+    use Thread::Specific;
+    my $k = key_create Thread::Specific;
+
+=cut
+
 sub import {
     use attrs qw(locked method);
     require fields;
diff --git a/global.sym b/global.sym
index b83f6d401d..1e2ada5a7e 100644
--- a/global.sym
+++ b/global.sym
@@ -337,6 +337,7 @@ gv_init
 gv_stashpv
 gv_stashpvn
 gv_stashsv
+hexdigit
 hv_clear
 hv_delayfree_ent
 hv_delete
diff --git a/hints/bsdos.sh b/hints/bsdos.sh
index 53adfa3b50..7c7c6e9565 100644
--- a/hints/bsdos.sh
+++ b/hints/bsdos.sh
@@ -69,7 +69,7 @@ case "$osvers" in
 	'')	cc='gcc2' ;;
 	esac
 	;;
-2.0*|2.1*|3.0*)
+2.0*|2.1*|3.0*|3.1*)
 	so='o'
 
 	# default to GCC 2.X w/shared libraries
@@ -88,22 +88,4 @@ case "$osvers" in
 	libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted"
 	libswanted="rpc curses termcap $libswanted"
 	;;
-3.1*)
-	# ELF dynamic link libraries starting in 3.1
-        useshrplib='true'
-	so='so'
-	dlext='so'
-
-	case "$cc" in
-	'')	cc='cc'			# cc is gcc2 in 3.1
-		cccdlflags="-fPIC"
-		ccdlflags=" " ;;
-	esac
-
-	case "$ld" in
-	'')	ld='ld'
-		lddlflags="-shared -x $lddlflags" ;;
-	esac
-	;;
 esac
-
diff --git a/hints/irix_6.sh b/hints/irix_6.sh
index 72cc2c61db..6d22d524b0 100644
--- a/hints/irix_6.sh
+++ b/hints/irix_6.sh
@@ -116,6 +116,10 @@ set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /'
 shift
 libswanted="$*"
 
+# Perl 5.004_57 introduced new qsort code into pp_ctl.c that
+# makes IRIX 6.2 cc to emit bad code.
+pp_ctl_cflags='optimize=-O'
+
 if [ "X$usethreads" != "X" ]; then
     if test ! -f /usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then
 	uname_r=`uname -r`
@@ -154,7 +158,7 @@ EOF
 	    exit 1
 	    ;;
 	esac
-	unset uname-r
+	unset uname_r
     fi
     ccflags="-DUSE_THREADS $ccflags"
     cppflags="-DUSE_THREADS $cppflags"
@@ -166,4 +170,5 @@ EOF
     ld="cc"
     shift
     libswanted="$*"
+    usemymalloc='n'
 fi
diff --git a/hints/next_3.sh b/hints/next_3.sh
index 55e89591d8..542a313a11 100644
--- a/hints/next_3.sh
+++ b/hints/next_3.sh
@@ -72,7 +72,7 @@ cccdlflags=' '
 # If you want to build for specific architectures, change the line
 # below to something like
 #
-#	archs=(m68k i386)
+#	archs='m68k i386'
 #
 archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
 
@@ -99,6 +99,8 @@ ld='cc'
 i_utime='undef'
 groupstype='int'
 direntrytype='struct direct'
+netdb_host_type='char *'
+netdb_hlen_type='int'
 d_strcoll='undef'
 d_uname='define'
 #
diff --git a/hints/next_4.sh b/hints/next_4.sh
index 316b339212..d34400200b 100644
--- a/hints/next_4.sh
+++ b/hints/next_4.sh
@@ -33,7 +33,7 @@ ld='cc'
 # If you want to build for specific architectures, change the line
 # below to something like
 #
-#	archs=(m68k i386)
+#	archs='m68k i386'
 #
 archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
 
@@ -83,6 +83,8 @@ i_dbm='define'
 i_utime='undef'
 groupstype='int'
 direntrytype='struct direct'
+netdb_host_type='const char *'
+netdb_hlen_type='int'
 
 usemymalloc='y'
 clocktype='int'
diff --git a/installperl b/installperl
index 150b334f8c..6197e92b1d 100755
--- a/installperl
+++ b/installperl
@@ -158,6 +158,16 @@ foreach $file (@corefiles) {
 		   "$installarchlib/CORE/$file");
 }
 
+# Install main perl executables
+# Make links to ordinary names if installbin directory isn't current directory.
+
+if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
+    safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
+    link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
+    link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
+      if $d_dosuid;
+}
+
 # Offer to install perl in a "standard" location
 
 $mainperl_is_instperl = 0;
@@ -195,13 +205,6 @@ if (!$versiononly && !$nonono && $^O ne 'MSWin32' && -t STDIN && -t STDERR
 
 # Make links to ordinary names if installbin directory isn't current directory.
 
-if (! $versiononly && ! samepath($installbin, '.') && ($^O ne 'dos')) {
-    safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
-    link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
-    link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
-      if $d_dosuid;
-}
-
 if (!$versiononly && ! samepath($installbin, 'x2p')) {
     safe_unlink("$installbin/a2p$exe_ext");
     copy("x2p/a2p$exe_ext", "$installbin/a2p$exe_ext");
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
index d03c1b6680..8ff3e8964b 100644
--- a/lib/Pod/Html.pm
+++ b/lib/Pod/Html.pm
@@ -770,13 +770,15 @@ sub scan_headings {
 	    chomp($title);
 	    $$sections{htmlify(0,$title)} = 1;
 
-	    if ($which_head > $listdepth) {
-		$index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
-	    } elsif ($which_head < $listdepth) {
-		$listdepth--;
-		$index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+	    while ($which_head != $listdepth) {
+		if ($which_head > $listdepth) {
+		    $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+		    $listdepth++;
+		} elsif ($which_head < $listdepth) {
+		    $listdepth--;
+		    $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+		}
 	    }
-	    $listdepth = $which_head;
 
 	    $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
 	              "<A HREF=\"#" . htmlify(0,$title) . "\">" .
@@ -1116,7 +1118,7 @@ sub process_text {
 	# parse through the string, stopping each time we find a
 	# pod-escape.  once the string has been throughly processed
 	# we can output it.
-	while ($rest) {
+	while (length $rest) {
 	    # check to see if there are any possible pod directives in
 	    # the remaining part of the text.
 	    if ($rest =~ m/[BCEIFLSZ]</) {
diff --git a/lib/Test.pm b/lib/Test.pm
new file mode 100644
index 0000000000..7e79da2bf4
--- /dev/null
+++ b/lib/Test.pm
@@ -0,0 +1,134 @@
+use strict;
+package Test;
+use Test::Harness 1.1601 ();
+use Carp;
+use vars qw($VERSION @ISA @EXPORT $ntest %todo);
+$VERSION = '0.06';
+require Exporter;
+@ISA=('Exporter');
+@EXPORT= qw(&plan &ok &skip $ntest);
+
+$|=1;
+#$^W=1;  ?
+$ntest=1;
+
+# Use of this variable is strongly discouraged.  It is set
+# exclusively for test coverage analyzers.
+$ENV{REGRESSION_TEST} = $0;
+
+sub plan {
+    croak "Test::plan(%args): odd number of arguments" if @_ & 1;
+    my $max=0;
+    for (my $x=0; $x < @_; $x+=2) {
+	my ($k,$v) = @_[$x,$x+1];
+	if ($k =~ /^test(s)?$/) { $max = $v; }
+	elsif ($k eq 'todo' or 
+	       $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
+	else { carp "Test::plan(): skipping unrecognized directive '$k'" }
+    }
+    my @todo = sort { $a <=> $b } keys %todo;
+    if (@todo) {
+	print "1..$max todo ".join(' ', @todo).";\n";
+    } else {
+	print "1..$max\n";
+    }
+}
+
+sub ok {
+    my ($ok, $guess) = @_;
+    carp "(this is ok $ntest)" if defined $guess && $guess != $ntest;
+    $ok = $ok->() if (ref $ok or '') eq 'CODE';
+    if ($ok) {
+	if ($todo{$ntest}) {
+	    print("ok $ntest # Wow!\n");
+	} else {
+	    print("ok $ntest # (failure expected)\n");
+	}
+    } else {
+	print("not ok $ntest\n");
+    }
+    ++ $ntest;
+    $ok;
+}
+
+sub skip {
+    my ($toskip, $ok, $guess) = @_;
+    carp "(this is skip $ntest)" if defined $guess && $guess != $ntest;
+    $toskip = $toskip->() if (ref $toskip or '') eq 'CODE';
+    if ($toskip) {
+	print "ok $ntest # skip\n";
+	++ $ntest;
+	1;
+    } else {
+	ok($ok);
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+  Test - provides a simple framework for writing test scripts
+
+=head1 SYNOPSIS
+
+  use strict;
+  use Test;
+  BEGIN { plan tests => 5, todo => [3,4] }
+
+  ok(0); #failure
+  ok(1); #success
+
+  ok(0); #ok, expected failure (see todo above)
+  ok(1); #surprise success!
+
+  skip($feature_is_missing, sub {...});    #do platform specific test
+
+=head1 DESCRIPTION
+
+Test::Harness expects to see particular output when it executes test
+scripts.  This module tries to make conforming just a little bit
+easier (and less error prone).
+
+=head1 TEST CATEGORIES
+
+=over 4
+
+=item * NORMAL TESTS
+
+These tests are expected to succeed.  If they don't, something is
+wrong!
+
+=item * SKIPPED TESTS
+
+C<skip> should be used to skip tests for which a platform specific
+feature isn't available.
+
+=item * TODO TESTS
+
+TODO tests are designed for the purpose of maintaining an executable
+TODO list.  These tests are expected NOT to succeed (otherwise the
+feature they test would be on the new feature list, not the TODO
+list).
+
+Packages should NOT be released with successful TODO tests.  As soon
+as a TODO test starts working, it should be promoted to a normal test
+and the new feature should be documented in the release notes.
+
+=back
+
+=head1 SEE ALSO
+
+L<Test::Harness> and various test coverage analysis tools.
+
+=head1 AUTHOR
+
+Copyright � 1998 Joshua Nathaniel Pritikin.  All rights reserved.
+
+This package is free software and is provided "as is" without express
+or implied warranty.  It may be used, redistributed and/or modified
+under the terms of the Perl Artistic License (see
+http://www.perl.com/perl/misc/Artistic.html)
+
+=cut
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 37f4a9fbde..8102ff4cac 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
 	    @ISA @EXPORT @EXPORT_OK);
 $have_devel_corestack = 0;
 
-$VERSION = "1.1502";
+$VERSION = "1.1601";
 
 @ISA=('Exporter');
 @EXPORT= qw(&runtests);
@@ -43,7 +43,7 @@ $switches = "-w";
 sub runtests {
     my(@tests) = @_;
     local($|) = 1;
-    my($test,$te,$ok,$next,$max,$pct,$totok,@failed,%failedtests);
+    my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests);
     my $totmax = 0;
     my $files = 0;
     my $bad = 0;
@@ -73,12 +73,20 @@ sub runtests {
 	$fh->open($cmd) or print "can't run $test. $!\n";
 	$ok = $next = $max = 0;
 	@failed = ();
+	my %todo = ();
+        my $bonus = 0;
 	my $skipped = 0;
 	while (<$fh>) {
 	    if( $verbose ){
 		print $_;
 	    }
-	    if (/^1\.\.([0-9]+)/) {
+	    if (/^1\.\.([0-9]+) todo([\d\s]+)\;/) {
+		$max = $1;
+		for (split(/\s+/, $2)) { $todo{$_} = 1; }
+		$totmax += $max;
+		$files++;
+		$next = 1;
+	    } elsif (/^1\.\.([0-9]+)/) {
 		$max = $1;
 		$totmax += $max;
 		$files++;
@@ -87,12 +95,18 @@ sub runtests {
 		my $this = $next;
 		if (/^not ok\s*(\d*)/){
 		    $this = $1 if $1 > 0;
-		    push @failed, $this;
+		    if (!$todo{$this}) {
+			push @failed, $this;
+		    } else {
+			$ok++;
+			$totok++;
+		    }
 		} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
 		    $this = $1 if $1 > 0;
 		    $ok++;
 		    $totok++;
 		    $skipped++ if defined $2;
+		    $bonus++, $totbonus++ if $todo{$this};
 		}
 		if ($this > $next) {
 		    # warn "Test output counter mismatch [test $this]\n";
@@ -144,9 +158,14 @@ sub runtests {
 				    estat => $estatus, wstat => $wstatus,
 				  };
 	} elsif ($ok == $max && $next == $max+1) {
-	    if ($max and $skipped) {
-	        my $ender = 's' x ($skipped > 1);
-		print "ok, $skipped subtest$ender skipped on this platform\n";
+	    if ($max and $skipped + $bonus) {
+		my @msg;
+		push(@msg, "$skipped subtest".($skipped>1?'s':'')." skipped")
+		    if $skipped;
+		push(@msg, "$bonus subtest".($bonus>1?'s':'').
+		     " unexpectedly succeeded")
+		    if $bonus;
+		print "ok, ".join(', ', @msg)."\n";
 	    } elsif ($max) {
 		print "ok\n";
 	    } else {
@@ -193,8 +212,12 @@ sub runtests {
 	    delete $ENV{PERL5LIB};
 	}
     }
+    my $bonusmsg = '';
+    $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':'').
+	       " UNEXPECTEDLY SUCCEEDED)")
+	if $totbonus;
     if ($bad == 0 && $totmax) {
-	    print "All tests successful.\n";
+	print "All tests successful$bonusmsg.\n";
     } elsif ($total==0){
 	die "FAILED--no tests were run for some reason.\n";
     } elsif ($totmax==0) {
@@ -289,6 +312,10 @@ runtests(@tests);
 
 =head1 DESCRIPTION
 
+(By using the L<Test> module, you can write test scripts without
+knowing the exact output this module expects.  However, if you need to
+know the specifics, read on!)
+
 Perl test scripts print to standard output C<"ok N"> for each single
 test, where C<N> is an increasing sequence of integers. The first line
 output by a standard test script is C<"1..M"> with C<M> being the
@@ -372,7 +399,8 @@ above messages.
 
 =head1 SEE ALSO
 
-See L<Benchmark> for the underlying timing routines.
+L<Test> for writing test scripts and also L<Benchmark> for the
+underlying timing routines.
 
 =head1 AUTHORS
 
diff --git a/lib/fields.pm b/lib/fields.pm
index 8e2d6398bb..c2cf1d6a5d 100644
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -1,5 +1,28 @@
 package fields;
 
+=head1 NAME
+
+fields - compile-time class fields
+
+=head1 SYNOPSIS
+
+    {
+        package Foo;
+        use fields qw(foo bar baz);
+    }
+    ...
+    my Foo $var = new Foo;
+    $var->{foo} = 42;
+
+    # This will generate a compile-time error.
+    $var->{zap} = 42;
+
+=head1 DESCRIPTION
+
+The C<fields> pragma enables compile-time verified class fields.
+
+=cut
+
 sub import {
     my $class = shift;
     my ($package) = caller;
diff --git a/malloc.c b/malloc.c
index cc1e376563..6f8f548f1e 100644
--- a/malloc.c
+++ b/malloc.c
@@ -777,7 +777,7 @@ static long Perl_sbrk_oldsize;
 #   define PERLSBRK_32_K (1<<15)
 #   define PERLSBRK_64_K (1<<16)
 
-char *
+Malloc_t
 Perl_sbrk(size)
 int size;
 {
diff --git a/op.c b/op.c
index fae24f82ca..c0b1124d30 100644
--- a/op.c
+++ b/op.c
@@ -4830,6 +4830,8 @@ peep(register OP *o)
 	case OP_AND:
 	case OP_OR:
 	    o->op_seq = op_seqmax++;
+	    while (cLOGOP->op_other->op_type == OP_NULL)
+		cLOGOP->op_other = cLOGOP->op_other->op_next;
 	    peep(cLOGOP->op_other);
 	    break;
 
diff --git a/patchlevel.h b/patchlevel.h
index 9ac7aa290a..fceaa3f595 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 4
-#define SUBVERSION 59
+#define SUBVERSION 60
 
 /*
 	local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.c b/perl.c
index 363d039cdc..d8270b78e8 100644
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-1997 Larry Wall
+ *    Copyright (c) 1987-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.
@@ -1705,7 +1705,7 @@ moreswitches(char *s)
 		LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
 #endif
 
-	printf("\n\nCopyright 1987-1997, Larry Wall\n");
+	printf("\n\nCopyright 1987-1998, Larry Wall\n");
 #ifdef MSDOS
 	printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
 #endif
@@ -1715,7 +1715,7 @@ moreswitches(char *s)
 #endif
 #ifdef OS2
 	printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
-	    "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n");
+	    "Version 5 port Copyright (c) 1994-1998, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
 #ifdef atarist
 	printf("atariST series port, ++jrb  bammi@cadence.com\n");
@@ -2896,6 +2896,7 @@ init_main_thread()
     sv_setpvn(bodytarget, "", 0);
     formtarget = bodytarget;
     thr->errsv = newSVpv("", 0);
+    (void) find_threadsv("@");	/* Ensure $@ is initialised early */
     return thr;
 }
 #endif /* USE_THREADS */
diff --git a/perl.h b/perl.h
index 190fe0ad5b..1858803c82 100644
--- a/perl.h
+++ b/perl.h
@@ -145,6 +145,10 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 # define DONT_DECLARE_STD 1
 #endif
 
+#if defined(NeXT) && !defined(_POSIX_SOURCE)
+#   define MISSING_PID_T
+#endif
+
 #if defined(HASVOLATILE) || defined(STANDARD_C)
 #   ifdef __cplusplus
 #	define VOL		// to temporarily suppress warnings
@@ -161,6 +165,10 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 #define TAINT_ENV()	if (tainting) { taint_env(); }
 #define TAINT_PROPER(s)	if (tainting) { taint_proper(no_security, s); }
 
+#ifdef MISSING_PID_T
+typedef int pid_t;
+#endif
+
 /* XXX All process group stuff is handled in pp_sys.c.  Should these 
    defines move there?  If so, I could simplify this a lot. --AD  9/96.
 */
diff --git a/pod/buildtoc b/pod/buildtoc
index d657d68c84..bd880c379d 100644
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -12,6 +12,7 @@ sub output ($);
 	   perllol perltoot perlobj perltie perlbot perlipc perldebug
 	   perldiag perlsec perltrap perlstyle perlpod perlbook
 	   perlembed perlapio perlxs perlxstut perlguts perlcall
+	   perlhist
 	  );
 
 for (@pods) { s/$/.pod/ }
@@ -171,7 +172,7 @@ sub podset {
 	    output $_; nl(); next;
 
 	}
-	if (s/^=item (.*)\n/$1/) {
+	if (s/^=item ([^=].*)\n/$1/) {
 	    next if $pod eq 'perldiag';
 	    s/^\s*\*\s*$// && next;
 	    s/^\s*\*\s*//;
diff --git a/pod/perl.pod b/pod/perl.pod
index e989ebaacf..41481a3bc4 100644
--- a/pod/perl.pod
+++ b/pod/perl.pod
@@ -60,6 +60,8 @@ of sections:
     perlguts	Perl internal functions for those doing extensions
     perlcall	Perl calling conventions from C
 
+    perlhist	Perl history records
+
 (If you're intending to read these straight through for the first time,
 the suggested order will tend to reduce the number of forward references.)
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 6802b08ac5..4ed7041cd1 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2802,6 +2802,27 @@ variables.
 of Perl.  Check the #! line, or manually feed your script into
 Perl yourself.
 
+=item perl: warning: Setting locale failed.
+
+(S) The whole warning message will look something like:
+
+	perl: warning: Setting locale failed.
+	perl: warning: Please check that your locale settings:
+	        LC_ALL = "En_US",
+	        LANG = (unset)
+	    are supported and installed on your system.
+	perl: warning: Falling back to the standard locale ("C").
+
+Exactly what were the failed locale settings varies.  In the above the
+settings were that the LC_ALL was "En_US" and the LANG had no value.
+This error means that Perl detected that you and/or your system
+administrator have set up the so-called variable system but Perl could
+not use those settings.  This was not dead serious, fortunately: there
+is a "default locale" called "C" that Perl can and will use, the
+script will be run.  Before you really fix the problem, however, you
+will get the same error message each time you run Perl.  How to really
+fix the problem can be found in L<perllocale> section B<LOCALE PROBLEMS>.
+
 =item Warning: something's wrong
 
 (W) You passed warn() an empty string (the equivalent of C<warn "">) or
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 111baf0899..4ef8c22713 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1417,13 +1417,11 @@ are subject to the same restrictions as in the pass 2.
 This is a listing of functions, macros, flags, and variables that may be
 useful to extension writers or that may be found while reading other
 extensions.
+The sort order of the listing is case insensitive, with any
+occurrences of '_' ignored for the the purpose of sorting.
 
 =over 8
 
-=item AvFILL
-
-Same as C<av_len>.
-
 =item av_clear
 
 Clears an array, making it empty.  Does not free the memory used by the
@@ -1449,6 +1447,10 @@ information on how to use this function on tied arrays.
 
 	SV**	av_fetch (AV* ar, I32 key, I32 lval)
 
+=item AvFILL
+
+Same as C<av_len>.
+
 =item av_len
 
 Returns the highest index in the array.  Returns -1 if the array is empty.
@@ -1523,7 +1525,7 @@ The XSUB-writer's interface to the C C<memcpy> function.  The C<s> is the
 source, C<d> is the destination, C<n> is the number of items, and C<t> is
 the type.  May fail on overlapping copies.  See also C<Move>.
 
-	(void) Copy( s, d, n, t )
+	void	Copy( s, d, n, t )
 
 =item croak
 
@@ -1534,7 +1536,7 @@ function the same way you use the C C<printf> function.  See C<warn>.
 
 Returns the stash of the CV.
 
-	HV * CvSTASH( SV* sv )
+	HV*	CvSTASH( SV* sv )
 
 =item DBsingle
 
@@ -1598,6 +1600,22 @@ Used to extend the argument stack for an XSUB's return values.
 
 	EXTEND( sp, int x )
 
+=item fbm_compile
+
+Analyses the string in order to make fast searches on it using fbm_instr() --
+the Boyer-Moore algorithm.
+
+	void	fbm_compile(SV* sv)
+
+=item fbm_instr
+
+Returns the location of the SV in the string delimited by C<str> and
+C<strend>.  It returns C<Nullch> if the string can't be found.  The
+C<sv> does not have to be fbm_compiled, but the search will not be as
+fast then.
+
+	char*	fbm_instr(char *str, char *strend, SV *sv)
+
 =item FREETMPS
 
 Closing bracket for temporaries on a callback.  See C<SAVETMPS> and
@@ -1637,10 +1655,6 @@ Indicates that no arguments are being sent to a callback.  See L<perlcall>.
 
 Used to indicate scalar context.  See C<GIMME_V>, C<GIMME>, and L<perlcall>.
 
-=item G_VOID
-
-Used to indicate void context.  See C<GIMME_V> and L<perlcall>.
-
 =item gv_fetchmeth
 
 Returns the glob with the given C<name> and a defined subroutine or
@@ -1692,6 +1706,10 @@ C<perl_call_sv> apply equally to these functions.
         GV*     gv_fetchmethod (HV* stash, char* name)
         GV*     gv_fetchmethod_autoload (HV* stash, char* name, I32 autoload)
 
+=item G_VOID
+
+Used to indicate void context.  See C<GIMME_V> and L<perlcall>.
+
 =item gv_stashpv
 
 Returns a pointer to the stash for a specified package.  If C<create> is set
@@ -1718,9 +1736,9 @@ C<char*> pointer is to be expected. (For information only--not to be used).
 
 =item HeHASH
 
-Returns the computed hash (type C<U32>) stored in the hash entry.
+Returns the computed hash stored in the hash entry.
 
-	HeHASH(HE* he)
+	U32	HeHASH(HE* he)
 
 =item HeKEY
 
@@ -1729,7 +1747,7 @@ The pointer may be either C<char*> or C<SV*>, depending on the value of
 C<HeKLEN()>.  Can be assigned to.  The C<HePV()> or C<HeSVKEY()> macros
 are usually preferable for finding the value of a key.
 
-	HeKEY(HE* he)
+	char*	HeKEY(HE* he)
 
 =item HeKLEN
 
@@ -1738,7 +1756,7 @@ holds an C<SV*> key.  Otherwise, holds the actual length of the key.
 Can be assigned to. The C<HePV()> macro is usually preferable for finding
 key lengths.
 
-	HeKLEN(HE* he)
+	int	HeKLEN(HE* he)
 
 =item HePV
 
@@ -1752,7 +1770,7 @@ or similar is not a good way to find the length of hash keys.
 This is very similar to the C<SvPV()> macro described elsewhere in
 this document.
 
-	HePV(HE* he, STRLEN len)
+	char*	HePV(HE* he, STRLEN len)
 
 =item HeSVKEY
 
@@ -1899,7 +1917,7 @@ Returns entries from a hash iterator.  See C<hv_iterinit>.
 Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
 operation.
 
-	SV *	hv_iternextsv (HV* hv, char** key, I32* retlen)
+	SV*	hv_iternextsv (HV* hv, char** key, I32* retlen)
 
 =item hv_iterval
 
@@ -1918,7 +1936,7 @@ Adds magic to a hash.  See C<sv_magic>.
 
 Returns the package name of a stash.  See C<SvSTASH>, C<CvSTASH>.
 
-	char *HvNAME (HV* stash)
+	char*	HvNAME (HV* stash)
 
 =item hv_store
 
@@ -1964,38 +1982,38 @@ Undefines the hash.
 Returns a boolean indicating whether the C C<char> is an ascii alphanumeric
 character or digit.
 
-	int isALNUM (char c)
+	int	isALNUM (char c)
 
 =item isALPHA
 
 Returns a boolean indicating whether the C C<char> is an ascii alphabetic
 character.
 
-	int isALPHA (char c)
+	int	isALPHA (char c)
 
 =item isDIGIT
 
 Returns a boolean indicating whether the C C<char> is an ascii digit.
 
-	int isDIGIT (char c)
+	int	isDIGIT (char c)
 
 =item isLOWER
 
 Returns a boolean indicating whether the C C<char> is a lowercase character.
 
-	int isLOWER (char c)
+	int	isLOWER (char c)
 
 =item isSPACE
 
 Returns a boolean indicating whether the C C<char> is whitespace.
 
-	int isSPACE (char c)
+	int	isSPACE (char c)
 
 =item isUPPER
 
 Returns a boolean indicating whether the C C<char> is an uppercase character.
 
-	int isUPPER (char c)
+	int	isUPPER (char c)
 
 =item items
 
@@ -2013,6 +2031,13 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
 	LEAVE;
 
+=item looks_like_number
+
+Test if an the content of an SV looks like a number (or is a number).
+
+	int	looks_like_number(SV*)
+
+
 =item MARK
 
 Stack marker variable for the XSUB.  See C<dMARK>.
@@ -2071,7 +2096,7 @@ The XSUB-writer's interface to the C C<memmove> function.  The C<s> is the
 source, C<d> is the destination, C<n> is the number of items, and C<t> is
 the type.  Can do overlapping moves.  See also C<Copy>.
 
-	(void) Move( s, d, n, t )
+	void	Move( s, d, n, t )
 
 =item na
 
@@ -2082,20 +2107,7 @@ string length.
 
 The XSUB-writer's interface to the C C<malloc> function.
 
-	void * New( x, void *ptr, int size, type )
-
-=item Newc
-
-The XSUB-writer's interface to the C C<malloc> function, with cast.
-
-	void * Newc( x, void *ptr, int size, type, cast )
-
-=item Newz
-
-The XSUB-writer's interface to the C C<malloc> function.  The allocated
-memory is zeroed with C<memzero>.
-
-	void * Newz( x, void *ptr, int size, type )
+	void*	New( x, void *ptr, int size, type )
 
 =item newAV
 
@@ -2103,6 +2115,12 @@ Creates a new AV.  The reference count is set to 1.
 
 	AV*	newAV (void)
 
+=item Newc
+
+The XSUB-writer's interface to the C C<malloc> function, with cast.
+
+	void*	Newc( x, void *ptr, int size, type, cast )
+
 =item newHV
 
 Creates a new HV.  The reference count is set to 1.
@@ -2127,10 +2145,12 @@ SV is B<not> incremented.
 
 =item NEWSV
 
-Creates a new SV.  The C<len> parameter indicates the number of bytes of
-preallocated string space the SV should have.  The reference count for the
-new SV is set to 1.  C<id> is an integer id between 0 and 1299 (used to
-identify leaks).
+Creates a new SV.  A non-zero C<len> parameter indicates the number of
+bytes of preallocated string space the SV should have.  An extra byte
+for a tailing NUL is also reserved.  (SvPOK is not set for the SV even
+if string space is allocated.)  The reference count for the new SV is
+set to 1.  C<id> is an integer id between 0 and 1299 (used to identify
+leaks).
 
 	SV*	NEWSV (int id, STRLEN len)
 
@@ -2155,6 +2175,13 @@ SV is set to 1.  If C<len> is zero then Perl will compute the length.
 
 	SV*	newSVpv (char* s, STRLEN len)
 
+=item newSVpvf
+
+Creates a new SV an initialize it with the string formatted like
+C<sprintf>.
+
+	SV*     newSVpvf(const char* pat, ...);
+
 =item newSVpvn
 
 Creates a new SV and copies a string into it.  The reference count for the
@@ -2187,6 +2214,13 @@ Used by C<xsubpp> to hook up XSUBs as Perl subs.
 Used by C<xsubpp> to hook up XSUBs as Perl subs.  Adds Perl prototypes to
 the subs.
 
+=item Newz
+
+The XSUB-writer's interface to the C C<malloc> function.  The allocated
+memory is zeroed with C<memzero>.
+
+	void*	Newz( x, void *ptr, int size, type )
+
 =item Nullav
 
 Null AV pointer.
@@ -2315,31 +2349,31 @@ Tells a Perl interpreter to run.  See L<perlembed>.
 
 Pops an integer off the stack.
 
-	int POPi()
+	int	POPi()
 
 =item POPl
 
 Pops a long off the stack.
 
-	long POPl()
+	long	POPl()
 
 =item POPp
 
 Pops a string off the stack.
 
-	char * POPp()
+	char*	POPp()
 
 =item POPn
 
 Pops a double off the stack.
 
-	double POPn()
+	double	POPn()
 
 =item POPs
 
 Pops an SV off the stack.
 
-	SV* POPs()
+	SV*	POPs()
 
 =item PUSHMARK
 
@@ -2352,14 +2386,14 @@ Opening bracket for arguments on a callback.  See C<PUTBACK> and L<perlcall>.
 Push an integer onto the stack.  The stack must have room for this element.
 Handles 'set' magic.  See C<XPUSHi>.
 
-	PUSHi(int d)
+	void	PUSHi(int d)
 
 =item PUSHn
 
 Push a double onto the stack.  The stack must have room for this element.
 Handles 'set' magic.  See C<XPUSHn>.
 
-	PUSHn(double d)
+	void	PUSHn(double d)
 
 =item PUSHp
 
@@ -2367,14 +2401,22 @@ Push a string onto the stack.  The stack must have room for this element.
 The C<len> indicates the length of the string.  Handles 'set' magic.  See
 C<XPUSHp>.
 
-	PUSHp(char *c, int len )
+	void	PUSHp(char *c, int len )
 
 =item PUSHs
 
 Push an SV onto the stack.  The stack must have room for this element.  Does
 not handle 'set' magic.  See C<XPUSHs>.
 
-	PUSHs(sv)
+	void	PUSHs(sv)
+
+=item PUSHu
+
+Push an unsigned integer onto the stack.  The stack must have room for
+this element.  See C<XPUSHu>.
+
+	void	PUSHu(unsigned int d)
+
 
 =item PUTBACK
 
@@ -2387,13 +2429,13 @@ See C<PUSHMARK> and L<perlcall> for other uses.
 
 The XSUB-writer's interface to the C C<realloc> function.
 
-	void * Renew( void *ptr, int size, type )
+	void*	Renew( void *ptr, int size, type )
 
 =item Renewc
 
 The XSUB-writer's interface to the C C<realloc> function, with cast.
 
-	void * Renewc( void *ptr, int size, type, cast )
+	void*	Renewc( void *ptr, int size, type, cast )
 
 =item RETVAL
 
@@ -2448,61 +2490,61 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 
 Used to access elements on the XSUB's stack.
 
-	SV* ST(int x)
+	SV*	ST(int x)
 
 =item strEQ
 
 Test two strings to see if they are equal.  Returns true or false.
 
-	int strEQ( char *s1, char *s2 )
+	int	strEQ( char *s1, char *s2 )
 
 =item strGE
 
 Test two strings to see if the first, C<s1>, is greater than or equal to the
 second, C<s2>.  Returns true or false.
 
-	int strGE( char *s1, char *s2 )
+	int	strGE( char *s1, char *s2 )
 
 =item strGT
 
 Test two strings to see if the first, C<s1>, is greater than the second,
 C<s2>.  Returns true or false.
 
-	int strGT( char *s1, char *s2 )
+	int	strGT( char *s1, char *s2 )
 
 =item strLE
 
 Test two strings to see if the first, C<s1>, is less than or equal to the
 second, C<s2>.  Returns true or false.
 
-	int strLE( char *s1, char *s2 )
+	int	strLE( char *s1, char *s2 )
 
 =item strLT
 
 Test two strings to see if the first, C<s1>, is less than the second,
 C<s2>.  Returns true or false.
 
-	int strLT( char *s1, char *s2 )
+	int	strLT( char *s1, char *s2 )
 
 =item strNE
 
 Test two strings to see if they are different.  Returns true or false.
 
-	int strNE( char *s1, char *s2 )
+	int	strNE( char *s1, char *s2 )
 
 =item strnEQ
 
 Test two strings to see if they are equal.  The C<len> parameter indicates
 the number of bytes to compare.  Returns true or false.
 
-	int strnEQ( char *s1, char *s2 )
+	int	strnEQ( char *s1, char *s2 )
 
 =item strnNE
 
 Test two strings to see if they are different.  The C<len> parameter
 indicates the number of bytes to compare.  Returns true or false.
 
-	int strnNE( char *s1, char *s2, int len )
+	int	strnNE( char *s1, char *s2, int len )
 
 =item sv_2mortal
 
@@ -2573,6 +2615,16 @@ Like C<sv_catsv>, but also handles 'set' magic.
 
 	void	sv_catsv_mg (SV* dsv, SV* ssv)
 
+=item sv_chop
+
+Efficient removal of characters from the beginning of the string
+buffer.  SvPOK(sv) must be true and the C<ptr> must be a pointer to
+somewhere inside the string buffer.  The C<ptr> becomes the first
+character of the adjusted string.
+
+	void    sv_chop(SV* sv, char *ptr)
+
+
 =item sv_cmp
 
 Compares the strings in two SVs.  Returns -1, 0, or 1 indicating whether the
@@ -2585,13 +2637,13 @@ C<sv2>.
 
 Returns the length of the string which is in the SV.  See C<SvLEN>.
 
-	int SvCUR (SV* sv)
+	int	SvCUR (SV* sv)
 
 =item SvCUR_set
 
 Set the length of the string which is in the SV.  See C<SvCUR>.
 
-	SvCUR_set (SV* sv, int val )
+	void	SvCUR_set (SV* sv, int val )
 
 =item sv_dec
 
@@ -2599,12 +2651,19 @@ Auto-decrement of the value in the SV.
 
 	void	sv_dec (SV* sv)
 
+=item sv_derived_from
+
+Returns a boolean indicating whether the SV is a subclass of the
+specified class.
+
+	int     sv_derived_from(SV* sv, char* class)
+
 =item SvEND
 
 Returns a pointer to the last character in the string which is in the SV.
 See C<SvCUR>.  Access the character as
 
-	*SvEND(sv)
+	char*	SvEND(sv)
 
 =item sv_eq
 
@@ -2622,10 +2681,12 @@ its argument more than once.
 
 =item SvGROW
 
-Expands the character buffer in the SV.  Calls C<sv_grow> to perform the
-expansion if necessary.  Returns a pointer to the character buffer.
+Expands the character buffer in the SV so that it has room for the
+indicated number of bytes (remember to reserve space for an extra
+trailing NUL character).  Calls C<sv_grow> to perform the expansion if
+necessary.  Returns a pointer to the character buffer.
 
-	char * SvGROW( SV* sv, int len )
+	char*	SvGROW( SV* sv, int len )
 
 =item sv_grow
 
@@ -2639,36 +2700,44 @@ Auto-increment of the value in the SV.
 
 	void	sv_inc (SV* sv)
 
+=item sv_insert
+
+Inserts a string at the specified offset/length within the SV.
+Similar to the Perl substr() function.
+
+	void	sv_insert(SV *sv, STRLEN offset, STRLEN len,
+			  char *str, STRLEN strlen)
+
 =item SvIOK
 
 Returns a boolean indicating whether the SV contains an integer.
 
-	int SvIOK (SV* SV)
+	int	SvIOK (SV* SV)
 
 =item SvIOK_off
 
 Unsets the IV status of an SV.
 
-	SvIOK_off (SV* sv)
+	void	SvIOK_off (SV* sv)
 
 =item SvIOK_on
 
 Tells an SV that it is an integer.
 
-	SvIOK_on (SV* sv)
+	void	SvIOK_on (SV* sv)
 
 =item SvIOK_only
 
 Tells an SV that it is an integer and disables all other OK bits.
 
-	SvIOK_on (SV* sv)
+	void	SvIOK_only (SV* sv)
 
 =item SvIOKp
 
 Returns a boolean indicating whether the SV contains an integer.  Checks the
 B<private> setting.  Use C<SvIOK>.
 
-	int SvIOKp (SV* SV)
+	int	SvIOKp (SV* SV)
 
 =item sv_isa
 
@@ -2678,12 +2747,6 @@ an inheritance relationship.
 
 	int	sv_isa (SV* sv, char* name)
 
-=item SvIV
-
-Returns the integer which is in the SV.
-
-	int SvIV (SV* sv)
-
 =item sv_isobject
 
 Returns a boolean indicating whether the SV is an RV pointing to a blessed
@@ -2692,17 +2755,23 @@ will return false.
 
 	int	sv_isobject (SV* sv)
 
+=item SvIV
+
+Returns the integer which is in the SV.
+
+	int	SvIV (SV* sv)
+
 =item SvIVX
 
 Returns the integer which is stored in the SV.
 
-	int  SvIVX (SV* sv)
+	int	SvIVX (SV* sv)
 
 =item SvLEN
 
 Returns the size of the string buffer in the SV.  See C<SvCUR>.
 
-	int SvLEN (SV* sv)
+	int	SvLEN (SV* sv)
 
 =item sv_len
 
@@ -2723,115 +2792,124 @@ as mortal.
 
 	SV*	sv_mortalcopy (SV* oldsv)
 
-=item SvOK
-
-Returns a boolean indicating whether the value is an SV.
-
-	int SvOK (SV* sv)
-
 =item sv_newmortal
 
 Creates a new SV which is mortal.  The reference count of the SV is set to 1.
 
 	SV*	sv_newmortal (void)
 
-=item sv_no
-
-This is the C<false> SV.  See C<sv_yes>.  Always refer to this as C<&sv_no>.
-
 =item SvNIOK
 
 Returns a boolean indicating whether the SV contains a number, integer or
 double.
 
-	int SvNIOK (SV* SV)
+	int	SvNIOK (SV* SV)
 
 =item SvNIOK_off
 
 Unsets the NV/IV status of an SV.
 
-	SvNIOK_off (SV* sv)
+	void	SvNIOK_off (SV* sv)
 
 =item SvNIOKp
 
 Returns a boolean indicating whether the SV contains a number, integer or
 double.  Checks the B<private> setting.  Use C<SvNIOK>.
 
-	int SvNIOKp (SV* SV)
+	int	SvNIOKp (SV* SV)
+
+=item sv_no
+
+This is the C<false> SV.  See C<sv_yes>.  Always refer to this as C<&sv_no>.
 
 =item SvNOK
 
 Returns a boolean indicating whether the SV contains a double.
 
-	int SvNOK (SV* SV)
+	int	SvNOK (SV* SV)
 
 =item SvNOK_off
 
 Unsets the NV status of an SV.
 
-	SvNOK_off (SV* sv)
+	void	SvNOK_off (SV* sv)
 
 =item SvNOK_on
 
 Tells an SV that it is a double.
 
-	SvNOK_on (SV* sv)
+	void	SvNOK_on (SV* sv)
 
 =item SvNOK_only
 
 Tells an SV that it is a double and disables all other OK bits.
 
-	SvNOK_on (SV* sv)
+	void	SvNOK_only (SV* sv)
 
 =item SvNOKp
 
 Returns a boolean indicating whether the SV contains a double.  Checks the
 B<private> setting.  Use C<SvNOK>.
 
-	int SvNOKp (SV* SV)
+	int	SvNOKp (SV* SV)
 
 =item SvNV
 
 Returns the double which is stored in the SV.
 
-	double SvNV (SV* sv)
+	double	SvNV (SV* sv)
 
 =item SvNVX
 
 Returns the double which is stored in the SV.
 
-	double SvNVX (SV* sv)
+	double	SvNVX (SV* sv)
+
+=item SvOK
+
+Returns a boolean indicating whether the value is an SV.
+
+	int	SvOK (SV* sv)
+
+=item SvOOK
+
+Returns a boolean indicating whether the SvIVX is a valid offset value
+for the SvPVX.  This hack is used internally to speed up removal of
+characters from the beginning of a SvPV.  When SvOOK is true, then the
+start of the allocated string buffer is really (SvPVX - SvIVX).
+
+	int     SvOOK(Sv* sv)
 
 =item SvPOK
 
 Returns a boolean indicating whether the SV contains a character string.
 
-	int SvPOK (SV* SV)
+	int	SvPOK (SV* SV)
 
 =item SvPOK_off
 
 Unsets the PV status of an SV.
 
-	SvPOK_off (SV* sv)
+	void	SvPOK_off (SV* sv)
 
 =item SvPOK_on
 
 Tells an SV that it is a string.
 
-	SvPOK_on (SV* sv)
+	void	SvPOK_on (SV* sv)
 
 =item SvPOK_only
 
 Tells an SV that it is a string and disables all other OK bits.
 
-	SvPOK_on (SV* sv)
+	void	SvPOK_only (SV* sv)
 
 =item SvPOKp
 
 Returns a boolean indicating whether the SV contains a character string.
 Checks the B<private> setting.  Use C<SvPOK>.
 
-	int SvPOKp (SV* SV)
+	int	SvPOKp (SV* SV)
 
 =item SvPV
 
@@ -2839,49 +2917,57 @@ Returns a pointer to the string in the SV, or a stringified form of the SV
 if the SV does not contain a string.  If C<len> is C<na> then Perl will
 handle the length on its own.  Handles 'get' magic.
 
-	char * SvPV (SV* sv, int len )
+	char*	SvPV (SV* sv, int len )
+
+=item SvPV_force
+
+Like <SvPV> but will force the SV into becoming a string (SvPOK).  You
+want force if you are going to update the SvPVX directly.
+
+	char*	SvPV_force(SV* sv, int len)
+
 
 =item SvPVX
 
 Returns a pointer to the string in the SV.  The SV must contain a string.
 
-	char * SvPVX (SV* sv)
+	char*	SvPVX (SV* sv)
 
 =item SvREFCNT
 
 Returns the value of the object's reference count.
 
-	int SvREFCNT (SV* sv)
+	int	SvREFCNT (SV* sv)
 
 =item SvREFCNT_dec
 
 Decrements the reference count of the given SV.
 
-	void SvREFCNT_dec (SV* sv)
+	void	SvREFCNT_dec (SV* sv)
 
 =item SvREFCNT_inc
 
 Increments the reference count of the given SV.
 
-	void SvREFCNT_inc (SV* sv)
+	void	SvREFCNT_inc (SV* sv)
 
 =item SvROK
 
 Tests if the SV is an RV.
 
-	int SvROK (SV* sv)
+	int	SvROK (SV* sv)
 
 =item SvROK_off
 
 Unsets the RV status of an SV.
 
-	SvROK_off (SV* sv)
+	void	SvROK_off (SV* sv)
 
 =item SvROK_on
 
 Tells an SV that it is an RV.
 
-	SvROK_on (SV* sv)
+	void	SvROK_on (SV* sv)
 
 =item SvRV
 
@@ -2896,35 +2982,6 @@ its argument more than once.
 
 	void	SvSETMAGIC( SV *sv )
 
-=item SvTAINT
-
-Taints an SV if tainting is enabled
-
-	SvTAINT (SV* sv)
-
-=item SvTAINTED
-
-Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not.
-
-	SvTAINTED (SV* sv)
-
-=item SvTAINTED_off
-
-Untaints an SV. Be I<very> careful with this routine, as it short-circuits
-some of Perl's fundamental security features. XS module authors should
-not use this function unless they fully understand all the implications
-of unconditionally untainting the value. Untainting should be done in
-the standard perl fashion, via a carefully crafted regexp, rather than
-directly untainting variables.
-
-	SvTAINTED_off (SV* sv)
-
-=item SvTAINTED_on
-
-Marks an SV as tainted.
-
-	SvTAINTED_on (SV* sv)
-
 =item sv_setiv
 
 Copies an integer into the given SV.  Does not handle 'set' magic.
@@ -3097,7 +3154,36 @@ Like C<sv_setuv>, but also handles 'set' magic.
 
 Returns the stash of the SV.
 
-	HV * SvSTASH (SV* sv)
+	HV*	SvSTASH (SV* sv)
+
+=item SvTAINT
+
+Taints an SV if tainting is enabled
+
+	void	SvTAINT (SV* sv)
+
+=item SvTAINTED
+
+Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not.
+
+	int	SvTAINTED (SV* sv)
+
+=item SvTAINTED_off
+
+Untaints an SV. Be I<very> careful with this routine, as it short-circuits
+some of Perl's fundamental security features. XS module authors should
+not use this function unless they fully understand all the implications
+of unconditionally untainting the value. Untainting should be done in
+the standard perl fashion, via a carefully crafted regexp, rather than
+directly untainting variables.
+
+	void	SvTAINTED_off (SV* sv)
+
+=item SvTAINTED_on
+
+Marks an SV as tainted.
+
+	void	SvTAINTED_on (SV* sv)
 
 =item SVt_IV
 
@@ -3132,7 +3218,7 @@ Double type flag for scalars.  See C<svtype>.
 Returns a boolean indicating whether Perl would evaluate the SV as true or
 false, defined or undefined.  Does not handle 'get' magic.
 
-	int SvTRUE (SV* sv)
+	int	SvTRUE (SV* sv)
 
 =item SvTYPE
 
@@ -3145,17 +3231,6 @@ Returns the type of the SV.  See C<svtype>.
 An enum of flags for Perl types.  These are found in the file B<sv.h> in the
 C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
-=item SvUPGRADE
-
-Used to upgrade an SV to a more complex form.  Uses C<sv_upgrade> to perform
-the upgrade if necessary.  See C<svtype>.
-
-	bool    SvUPGRADE (SV* sv, svtype mt)
-
-=item sv_upgrade
-
-Upgrade an SV to a more complex form.  Use C<SvUPGRADE>.  See C<svtype>.
-
 =item sv_undef
 
 This is the C<undef> SV.  Always refer to this as C<&sv_undef>.
@@ -3168,6 +3243,17 @@ as a reversal of C<newSVrv>.  See C<SvROK_off>.
 
 	void    sv_unref (SV* sv)
 
+=item SvUPGRADE
+
+Used to upgrade an SV to a more complex form.  Uses C<sv_upgrade> to perform
+the upgrade if necessary.  See C<svtype>.
+
+	bool    SvUPGRADE (SV* sv, svtype mt)
+
+=item sv_upgrade
+
+Upgrade an SV to a more complex form.  Use C<SvUPGRADE>.  See C<svtype>.
+
 =item sv_usepvn
 
 Tells an SV to use C<ptr> to find its string value.  Normally the string is
@@ -3186,6 +3272,18 @@ Like C<sv_usepvn>, but also handles 'set' magic.
 
 	void	sv_usepvn_mg (SV* sv, char* ptr, STRLEN len)
 
+=item SvUV
+
+Returns the unsigned integer which is in the SV.
+
+	UV      SvUV(SV* sv)
+
+=item SvUVX
+
+Returns the unsigned integer which is stored in the SV.
+
+	UV      SvUVX(SV* sv)
+
 =item sv_yes
 
 This is the C<true> SV.  See C<sv_no>.  Always refer to this as C<&sv_yes>.
@@ -3200,13 +3298,13 @@ L<perlxs/"Using XS With C++">.
 
 Converts the specified character to lowercase.
 
-	int toLOWER (char c)
+	int	toLOWER (char c)
 
 =item toUPPER
 
 Converts the specified character to uppercase.
 
-	int toUPPER (char c)
+	int	toUPPER (char c)
 
 =item warn
 
@@ -3241,6 +3339,11 @@ handle 'set' magic.  See C<PUSHs>.
 
 	XPUSHs(sv)
 
+=item XPUSHu
+
+Push an unsigned integer onto the stack, extending the stack if
+necessary.  See C<PUSHu>.
+
 =item XS
 
 Macro to declare an XSUB and its C parameter list.  This is handled by
@@ -3350,7 +3453,7 @@ C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
 The XSUB-writer's interface to the C C<memzero> function.  The C<d> is the
 destination, C<n> is the number of items, and C<t> is the type.
 
-	(void) Zero( d, n, t )
+	void	Zero( d, n, t )
 
 =back
 
diff --git a/pod/perlhist.pod b/pod/perlhist.pod
index 9113ed90a4..163fe03984 100644
--- a/pod/perlhist.pod
+++ b/pod/perlhist.pod
@@ -6,7 +6,7 @@ perlhist - the Perl history records
 
 =for RCS
 #
-# $Id: perlhist.pod,v 1.27 1998/01/16 19:50:20 jhi Exp $
+# $Id: perlhist.pod,v 1.29 1998/02/19 15:49:17 jhi Exp $
 #
 =end RCS
 
@@ -18,15 +18,15 @@ This document aims to record the Perl source code releases.
 
 Perl history in brief, by Larry Wall:
 
-    Perl 0 introduced Perl to my officemates.
-    Perl 1 introduced Perl to the world, and changed /\(...\|...\)/ to
-	/(...|...)/.  \(Dan Faigin still hasn't forgiven me. :-\)
+   Perl 0 introduced Perl to my officemates.
+   Perl 1 introduced Perl to the world, and changed /\(...\|...\)/ to
+        /(...|...)/.  \(Dan Faigin still hasn't forgiven me. :-\)
     Perl 2 introduced Henry Spencer's regular expression package.
     Perl 3 introduced the ability to handle binary data (embedded nulls).
     Perl 4 introduced the first Camel book.  Really.  We mostly just
-	switched version numbers so the book could refer to 4.000.
+        switched version numbers so the book could refer to 4.000.
     Perl 5 introduced everything else, including the ability to
-	introduce everything else.
+        introduce everything else.
 
 =head1 THE KEEPERS OF THE PUMPKIN
 
@@ -65,19 +65,19 @@ the pumpking or the pumpkineer.
                                          for details)
  ===========================================================================
 
- Larry   0              Classified.	Don't ask.
+ Larry   0              Classified.     Don't ask.
 
  Larry   1.000          1987-Dec-18
-				   
+                                   
           1.001..10     1988-Jan-30
           1.011..14     1988-Feb-02
-				   
+                                   
  Larry   2.000          1988-Jun-05
-				   
+                                   
           2.001         1988-Jun-28
-				   
+                                   
  Larry   3.000          1989-Oct-18
-				   
+                                   
           3.001         1989-Oct-26
           3.002..4      1989-Nov-11
           3.005         1989-Nov-18
@@ -86,7 +86,7 @@ the pumpking or the pumpkineer.
           3.014         1990-Mar-13
           3.015         1990-Mar-14
           3.016..18     1990-Mar-28
-          3.019..27     1990-Aug-10	User subs.
+          3.019..27     1990-Aug-10     User subs.
           3.028         1990-Aug-14
           3.029..36     1990-Oct-17
           3.037         1990-Oct-20
@@ -94,19 +94,19 @@ the pumpking or the pumpkineer.
           3.041         1990-Nov-13
           3.042..43     1990-Jan-91
           3.044         1991-Jan-12
-				   
+                                   
  Larry   4.000          1991-Mar-21
-				   
+                                   
           4.001..3      1991-Apr-12
           4.004..9      1991-Jun-07
           4.010         1991-Jun-10
           4.011..18     1991-Nov-05
-          4.019         1991-Nov-11	Stable.
+          4.019         1991-Nov-11     Stable.
           4.020..33     1992-Jun-08
           4.034         1992-Jun-11
           4.035         1992-Jun-23
- Larry    4.036         1993-Feb-05	Very stable.
-				   
+ Larry    4.036         1993-Feb-05     Very stable.
+                                   
           5.000alpha1   1993-Jul-31
           5.000alpha2   1993-Aug-16
           5.000alpha3   1993-Oct-10
@@ -115,10 +115,10 @@ the pumpking or the pumpkineer.
           5.000alpha6   1993-Mar-18
           5.003alpha7   1994-Mar-25
  Andy     5.000alpha8   1994-Apr-04
- Larry    5.000alpha9   1994-May-05
+ Larry    5.000alpha9   1994-May-05     ext appears.
           5.000alpha10  1994-???-??
           5.000alpha11  1994-???-??
- Andy     5.000a11a     1994-Jul-07	To fit 14.
+ Andy     5.000a11a     1994-Jul-07     To fit 14.
           5.000a11b     1994-Jul-14
           5.000a11c     1994-Jul-19
           5.000a11d     1994-Jul-22
@@ -133,7 +133,7 @@ the pumpking or the pumpkineer.
           5.000a12h     1994-Aug-24
  Larry    5.000beta1    1994-???-??
  Andy     5.000b1a      1994-???-??
- Larry    5.000beta2    1994-Sep-14	Core slushified.
+ Larry    5.000beta2    1994-Sep-14     Core slushified.
  Andy     5.000b2a      1994-Sep-14
           5.000b2b      1994-Sep-17
           5.000b2c      1994-Sep-17
@@ -146,9 +146,9 @@ the pumpking or the pumpkineer.
           5.000b3f      1994-Sep-30
           5.000b3g      1994-Oct-04
  Andy     5.000b3h      1994-Oct-07
-				   
+                                   
  Larry   5.000          1994-Oct-18
-				   
+                                   
  Andy     5.000a        1994-Dec-19
           5.000b        1995-Jan-18
           5.000c        1995-Jan-18
@@ -163,23 +163,23 @@ the pumpking or the pumpkineer.
           5.000l        1995-Feb-21
           5.000m        1995-???-??
           5.000n        1995-Mar-07
-				   
+                                   
  Larry   5.001          1995-Mar-13
-				   
+                                   
  Andy     5.001a        1995-Mar-15
           5.001b        1995-Mar-31
           5.001c        1995-Apr-07
           5.001d        1995-Apr-14
-          5.001e        1995-Apr-18	Stable.
+          5.001e        1995-Apr-18     Stable.
           5.001f        1995-May-31
           5.001g        1995-May-25
           5.001h        1995-May-25
           5.001i        1995-May-30
           5.001j        1995-Jun-05
           5.001k        1995-Jun-06
-          5.001l        1995-Jun-06	Stable.
-          5.001m        1995-Jul-02	Very stable.
-          5.001n        1995-Oct-31	Very unstable.
+          5.001l        1995-Jun-06     Stable.
+          5.001m        1995-Jul-02     Very stable.
+          5.001n        1995-Oct-31     Very unstable.
           5.002beta1    1995-Nov-21
           5.002b1a      1995-Nov-??
           5.002b1b      1995-Dec-04
@@ -187,19 +187,19 @@ the pumpking or the pumpkineer.
           5.002b1d      1995-Dec-04
           5.002b1e      1995-Dec-08
           5.002b1f      1995-Dec-08
- Tom      5.002b1g      1995-Dec-21	Doc release.
+ Tom      5.002b1g      1995-Dec-21     Doc release.
  Andy     5.002b1h      1996-Jan-05
-	  5.002b2	1996-Jan-14
- Larry	  5.002b3	1996-Feb-02
+          5.002b2       1996-Jan-14
+ Larry    5.002b3       1996-Feb-02
  Andy     5.002gamma    1996-Feb-11
  Larry    5.002delta    1996-Feb-27
-				   
+                                   
  Larry   5.002          1996-Feb-29
-				   
+                                   
  Charles  5.002_01      1996-Mar-25
-				   
-         5.003          1996-Jun-25	Security release.
-				   
+                                   
+         5.003          1996-Jun-25     Security release.
+                                   
           5.003_01      1996-Jul-31
  Nick     5.003_02      1996-Aug-10
  Andy     5.003_03      1996-Aug-28
@@ -228,14 +228,14 @@ the pumpking or the pumpkineer.
           5.003_26      1997-Feb-10
           5.003_27      1997-Feb-18
           5.003_28      1997-Feb-21
-          5.003_90      1997-Feb-25	Ramping up to the 5.004 release.
+          5.003_90      1997-Feb-25     Ramping up to the 5.004 release.
           5.003_91      1997-Mar-01
           5.003_92      1997-Mar-06
           5.003_93      1997-Mar-10
           5.003_94      1997-Mar-22
           5.003_95      1997-Mar-25
           5.003_96      1997-Apr-01
-          5.003_97      1997-Apr-03	Fairly widely used.
+          5.003_97      1997-Apr-03     Fairly widely used.
           5.003_97a     1997-Apr-05
           5.003_97b     1997-Apr-08
           5.003_97c     1997-Apr-10
@@ -249,23 +249,26 @@ the pumpking or the pumpkineer.
           5.003_98      1997-Apr-30
           5.003_99      1997-May-01
           5.003_99a     1997-May-09
-          p54rc1        1997-May-12	Release Candidates.
-          p54rc2        1997-May-14	
-				   
- Chip    5.004          1997-May-15	A major maintenance release.
-				   
- Tim      5.004_01      1997-Jun-13	The 5.004 maintenance track.
+          p54rc1        1997-May-12     Release Candidates.
+          p54rc2        1997-May-14     
+                                   
+ Chip    5.004          1997-May-15     A major maintenance release.
+                                   
+ Tim      5.004_01      1997-Jun-13     The 5.004 maintenance track.
           5.004_02      1997-Aug-07
           5.004_03      1997-Sep-05
           5.004_04      1997-Oct-15
-				   
- Malcolm  5.004_50      1997-Sep-09	The 5.005 development track.
+                                   
+ Malcolm  5.004_50      1997-Sep-09     The 5.005 development track.
           5.004_51      1997-Oct-02
           5.004_52      1997-Oct-15
           5.004_53      1997-Oct-16
           5.004_54      1997-Nov-14
           5.004_55      1997-Nov-25
           5.004_56      1997-Dec-18
+          5.004_57      1998-Feb-03
+          5.004_58      1998-Feb-06
+          5.004_59      1998-Feb-13
 
 =head2 SELECTED RELEASE SIZES
 
@@ -273,44 +276,45 @@ For example the notation "core: 212  29" in the release 1.000 means that
 it had in the core 212 kilobytes, in 29 files.  The "core".."doc" are
 explained below.
 
- release	core	   lib	       ext        t         doc
+ release        core       lib         ext        t         doc
  ======================================================================
 
- 1.000		 212  29      -   -      -   -     38  51     62   3
- 1.014		 219  29      -   -      -   -     39  52     68   4
- 2.000		 309  31      2   3      -   -     55  57     92   4
- 2.001		 312  31      2   3      -   -     55  57     94   4
- 3.000		 508  36     24  11      -   -     79  73    156   5
- 3.044		 645  37     61  20      -   -     90  74    190   6
- 4.000		 635  37     59  20      -   -     91  75    198   4
- 4.019		 680  37     85  29      -   -     98  76    199   4
- 4.036		 709  37     89  30      -   -     98  76    208   5
- 5.000alpha2	 785  50    114  32      -   -    112  86    209   5
- 5.000a3    	 801  50    117  33      -   -    121  87    209   5
- 5.000a9    	1022  56    149  43    116  29    125  90    217   6
+ 1.000           212  29      -   -      -   -     38  51     62   3
+ 1.014           219  29      -   -      -   -     39  52     68   4
+ 2.000           309  31      2   3      -   -     55  57     92   4
+ 2.001           312  31      2   3      -   -     55  57     94   4
+ 3.000           508  36     24  11      -   -     79  73    156   5
+ 3.044           645  37     61  20      -   -     90  74    190   6
+ 4.000           635  37     59  20      -   -     91  75    198   4
+ 4.019           680  37     85  29      -   -     98  76    199   4
+ 4.036           709  37     89  30      -   -     98  76    208   5
+ 5.000alpha2     785  50    114  32      -   -    112  86    209   5
+ 5.000a3         801  50    117  33      -   -    121  87    209   5
+ 5.000a9        1022  56    149  43    116  29    125  90    217   6
  5.000a12h       978  49    140  49    205  46    152  97    228   9
  5.000beta3h    1035  53    232  70    216  38    162  94    218  21
- 5.000		1038  53    250  76    216  38    154  92    536  62
- 5.001m		1071  54    388  82    240  38    159  95    544  29
- 5.002		1121  54    661 101    287  43    155  94    847  35
- 5.003		1129  54    680 102    291  43    166 100    853  35
- 5.003_07	1231  60    748 106    396  53    213 137    976  39
- 5.004		1351  60   1230 136    408  51    355 161   1587  55
- 5.004_01	1356  60   1258 138    410  51    358 161   1587  55 
- 5.004_04	1375  60   1294 139    413  51    394 162   1629  55
- 5.004_51	1401  61   1260 140    413  53    358 162   1594  56
- 5.004_53	1422  62   1295 141    438  70    394 162   1637  56
- 5.004_56	1501  66   1301 140    447  74    408 165   1648  57
+ 5.000          1038  53    250  76    216  38    154  92    536  62
+ 5.001m         1071  54    388  82    240  38    159  95    544  29
+ 5.002          1121  54    661 101    287  43    155  94    847  35
+ 5.003          1129  54    680 102    291  43    166 100    853  35
+ 5.003_07       1231  60    748 106    396  53    213 137    976  39
+ 5.004          1351  60   1230 136    408  51    355 161   1587  55
+ 5.004_01       1356  60   1258 138    410  51    358 161   1587  55 
+ 5.004_04       1375  60   1294 139    413  51    394 162   1629  55
+ 5.004_51       1401  61   1260 140    413  53    358 162   1594  56
+ 5.004_53       1422  62   1295 141    438  70    394 162   1637  56
+ 5.004_56       1501  66   1301 140    447  74    408 165   1648  57
+ 5.004_59       1555  72   1317 142    448  74    424 171   1678  58   
 
 The "core"..."doc" mean the following files from the Perl source code
 distribution.  The glob notation ** means recursively, (.) means
 regular files.
 
- core	*.[hcy]
- lib	lib/**/*.p[ml]
- ext	ext/**/*.{[hcyt],xs,pm}
- t	t/**/*(.)
- doc	{README*,INSTALL,*[_.]man{,.?},pod/**/*.pod}
+ core   *.[hcy]
+ lib    lib/**/*.p[ml]
+ ext    ext/**/*.{[hcyt],xs,pm}
+ t      t/**/*(.)
+ doc    {README*,INSTALL,*[_.]man{,.?},pod/**/*.pod}
 
 Here are some statistics for the other subdirectories and one file in
 the Perl source distribution for somewhat more selected releases.
@@ -318,8 +322,8 @@ the Perl source distribution for somewhat more selected releases.
  ======================================================================
    Legend:  kB   #
 
-	    1.014   2.001   3.044   4.000   4.019   4.036   
-	    			                              
+            1.014   2.001   3.044   4.000   4.019   4.036   
+                                                              
  atarist      -  -    -  -    -  -    -  -    -  -  113 31  
  Configure   31  1   37  1   62  1   73  1   83  1   86  1  
  eg           -  -   34 28   47 39   47 39   47 39   47 39  
@@ -333,8 +337,8 @@ the Perl source distribution for somewhat more selected releases.
 
  ======================================================================
 
-	    5.000a2 5.000a12h 5.000b3h 5.000  5.001m  5.002   5.003   
-	                                                              
+            5.000a2 5.000a12h 5.000b3h 5.000  5.001m  5.002   5.003   
+                                                                      
  atarist    113 31  113 31    -  -      -  -    -  -    -  -    -  -
  bench        -  -    0  1    -  -      -  -    -  -    -  -    -  -
  Bugs         2  5   26  1    -  -      -  -    -  -    -  -    -  -
@@ -356,22 +360,22 @@ the Perl source distribution for somewhat more selected releases.
 
  ======================================================================
 
-	    5.003_07 5.004   5.004_04 5.004_56
-	    	                              
- Configure  217  1   225  1  225  1   232  1  
+            5.003_07 5.004   5.004_04 5.004_59
+                                              
+ Configure  217  1   225  1  225  1   240  1  
  cygwin32     -  -    23  5   23  5    23  5  
  djgpp        -  -     -  -    -  -    15  5
  eg          54 44    81 62   81 62    81 62
  emacs      143  1   194  1  204  1   212  2
  h2pl        12 12    12 12   12 12    12 12
- hints       90 62   129 69  132 71   138 72
+ hints       90 62   129 69  132 71   139 72
  os2        117 42   121 42  127 42   134 44
  plan9       79 15    82 15   82 15    82 15
  Porting     51  1    94  2  109  4   109  4
  qnx          -  -     1  2    1  2     1  2
- utils       97  7   112  8  118  8   118  8
- vms        505 27   518 34  524 34   538 34
- win32        -  -   285 33  378 36   449 38
+ utils       97  7   112  8  118  8   123  8
+ vms        505 27   518 34  524 34   536 34
+ win32        -  -   285 33  378 36   464 39
  x2p        280 19   281 19  281 19   281 19
 
 =head2 SELECTED PATCH SIZES
diff --git a/pod/perllocale.pod b/pod/perllocale.pod
index e1bf5f070d..037fcc9f91 100644
--- a/pod/perllocale.pod
+++ b/pod/perllocale.pod
@@ -189,6 +189,9 @@ If the second argument does not correspond to a valid locale, the locale
 for the category is not changed, and the function returns I<undef>.
 
 For further information about the categories, consult L<setlocale(3)>.
+
+=head2 Finding locales
+
 For the locales available in your system, also consult L<setlocale(3)>
 and see whether it leads you to the list of the available locales
 (search for the I<SEE ALSO> section).  If that fails, try the following
@@ -213,10 +216,17 @@ and see whether they list something resembling these
         english.iso88591    german.iso88591     russian.iso88595
 
 Sadly, even though the calling interface for setlocale() has been
-standardized, the names of the locales and the directories where
-the configuration is, have not.  The basic form of the name is
-I<language_country/territory>B<.>I<codeset>, but the
-latter parts are not always present.
+standardized, the names of the locales and the directories where the
+configuration is, have not.  The basic form of the name is
+I<language_country/territory>B<.>I<codeset>, but the latter parts
+after the I<language> are not always present.  The I<language> and the
+I<country> are usually from the standards B<ISO 3166> and B<ISO 639>,
+respectively, the two-letter abbreviations for the countries and the
+languages of the world.  The I<codeset> part often mentions some B<ISO
+8859> character set, the Latin codesets.  For example the C<ISO
+8859-1> is the so-called "Western codeset" that can be used to encode
+most of the Western European languages.  Again, sadly, as you can see,
+there are several ways to write even the name of that one standard.
 
 Two special locales are worth particular mention: "C" and "POSIX".
 Currently these are effectively the same locale: the difference is
@@ -230,6 +240,117 @@ B<NOTE>: Not all systems have the "POSIX" locale (not all systems are
 POSIX-conformant), so use "C" when you need explicitly to specify this
 default locale.
 
+=head2 LOCALE PROBLEMS
+
+You may meet the following warning message at Perl startup:
+
+	perl: warning: Setting locale failed.
+	perl: warning: Please check that your locale settings:
+	        LC_ALL = "En_US",
+	        LANG = (unset)
+	    are supported and installed on your system.
+	perl: warning: Falling back to the standard locale ("C").
+
+This means that your locale settings were that LC_ALL equals "En_US"
+and LANG exists but has no value.  Perl tried to believe you but it
+could not.  Instead Perl gave up and fell back to the "C" locale, the
+default locale that is supposed to work no matter what.  This usually
+means either or both of the two problems: either your locale settings
+were wrong, they talk of locales your system has never heard of, or
+that the locale installation in your system has problems, for example
+some system files are broken or missing.  For the problems there are
+quick and temporary fixes and more thorough and lasting fixes.
+
+=head2 Temporarily fixing locale problems
+
+The two quickest fixes are either to make Perl be silent about any
+locale inconsistencies or to run Perl under the default locale "C".
+
+Perl's moaning about locale problems can be silenced by setting the
+environment variable PERL_BADLANG to a non-zero value, for example
+"1".  This method really just sweeps the problem under the carpet: you
+tell Perl to shut up even when Perl sees that something is wrong.  Do
+not be surprised if later something locale-dependent works funny.
+
+Perl can be run under the "C" locale by setting the environment
+variable LC_ALL to "C".  This method is perhaps a bit more civilised
+than the PERL_BADLANG one but please note that setting the LC_ALL (or
+the other locale variables) may affect also other programs, not just
+Perl.  Especially external programs run from within Perl will see
+these changes.  If you make the new settings permanent (read on), all
+the programs you run will see the changes.  See L<ENVIRONMENT> for for
+the full list of all the environment variables and L<USING LOCALES>
+for their effects in Perl.  The effects in other programs are quite
+easily deducible: for example the variable LC_COLLATE may well affect
+your "sort" program (or whatever the program that arranges `records'
+alphabetically in your system is called).
+
+You can first try out changing these variables temporarily and if the
+new settings seem to help then put the settings into the startup files
+of your environment.  Please consult your local documentation for the
+exact details but very shortly for UNIXish systems: in Bourneish
+shells (sh, ksh, bash, zsh) for example
+
+	LC_ALL=en_US.ISO8859-1
+	export LC_ALL
+
+We assume here that we saw with the above discussed commands the
+locale "en_US.ISO8859-1" and decided to try that instead of the above
+faulty locale "En_US" -- and in Cshish shells (csh, tcsh)
+
+	setenv LC_ALL en_US.ISO8859-1
+	
+If you do not know what shell you have, please consult your local
+helpdesk or the equivalent.
+
+=head2 Permanently fixing locale problems
+
+Then the slower but better fixes: the misconfiguration of your own
+environment variables you may be able to fix yourself; the
+mis(sing)configuration of the whole system's locales usually requires
+the help of your friendly system administrator.
+
+First, see earlier in this document about L<Finding locales>.  That
+tells how you can find which locales really are supported and more
+importantly, installed, in your system.  In our example error message
+the environment variables affecting the locale are listed in the order
+of decreasing importance and unset variables do not matter, therefore
+in the above error message the LC_ALL being "En_US" must have been the
+bad choice.  Always try fixing first the locale settings listed first.
+
+Second, if you see with the listed commands something B<exactly> (for
+example prefix matches do not count and case usually matters) like
+"En_US" (without the quotes), then you should be okay because you are
+using a locale name that should be installed and available in your
+system.  In this case skip forward to L<Fixing the system locale
+configuration>.
+
+=head2 Permantently fixing your locale configuration
+
+This is the case when for example you see
+
+	perl: warning: Please check that your locale settings:
+	        LC_ALL = "En_US",
+	        LANG = (unset)
+	    are supported and installed on your system.
+
+but then cannot see that "En_US" listed by the above-mentioned
+commands.  You may see things like "en_US.ISO8859-1" but that is not
+the same thing.  In this case you might try running under a locale
+that you could list and somehow matches with what you tried.  The
+rules for matching locale names are a bit vague because
+standardisation is weak in this area.  See again the L<Finding
+locales> about the general rules.
+
+=head2 Permanently fixing the system locale configuration
+
+Please contact your system administrator and tell her the exact error
+message you get and ask her to read this same documentation you are
+now reading.  She should be able to check whether there is something
+wrong with the locale configuration of the system.  The L<Finding
+locales> section is unfortunately a bit vague about the exact commands
+and places because these things are not that standardised.
+
 =head2 The localeconv function
 
 The POSIX::localeconv() function allows you to get particulars of the
@@ -797,4 +918,4 @@ L<POSIX (3)/strxfrm>
 Jarkko Hietaniemi's original F<perli18n.pod> heavily hacked by Dominic
 Dunlop, assisted by the perl5-porters.
 
-Last update: Wed Jan 22 11:04:58 EST 1997
+Last update: Mon Nov 17 22:48:48 EET 1997
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index 9c3f6617bd..5274d28383 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -270,15 +270,22 @@ implicitly local to the loop and regains its former value upon exiting
 the loop.  If the variable was previously declared with C<my>, it uses
 that variable instead of the global one, but it's still localized to
 the loop.  (Note that a lexically scoped variable can cause problems
-with you have subroutine or format declarations.)
+if you have subroutine or format declarations within the loop which
+refer to it.)
 
 The C<foreach> keyword is actually a synonym for the C<for> keyword, so
 you can use C<foreach> for readability or C<for> for brevity.  If VAR is
-omitted, $_ is set to each value.  If LIST is an actual array (as opposed
-to an expression returning a list value), you can modify each element of
-the array by modifying VAR inside the loop.  That's because the C<foreach>
-loop index variable is an implicit alias for each item in the list that
-you're looping over.
+omitted, $_ is set to each value.  If any element of LIST is an lvalue,
+you can modify it by modifying VAR inside the loop.  That's because
+the C<foreach> loop index variable is an implicit alias for each item
+in the list that you're looping over.
+
+If any part of LIST is an array, C<foreach> will get very confused if
+you add or remove elements within the loop body, for example with
+C<splice>.   So don't do that.
+
+C<foreach> probably won't do what you expect if VAR is a tied or other
+special variable.   Don't do that either.
 
 Examples:
 
diff --git a/pod/perltoc.pod b/pod/perltoc.pod
index d3f3a812b1..4def4c7dcc 100644
--- a/pod/perltoc.pod
+++ b/pod/perltoc.pod
@@ -863,10 +863,14 @@ CGI script to do bad things?
 
 =item Fixed parsing of $$<digit>, &$<digit>, etc.
 
+=item Fixed localization of $<digit>, $&, etc.
+
 =item No resetting of $. on implicit close
 
 =item C<wantarray> may return undef
 
+=item C<eval EXPR> determines value of EXPR in scalar context
+
 =item Changes to tainting checks
 
 No glob() or <*>, No spawning if tainted $CDPATH, $ENV, $BASH_ENV, No
@@ -911,7 +915,7 @@ LIST, READLINE this, GETC this, DESTROY this
 
 =item Malloc enhancements
 
--DDEBUGGING_MSTATS, -DPERL_EMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE
+-DPERL_EMERGENCY_SBRK, -DPACK_MALLOC, -DTWO_POT_OPTIMIZE
 
 =item Miscellaneous efficiency enhancements
 
@@ -1132,7 +1136,7 @@ unary &, unary *, (TYPE)
 
 =item Regexp Quote-Like Operators
 
-?PATTERN?, m/PATTERN/gimosx, /PATTERN/gimosx, q/STRING/, C<'STRING'>,
+?PATTERN?, m/PATTERN/cgimosx, /PATTERN/cgimosx, q/STRING/, C<'STRING'>,
 qq/STRING/, "STRING", qx/STRING/, `STRING`, qw/STRING/,
 s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds,
 y/SEARCHLIST/REPLACEMENTLIST/cds
@@ -1157,7 +1161,10 @@ i, m, s, x
 
 =item Regular Expressions
 
-(?#text), (?:regexp), (?=regexp), (?!regexp), (?imsx)
+C<(?#text)>, C<(?:regexp)>, C<(?=regexp)>, C<(?!regexp)>, C<(?<=regexp)>,
+C<(?<!regexp)>, C<(?{ code })>, C<(?E<gt>regexp)>,
+C<(?(condition)yes-regexp|no-regexp)>, C<(?(condition)yes-regexp)>,
+C<(?imsx)>
 
 =item Backtracking
 
@@ -1183,8 +1190,8 @@ OS/2, MS-DOS, Win95/NT, Macintosh
 
 =item Switches
 
-B<-0>[I<digits>], B<-a>, B<-c>, B<-d>, B<-d:>I<foo>, B<-D>I<number>,
-B<-D>I<list>, B<-e> I<commandline>, B<-F>I<pattern>, B<-h>,
+B<-0>[I<digits>], B<-a>, B<-c>, B<-d>, B<-d:>I<foo>, B<-D>I<letters>,
+B<-D>I<number>, B<-e> I<commandline>, B<-F>I<pattern>, B<-h>,
 B<-i>[I<extension>], B<-I>I<directory>, B<-l>[I<octnum>],
 B<-m>[B<->]I<module>, B<-M>[B<->]I<module>, B<-M>[B<->]I<'module ...'>,
 B<-[mM]>[B<->]I<module=arg[,arg]...>, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>,
@@ -1221,7 +1228,7 @@ in perl5
 
 =item Alphabetical Listing of Perl Functions
 
--I<X> FILEHANDLE, -I<X> EXPR, -I<X>, abs VALUE, abs, accept
+I<-X> FILEHANDLE, I<-X> EXPR, I<-X>, abs VALUE, abs, accept
 NEWSOCKET,GENERICSOCKET, alarm SECONDS, alarm, atan2 Y,X, bind SOCKET,NAME,
 binmode FILEHANDLE, bless REF,CLASSNAME, bless REF, caller EXPR, caller,
 chdir EXPR, chmod LIST, chomp VARIABLE, chomp LIST, chomp, chop VARIABLE,
@@ -1258,18 +1265,19 @@ LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, printf FORMAT,
 LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, qq/STRING/,
 qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR, rand, read
 FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir
-DIRHANDLE, readlink EXPR, readlink, recv SOCKET,SCALAR,LEN,FLAGS, redo
-LABEL, redo, ref EXPR, ref, rename OLDNAME,NEWNAME, require EXPR, require,
-reset EXPR, reset, return EXPR, return, reverse LIST, rewinddir DIRHANDLE,
-rindex STR,SUBSTR,POSITION, rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///,
-scalar EXPR, seek FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select
-FILEHANDLE, select, select RBITS,WBITS,EBITS,TIMEOUT, semctl
-ID,SEMNUM,CMD,ARG, semget KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send
-SOCKET,MSG,FLAGS,TO, send SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority
-WHICH,WHO,PRIORITY, setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY,
-shift, shmctl ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE,
-shmwrite ID,STRING,POS,SIZE, shutdown SOCKET,HOW, sin EXPR, sin, sleep
-EXPR, sleep, socket SOCKET,DOMAIN,TYPE,PROTOCOL, socketpair
+DIRHANDLE, readline EXPR, readlink EXPR, readlink, readpipe EXPR, recv
+SOCKET,SCALAR,LEN,FLAGS, redo LABEL, redo, ref EXPR, ref, rename
+OLDNAME,NEWNAME, require EXPR, require, reset EXPR, reset, return EXPR,
+return, reverse LIST, rewinddir DIRHANDLE, rindex STR,SUBSTR,POSITION,
+rindex STR,SUBSTR, rmdir FILENAME, rmdir, s///, scalar EXPR, seek
+FILEHANDLE,POSITION,WHENCE, seekdir DIRHANDLE,POS, select FILEHANDLE,
+select, select RBITS,WBITS,EBITS,TIMEOUT, semctl ID,SEMNUM,CMD,ARG, semget
+KEY,NSEMS,FLAGS, semop KEY,OPSTRING, send SOCKET,MSG,FLAGS,TO, send
+SOCKET,MSG,FLAGS, setpgrp PID,PGRP, setpriority WHICH,WHO,PRIORITY,
+setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL, shift ARRAY, shift, shmctl
+ID,CMD,ARG, shmget KEY,SIZE,FLAGS, shmread ID,VAR,POS,SIZE, shmwrite
+ID,STRING,POS,SIZE, shutdown SOCKET,HOW, sin EXPR, sin, sleep EXPR, sleep,
+socket SOCKET,DOMAIN,TYPE,PROTOCOL, socketpair
 SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL, sort SUBNAME LIST, sort BLOCK LIST,
 sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH,
 splice ARRAY,OFFSET, split /PATTERN/,EXPR,LIMIT, split /PATTERN/,EXPR,
@@ -1316,9 +1324,10 @@ $CHILD_ERROR, $?, $OS_ERROR, $ERRNO, $!, $EXTENDED_OS_ERROR, $^E,
 $EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID, $UID, $<,
 $EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(,
 $EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $PERL_VERSION, $],
-$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $OSNAME,
-$^O, $PERLDB, $^P, $BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X,
-$ARGV, @ARGV, @INC, %INC, $ENV{expr}, $SIG{expr}, $^M
+$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $^M,
+$OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, $^S,
+$BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, $ARGV, @ARGV, @INC,
+@_, %INC, %ENV	$ENV{expr}, %SIG  $SIG{expr}
 
 =back
 
@@ -1390,16 +1399,16 @@ CPAN::Nox, Carp, Class::Struct, Config, Cwd, DB_File, Devel::SelfStubber,
 DirHandle, DynaLoader, English, Env, Exporter, ExtUtils::Embed,
 ExtUtils::Install, ExtUtils::Liblist, ExtUtils::MM_OS2, ExtUtils::MM_Unix,
 ExtUtils::MM_VMS, ExtUtils::MakeMaker, ExtUtils::Manifest,
-ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::testlib, Fcntl,
-File::Basename, File::CheckTree, File::Compare, File::Copy, File::Find,
-File::Path, File::stat, FileCache, FileHandle, FindBin, GDBM_File,
-Getopt::Long, Getopt::Std, I18N::Collate, IO, IO::File, IO::Handle,
-IO::Pipe, IO::Seekable, IO::Select, IO::Socket, IPC::Open2, IPC::Open3,
-Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig, NDBM_File,
-Net::Ping, Net::hostent, Net::netent, Net::protoent, Net::servent, Opcode,
-Pod::Text, POSIX, SDBM_File, Safe, Search::Dict, SelectSaver, SelfLoader,
-Shell, Socket, Symbol, Sys::Hostname, Sys::Syslog, Term::Cap,
-Term::Complete, Term::ReadLine, Test::Harness, Text::Abbrev,
+ExtUtils::Mkbootstrap, ExtUtils::Mksymlists, ExtUtils::testlib, Fatal,
+Fcntl, File::Basename, File::CheckTree, File::Compare, File::Copy,
+File::Find, File::Path, File::stat, FileCache, FileHandle, FindBin,
+GDBM_File, Getopt::Long, Getopt::Std, I18N::Collate, IO, IO::File,
+IO::Handle, IO::Pipe, IO::Seekable, IO::Select, IO::Socket, IPC::Open2,
+IPC::Open3, Math::BigFloat, Math::BigInt, Math::Complex, Math::Trig,
+NDBM_File, Net::Ping, Net::hostent, Net::netent, Net::protoent,
+Net::servent, Opcode, Pod::Text, POSIX, SDBM_File, Safe, Search::Dict,
+SelectSaver, SelfLoader, Shell, Socket, Symbol, Sys::Hostname, Sys::Syslog,
+Term::Cap, Term::Complete, Term::ReadLine, Test::Harness, Text::Abbrev,
 Text::ParseWords, Text::Soundex, Text::Tabs, Text::Wrap, Tie::Hash,
 Tie::RefHash, Tie::Scalar, Tie::SubstrHash, Time::Local, Time::gmtime,
 Time::localtime, Time::tm, UNIVERSAL, User::grent, User::pwent
@@ -1964,8 +1973,8 @@ C<compactDump>, C<veryCompact>, C<globPrint>, C<DumpDBFiles>,
 C<DumpPackages>, C<quote>, C<HighBit>, C<undefPrint>, C<UsageOnly>, C<TTY>,
 C<noTTY>, C<ReadLine>, C<NonStop>, E<lt> [ command ], E<lt>E<lt> command,
 E<gt> command, E<gt>E<gt> command, { [ command ], {{ command, ! number, !
--number, ! pattern, !! cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd, =
-[alias value], command, m expr, m package
+-number, ! pattern, !! cmd, H -number, q or ^D, R, |dbcmd, ||dbcmd,
+command, m expr, m package
 
 =item Debugger input/output
 
@@ -2061,8 +2070,7 @@ Numerical, Numerical, Numerical
 
 =item Precedence Traps
 
-Precedence, Precedence, Precedence, Precedence, Precedence, Precedence,
-Precedence
+Precedence, Precedence, Precedence, Precedence, Precedence, Precedence
 
 =item General Regular Expression Traps using s///, etc.
 
@@ -2089,7 +2097,8 @@ DBM, DBM
 
 =item Unclassified Traps
 
-Unclassified
+C<require>/C<do> trap using returned value, C<split> on empty string with
+LIMIT specified
 
 =back
 
@@ -2101,10 +2110,22 @@ Unclassified
 
 =item DESCRIPTION
 
+=over
+
+=item Verbatim Paragraph
+
+=item Command Paragraph
+
+=item Ordinary Block of Text
+
+=item The Intent
+
 =item Embedding Pods in Perl Modules
 
 =item Common Pod Pitfalls
 
+=back
+
 =item SEE ALSO
 
 =item AUTHOR
@@ -2165,8 +2186,8 @@ B<PerlIO *>, B<PerlIO_stdin()>, B<PerlIO_stdout()>, B<PerlIO_stderr()>,
 B<PerlIO_open(path, mode)>, B<PerlIO_fdopen(fd,mode)>,
 B<PerlIO_printf(f,fmt,...)>, B<PerlIO_vprintf(f,fmt,a)>,
 B<PerlIO_stdoutf(fmt,...)>, B<PerlIO_read(f,buf,count)>,
-B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(s,f)>,
-B<PerlIO_putc(c,f)>, B<PerlIO_ungetc(c,f)>, B<PerlIO_getc(f)>,
+B<PerlIO_write(f,buf,count)>, B<PerlIO_close(f)>, B<PerlIO_puts(f,s)>,
+B<PerlIO_putc(f,c)>, B<PerlIO_ungetc(f,c)>, B<PerlIO_getc(f)>,
 B<PerlIO_eof(f)>, B<PerlIO_error(f)>, B<PerlIO_fileno(f)>,
 B<PerlIO_clearerr(f)>, B<PerlIO_flush(f)>, B<PerlIO_tell(f)>,
 B<PerlIO_seek(f,o,w)>, B<PerlIO_getpos(f,p)>, B<PerlIO_setpos(f,p)>,
@@ -2365,6 +2386,17 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
 
 =item Understanding the Magic of Tied Hashes and Arrays
 
+=item Localizing changes
+
+C<SAVEINT(int i)>, C<SAVEIV(IV i)>, C<SAVEI32(I32 i)>, C<SAVELONG(long i)>,
+C<SAVESPTR(s)>, C<SAVEPPTR(p)>, C<SAVEFREESV(SV *sv)>, C<SAVEFREEOP(OP
+*op)>, C<SAVEFREEPV(p)>, C<SAVECLEARSV(SV *sv)>, C<SAVEDELETE(HV *hv, char
+*key, I32 length)>, C<SAVEDESTRUCTOR(f,p)>, C<SAVESTACK_POS()>, C<SV*
+save_scalar(GV *gv)>, C<AV* save_ary(GV *gv)>, C<HV* save_hash(GV *gv)>,
+C<void save_item(SV *item)>, C<void save_list(SV **sarg, I32 maxsarg)>,
+C<SV* save_svref(SV **sptr)>, C<void save_aptr(AV **aptr)>, C<void
+save_hptr(HV **hptr)>
+
 =back
 
 =item Subroutines
@@ -2410,8 +2442,8 @@ B<PerlIO_get_base(f)>, B<PerlIO_get_bufsiz(f)>
 AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop, av_push,
 av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak, CvSTASH,
 DBsingle, DBsub, DBtrace, dMARK, dORIGMARK, dowarn, dSP, dXSARGS, dXSI32,
-dXSI32, ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME,
-GIMME_V, G_NOARGS, G_SCALAR, G_VOID, gv_fetchmeth, gv_fetchmethod,
+ENTER, EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, GIMME_V,
+G_NOARGS, G_SCALAR, G_VOID, gv_fetchmeth, gv_fetchmethod,
 gv_fetchmethod_autoload, gv_stashpv, gv_stashsv, GvSV, HEf_SVKEY, HeHASH,
 HeKEY, HeKLEN, HePV, HeSVKEY, HeSVKEY_force, HeSVKEY_set, HeVAL, hv_clear,
 hv_delayfree_ent, hv_delete, hv_delete_ent, hv_exists, hv_exists_ent,
@@ -2421,26 +2453,30 @@ hv_store_ent, hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE,
 isUPPER, items, ix, LEAVE, MARK, mg_clear, mg_copy, mg_find, mg_free,
 mg_get, mg_len, mg_magical, mg_set, Move, na, New, Newc, Newz, newAV,
 newHV, newRV_inc, newRV_noinc, NEWSV, newSViv, newSVnv, newSVpv, newSVpvn,
-newSVpvf, newSVrv, newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, Nullhv,
-Nullsv, ORIGMARK, perl_alloc, perl_call_argv, perl_call_method, perl_call_pv,
-perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv,
-perl_free, perl_get_av, perl_get_cv, perl_get_hv, perl_get_sv, perl_parse,
-perl_require_pv, perl_run, POPi, POPl, POPp, POPn, POPs, PUSHMARK, PUSHi,
-PUSHn, PUSHp, PUSHs, PUTBACK, Renew, Renewc, RETVAL, safefree, safemalloc,
-saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN, ST, strEQ, strGE,
-strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal, sv_bless, sv_catpv,
-sv_catpvn, sv_catpvf, sv_catsv, sv_cmp, sv_cmp, SvCUR, SvCUR_set, sv_dec,
-sv_dec, SvEND, sv_eq, SvGROW, sv_grow, sv_inc, SvIOK, SvIOK_off, SvIOK_on,
-SvIOK_only, SvIOK_only, SvIOKp, sv_isa, SvIV, sv_isobject, SvIVX, SvLEN,
-sv_len, sv_len, sv_magic, sv_mortalcopy, SvOK, sv_newmortal, sv_no, SvNIOK,
-SvNIOK_off, SvNIOKp, SvNOK, SvNOK_off, SvNOK_on, SvNOK_only, SvNOK_only,
-SvNOKp, SvNV, SvNVX, SvPOK, SvPOK_off, SvPOK_on, SvPOK_only, SvPOK_only,
-SvPOKp, SvPV, SvPVX, SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK,
-SvROK_off, SvROK_on, SvRV, sv_setiv, sv_setnv, sv_setpv, sv_setpvn,
-sv_setpvf, sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn,
-sv_setsv, SvSTASH, SVt_IV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG,
-SVt_NV, SvTRUE, SvTYPE, svtype, SvUPGRADE, sv_upgrade, sv_undef, sv_unref,
-sv_usepvn, sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp,
+newSVrv, newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, Nullhv,
+Nullsv, ORIGMARK, perl_alloc, perl_call_argv, perl_call_method,
+perl_call_pv, perl_call_sv, perl_construct, perl_destruct, perl_eval_sv,
+perl_eval_pv, perl_free, perl_get_av, perl_get_cv, perl_get_hv,
+perl_get_sv, perl_parse, perl_require_pv, perl_run, POPi, POPl, POPp, POPn,
+POPs, PUSHMARK, PUSHi, PUSHn, PUSHp, PUSHs, PUTBACK, Renew, Renewc, RETVAL,
+safefree, safemalloc, saferealloc, savepv, savepvn, SAVETMPS, SP, SPAGAIN,
+ST, strEQ, strGE, strGT, strLE, strLT, strNE, strnEQ, strnNE, sv_2mortal,
+sv_bless, sv_catpv, sv_catpv_mg, sv_catpvn, sv_catpvn_mg, sv_catpvf,
+sv_catpvf_mg, sv_catsv, sv_catsv_mg, sv_cmp, SvCUR, SvCUR_set, sv_dec,
+SvEND, sv_eq, SvGETMAGIC, SvGROW, sv_grow, sv_inc, SvIOK, SvIOK_off,
+SvIOK_on, SvIOK_only, SvIOKp, sv_isa, SvIV, sv_isobject, SvIVX, SvLEN,
+sv_len, sv_magic, sv_mortalcopy, SvOK, sv_newmortal, sv_no, SvNIOK,
+SvNIOK_off, SvNIOKp, SvNOK, SvNOK_off, SvNOK_on, SvNOK_only, SvNOKp, SvNV,
+SvNVX, SvPOK, SvPOK_off, SvPOK_on, SvPOK_only, SvPOKp, SvPV, SvPVX,
+SvREFCNT, SvREFCNT_dec, SvREFCNT_inc, SvROK, SvROK_off, SvROK_on, SvRV,
+SvSETMAGIC, SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, sv_setiv,
+sv_setiv_mg, sv_setnv, sv_setnv_mg, sv_setpv, sv_setpv_mg, sv_setpviv,
+sv_setpviv_mg, sv_setpvn, sv_setpvn_mg, sv_setpvf, sv_setpvf_mg,
+sv_setref_iv, sv_setref_nv, sv_setref_pv, sv_setref_pvn, SvSetSV,
+SvSetSV_nosteal, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, SvSTASH,
+SVt_IV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE,
+SvTYPE, svtype, SvUPGRADE, sv_upgrade, sv_undef, sv_unref, sv_usepvn,
+sv_usepvn_mg, sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp,
 XPUSHs, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO,
 XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNV,
 XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK,
@@ -2532,8 +2568,42 @@ callback
 
 =item DATE
 
+=head2 perlhist - the Perl history records
+
+=item DESCRIPTION
+
+=item INTRODUCTION
+
+=item THE KEEPERS OF THE PUMPKIN
+
+=over
+
+=item PUMPKIN?
+
+=back
+
+=item THE RECORDS
+
+=over
+
+=item SELECTED RELEASE SIZES
+
+=item SELECTED PATCH SIZES
+
+=back
+
+=item THE KEEPERS OF THE RECORDS
+
 =head1 PRAGMA DOCUMENTATION
 
+=head2 attrs - set/get attributes of a subroutine
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+method, locked
+
 =head2 autouse - postpone load of modules until a function is used
 
 =item SYNOPSIS
@@ -2548,6 +2618,14 @@ callback
 
 =item SEE ALSO
 
+=head2 base - Establish IS-A relationship with base class at compile time
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item BUGS
+
 =head2 blib - Use MakeMaker's uninstalled version of a package
 
 =item SYNOPSIS
@@ -2597,6 +2675,12 @@ diagnostics
 
 =item AUTHOR
 
+=head2 fields - compile-time class fields
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
 =head2 integer - Perl pragma to compute arithmetic in integer instead of
 double
 
@@ -2637,14 +2721,6 @@ operations
 
 =item DESCRIPTION
 
-=head2 ops - Perl pragma to restrict unsafe operations when compiling
-
-=item SYNOPSIS	
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
 =head2 overload - Package for overloading perl operations
 
 =item SYNOPSIS
@@ -3104,7 +3180,7 @@ other) error log
 
 =item USING CGI::Push
 
--last_page, -type, -delay, -cookie, -target, -expires
+-next_page, -last_page, -type, -delay, -cookie, -target, -expires
 
 =item INSTALLING CGI::Push SCRIPTS
 
@@ -3147,12 +3223,14 @@ distribution
 
 =item recompile
 
-=item The 4 Classes: Authors, Bundles, Modules, Distributions
+=item The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
 
 =item ProgrammerE<39>s interface
 
 expand($type,@things), Programming Examples
 
+=item Methods in the four
+
 =item Cache Manager
 
 =item Bundles
@@ -3172,6 +3250,12 @@ E<lt>valueE<gt>, o conf E<lt>list optionE<gt>, o conf E<lt>list optionE<gt>
 [shift|pop], o conf E<lt>list optionE<gt> [unshift|push|splice]
 E<lt>listE<gt>
 
+=over
+
+=item CD-ROM support
+
+=back
+
 =item SECURITY
 
 =item EXPORT
@@ -3197,12 +3281,18 @@ module
 
 =item  SEE ALSO
 
-=head2 Carp, carp - warn of errors (from perspective of caller)
+=head2 Carp, carp    - warn of errors (from perspective of caller)
 
 =item SYNOPSIS
 
 =item DESCRIPTION
 
+=over
+
+=item Forcing a Stack Trace
+
+=back
+
 =head2 Class::Struct - declare struct-like datatypes as Perl classes
 
 =item SYNOPSIS
@@ -3226,27 +3316,13 @@ Example 1, Example 2
 
 =item Author and Modification History
 
-=head2 Config - access Perl configuration information
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-myconfig(), config_sh(), config_vars(@names)
-
-=item EXAMPLE
-
-=item WARNING
-
-=item NOTE
-
 =head2 Cwd, getcwd - get pathname of current working directory
 
 =item SYNOPSIS
 
 =item DESCRIPTION
 
-=head2 DB_File - Perl5 access to Berkeley DB
+=head2 DB_File - Perl5 access to Berkeley DB version 1.x
 
 =item SYNOPSIS
 
@@ -3256,6 +3332,8 @@ B<DB_HASH>, B<DB_BTREE>, B<DB_RECNO>
 
 =over
 
+=item Using DB_File with Berkeley DB version 2
+
 =item Interface to Berkeley DB
 
 =item Opening a Berkeley DB Database File
@@ -3344,6 +3422,8 @@ $value, $flags) ;>, B<$status = $X-E<gt>sync([$flags]) ;>
 
 =item AVAILABILITY
 
+=item COPYRIGHT
+
 =item SEE ALSO
 
 =item AUTHOR
@@ -3401,6 +3481,8 @@ variables
 
 =item Specialised Import Lists
 
+=item Exporting without using Export's import method
+
 =item Module Version Checking
 
 =item Managing Unknown Symbols
@@ -3512,9 +3594,9 @@ extliblist, file_name_is_absolute, find_perl
 
 =item Methods to actually produce chunks of text for the Makefile
 
-force (o), guess_name, has_link_code, init_dirscan, init_main, init_others,
-install (o), installbin (o), libscan (o), linkext (o), lsdir, macro (o),
-makeaperl (o), makefile (o), manifypods (o), maybe_command,
+fixin, force (o), guess_name, has_link_code, init_dirscan, init_main,
+init_others, install (o), installbin (o), libscan (o), linkext (o), lsdir,
+macro (o), makeaperl (o), makefile (o), manifypods (o), maybe_command,
 maybe_command_in_dirs, needs_linking (o), nicetext, parse_version, pasthru
 (o), path, perl_script, perldepend (o), pm_to_blib, post_constants (o),
 post_initialize (o), postamble (o), prefixify, processPL (o), realclean
@@ -3603,8 +3685,8 @@ dist_ci (o), dist_core (o), pasthru (o)
 
 =item Using Attributes and Parameters
 
-C, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS,
-EXCLUDE_EXT, EXE_FILES, NO_VC, FIRST_MAKEFILE, FULLPERL, H, INC,
+C, CCFLAGS, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS,
+EXCLUDE_EXT, EXE_FILES, NO_VC, FIRST_MAKEFILE, FULLPERL, H, IMPORTS, INC,
 INCLUDE_EXT, INSTALLARCHLIB, INSTALLBIN, INSTALLDIRS, INSTALLMAN1DIR,
 INSTALLMAN3DIR, INSTALLPRIVLIB, INSTALLSCRIPT, INSTALLSITELIB,
 INSTALLSITEARCH, INST_ARCHLIB, INST_BIN, INST_EXE, INST_LIB, INST_MAN1DIR,
@@ -3630,6 +3712,8 @@ tool_autosplit
   make distdir,    make tardist,    make dist,	  make uutardist,    make
 shdist,    make zipdist,    make ci
 
+=item Disabling an extension
+
 =back
 
 =item SEE ALSO
@@ -3657,14 +3741,6 @@ C<Added to MANIFEST:> I<file>
 
 =item AUTHOR
 
-=head2 ExtUtils::Miniperl, writemain - write the C code for perlmain.c
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
 =head2 ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
 
 =item SYNOPSIS
@@ -3690,6 +3766,14 @@ NAME, DL_FUNCS, DL_VARS, FILE, FUNCLIST, DLBASE
 
 =item DESCRIPTION
 
+=head2 Fatal - replace functions with equivalents which succeed or die
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item AUTHOR
+
 =head2 Fcntl - load the C Fcntl.h defines
 
 =item SYNOPSIS
@@ -3768,6 +3852,8 @@ rmscopy($from,$to[,$date_flag])
 
 =item DESCRIPTION
 
+=item BUGS
+
 =head2 File::Path - create or remove a series of directories
 
 =item SYNOPSIS
@@ -3841,7 +3927,7 @@ options
 
 =item DESCRIPTION
 
-E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f
+!, :s, :i, :f
 
 =over
 
@@ -3853,7 +3939,7 @@ E<lt>noneE<gt>, !, =s, :s, =i, :i, =f, :f
 
 =item Option starters
 
-=item Return value
+=item Return values and Errors
 
 =back
 
@@ -3872,6 +3958,10 @@ reset), debug (default: reset)
 
 $Getopt::Long::VERSION, $Getopt::Long::error
 
+=item AUTHOR
+
+=item COPYRIGHT AND DISCLAIMER
+
 =head2 Getopt::Std, getopt - Process single-character switches with switch
 clustering
 
@@ -3892,140 +3982,6 @@ locale
 
 =item DESCRIPTION
 
-=head2 IO::File - supply object methods for filehandles
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CONSTRUCTOR
-
-new ([ ARGS ] ), new_tmpfile
-
-=item METHODS
-
-open( FILENAME [,MODE [,PERMS]] )
-
-=item SEE ALSO
-
-=item HISTORY
-
-=head2 IO::Handle - supply object methods for I/O handles
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CONSTRUCTOR
-
-new (), new_from_fd ( FD, MODE )
-
-=item METHODS
-
-$fh->fdopen ( FD, MODE ), $fh->opened, $fh->getline, $fh->getlines,
-$fh->ungetc ( ORD ), $fh->write ( BUF, LEN [, OFFSET }\] ), $fh->flush,
-$fh->error, $fh->clearerr, $fh->untaint
-
-=item NOTE
-
-=item SEE ALSO
-
-=item BUGS
-
-=item HISTORY
-
-=head2 IO::Pipe, IO::pipe - supply object methods for pipes
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CONSTRCUTOR
-
-new ( [READER, WRITER] )
-
-=item METHODS
-
-reader ([ARGS]), writer ([ARGS]), handles ()
-
-=item SEE ALSO
-
-=item AUTHOR
-
-=item COPYRIGHT
-
-=head2 IO::Seekable - supply seek based methods for I/O objects
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item SEE ALSO
-
-=item HISTORY
-
-=head2 IO::Select - OO interface to the select system call
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CONSTRUCTOR
-
-new ( [ HANDLES ] )
-
-=item METHODS
-
-add ( HANDLES ), remove ( HANDLES ), exists ( HANDLE ), handles, can_read (
-[ TIMEOUT ] ), can_write ( [ TIMEOUT ] ), has_error ( [ TIMEOUT ] ), count
-(), bits(), bits(), select ( READ, WRITE, ERROR [, TIMEOUT ] )
-
-=item EXAMPLE
-
-=item AUTHOR
-
-=item COPYRIGHT
-
-=head2 IO::Socket - Object interface to socket communications
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-=item CONSTRUCTOR
-
-new ( [ARGS] )
-
-=item METHODS
-
-accept([PKG]), timeout([VAL]), sockopt(OPT [, VAL]), sockdomain, socktype,
-protocol
-
-=item SUB-CLASSES
-
-=over
-
-=item IO::Socket::INET
-
-=item METHODS
-
-sockaddr (), sockport (), sockhost (), peeraddr (), peerport (), peerhost
-()
-
-=item IO::Socket::UNIX
-
-=item METHODS
-
-hostpath(), peerpath()
-
-=back
-
-=item SEE ALSO
-
-=item AUTHOR
-
-=item COPYRIGHT
-
 =head2 IO::lib::IO::File, IO::File - supply object methods for filehandles
 
 =item SYNOPSIS
@@ -4224,7 +4180,9 @@ functions
 
 =item USAGE
 
-=item ERRORS DUE TO DIVISION BY ZERO
+=item ERRORS DUE TO DIVISION BY ZERO OR LOGARITHM OF ZERO
+
+=item ERRORS DUE TO INDIGESTIBLE ARGUMENTS
 
 =item BUGS
 
@@ -4362,8 +4320,9 @@ opdump (PAT)
 =item Predefined Opcode Tags
 
 :base_core, :base_mem, :base_loop, :base_io, :base_orig, :base_math,
-:default, :filesys_read, :sys_db, :browse, :filesys_open, :filesys_write,
-:subprocess, :ownprocess, :others, :still_to_be_decided, :dangerous
+:base_thread, :default, :filesys_read, :sys_db, :browse, :filesys_open,
+:filesys_write, :subprocess, :ownprocess, :others, :still_to_be_decided,
+:dangerous
 
 =item SEE ALSO
 
@@ -4572,35 +4531,6 @@ nonetscape, index, noindex, recurse, norecurse, title, verbose
 
 =item DESCRIPTION
 
-=head2 Safe - Compile and execute code in restricted compartments
-
-=item SYNOPSIS
-
-=item DESCRIPTION
-
-a new namespace, an operator mask
-
-=item WARNING
-
-=over
-
-=item RECENT CHANGES
-
-=item Methods in class Safe
-
-permit (OP, ...), permit_only (OP, ...), deny (OP, ...), deny_only (OP,
-...), trap (OP, ...), untrap (OP, ...), share (NAME, ...), share_from
-(PACKAGE, ARRAYREF), varglob (VARNAME), reval (STRING), rdo (FILENAME),
-root (NAMESPACE), mask (MASK)
-
-=item Some Safety Issues
-
-Memory, CPU, Snooping, Signals, State Changes
-
-=item AUTHOR
-
-=back
-
 =head2 Search::Dict, look - search for key in dictionary file
 
 =item SYNOPSIS
@@ -4680,7 +4610,15 @@ interface to the UNIX syslog(3) calls
 =item DESCRIPTION
 
 openlog $ident, $logopt, $facility, syslog $priority, $format, @args,
-setlogmask $mask_priority, closelog
+setlogmask $mask_priority, setlogsock $sock_type (added in 5.004_03) 
+Sets the socket type to be used for the next call to
+C<openlog()> or C<syslog()>.
+
+A value of 'unix' will connect to the UNIX domain socket returned by
+C<_PATH_LOG> in F<syslog.ph>. If F<syslog.ph> fails to define
+C<_PATH_LOG>, C<setlogsock> returns C<undef>; otherwise a true value is
+returned. A value of 'inet' will connect to an INET socket returned by
+getservbyname().  Any other value croaks, closelog
 
 =item EXAMPLES
 
@@ -4726,6 +4664,8 @@ C<MinLine>, C<findConsole>, Attribs, C<Features>
 
 =item Additional supported functions
 
+C<tkRunning>, C<ornaments>, C<newTTY>
+
 =item EXPORTS
 
 =item ENVIRONMENT
@@ -4809,6 +4749,41 @@ unexpand(1)
 
 =item AUTHOR
 
+=head2 Thread - multithreading
+
+=item SYNOPSIS
+
+=item DESCRIPTION
+
+=item SEE ALSO
+
+=head2 Thread::Queue - thread-safe queues
+
+=item SYNOPSIS
+
+=head2 Thread::Semaphore - thread-safe semaphores
+
+=item SYNOPSIS
+
+=head2 Thread::Specific - thread-specific keys
+
+=item SYNOPSIS
+
+=head2 Tie::Array - base class for tied arrays
+
+=item SYNOPSIS	
+
+=item DESCRIPTION	
+
+TIEARRAY classname, LIST, STORE this, index, value, FETCH this, index,
+FETCHSIZE this, STORESIZE this, count, EXTEND this, count, CLEAR this,
+DESTROY this, PUSH this, LIST, POP this, SHIFT this, UNSHIFT this, LIST,
+SPLICE this, offset, length, LIST
+
+=item CAVEATS
+
+=item AUTHOR 
+
 =head2 Tie::Hash, Tie::StdHash - base class definitions for tied hashes
 
 =item SYNOPSIS
@@ -4897,8 +4872,8 @@ function
 
 =item DESCRIPTION
 
-isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), isa ( VAL, TYPE ),
-can ( VAL, METHOD )
+isa ( TYPE ), can ( METHOD ), VERSION ( [ REQUIRE ] ), UNIVERSAL::isa (
+VAL, TYPE ), UNIVERSAL::can ( VAL, METHOD )
 
 =head2 User::grent - by-name interface to Perl's built-in getgr*()
 functions
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 6a1ed81c5d..3ab11ef2ae 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -451,7 +451,7 @@ the same as C<$!>.
 Under VMS, C<$^E> provides the VMS status value from the last
 system error.  This is more specific information about the last
 system error than that provided by C<$!>.  This is particularly
-important when C<$!> is set to E<EVMSERR>.
+important when C<$!> is set to B<EVMSERR>.
 
 Under OS/2, C<$^E> is set based on the value returned by the OS/2
 call C<_syserrno()> only when a call into the OS/2 API generates
diff --git a/pp.c b/pp.c
index c98ac83cb3..c78c845ce1 100644
--- a/pp.c
+++ b/pp.c
@@ -2760,9 +2760,8 @@ PP(pp_unshift)
     MAGIC *mg;
 
     if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-
-
 	*MARK-- = mg->mg_obj;
+	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
 	perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
diff --git a/pp_sys.c b/pp_sys.c
index 55d00edba8..3f30b63200 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -79,7 +79,7 @@ extern int h_errno;
 #endif
 
 #ifdef I_UTIME
-#  ifdef _MSC_VER
+#  if defined(_MSC_VER) || defined(__MINGW32__)
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
diff --git a/regcomp.c b/regcomp.c
index 363a14bca8..fc6b131256 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -162,6 +162,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
 #define SF_HAS_PAR		0x80
 #define SF_IN_PAR		0x100
 #define SF_HAS_EVAL		0x200
+#define SCF_DO_SUBSTR		0x400
 
 STATIC void
 scan_commit(scan_data_t *data)
@@ -195,8 +196,6 @@ scan_commit(scan_data_t *data)
     data->flags &= ~SF_BEFORE_EOL;
 }
 
-#define SCF_DO_SUBSTR 1
-
 /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
    to the position after last scanned or to NULL. */
 
diff --git a/sv.c b/sv.c
index 93fcaa60be..a4d72bcf42 100644
--- a/sv.c
+++ b/sv.c
@@ -65,6 +65,8 @@ static void sv_mortalgrow _((void));
 static void sv_unglob _((SV* sv));
 static void sv_check_thinkfirst _((SV *sv));
 
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
+
 #ifndef PURIFY
 static void *my_safemalloc(MEM_SIZE size);
 #endif
@@ -1112,7 +1114,7 @@ sv_grow(SV* sv, unsigned long newlen)
 void
 sv_setiv(register SV *sv, IV i)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
 	sv_upgrade(sv, SVt_IV);
@@ -1173,7 +1175,7 @@ sv_setuv_mg(register SV *sv, UV u)
 void
 sv_setnv(register SV *sv, double num)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     case SVt_IV:
@@ -1875,7 +1877,7 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     if (sstr == dstr)
 	return;
-    sv_check_thinkfirst(dstr);
+    SV_CHECK_THINKFIRST(dstr);
     if (!sstr)
 	sstr = &sv_undef;
     stype = SvTYPE(sstr);
@@ -2210,7 +2212,7 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
     register char *dptr;
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
 			  elicit a warning, but it won't hurt. */
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
 	(void)SvOK_off(sv);
 	return;
@@ -2243,7 +2245,7 @@ sv_setpv(register SV *sv, register const char *ptr)
 {
     register STRLEN len;
 
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
 	(void)SvOK_off(sv);
 	return;
@@ -2273,7 +2275,7 @@ sv_setpv_mg(register SV *sv, register const char *ptr)
 void
 sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
     if (!ptr) {
 	(void)SvOK_off(sv);
@@ -2300,15 +2302,13 @@ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
 STATIC void
 sv_check_thinkfirst(register SV *sv)
 {
-    if (SvTHINKFIRST(sv)) {
-	if (SvREADONLY(sv)) {
-	    dTHR;
-	    if (curcop != &compiling)
-		croak(no_modify);
-	}
-	if (SvROK(sv))
-	    sv_unref(sv);
+    if (SvREADONLY(sv)) {
+	dTHR;
+	if (curcop != &compiling)
+	    croak(no_modify);
     }
+    if (SvROK(sv))
+	sv_unref(sv);
 }
     
 void
@@ -2320,7 +2320,7 @@ sv_chop(register SV *sv, register char *ptr)	/* like set but assuming ptr is in
 
     if (!ptr || !SvPOKp(sv))
 	return;
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvTYPE(sv) < SVt_PVIV)
 	sv_upgrade(sv,SVt_PVIV);
 
@@ -2693,7 +2693,7 @@ void
 sv_replace(register SV *sv, register SV *nsv)
 {
     U32 refcnt = SvREFCNT(sv);
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvREFCNT(nsv) != 1)
 	warn("Reference miscount in sv_replace()");
     if (SvMAGICAL(sv)) {
@@ -3090,7 +3090,7 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append)
     register I32 cnt;
     I32 i;
 
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
     SvSCREAM_off(sv);
 
@@ -3994,7 +3994,7 @@ newSVrv(SV *rv, char *classname)
     SvREFCNT(sv) = 0;
     SvFLAGS(sv) = 0;
 
-    sv_check_thinkfirst(rv);
+    SV_CHECK_THINKFIRST(rv);
 #ifdef OVERLOAD
     SvAMAGIC_off(rv);
 #endif /* OVERLOAD */
diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t
index 854f146337..ce3003e5b7 100755
--- a/t/lib/anydbm.t
+++ b/t/lib/anydbm.t
@@ -85,7 +85,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -94,7 +94,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index fea0cd7fb7..2395611d1e 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -87,7 +87,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -96,7 +96,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index db9846a8cb..a97dbd1f1e 100755
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index 65c9870a02..8ba9bcf3a4 100755
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index 90dbb841e6..c2952ecf68 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -90,7 +90,7 @@ delete $h{'goner3'};
 
 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
 
-while (($key,$value) = each(h)) {
+while (($key,$value) = each(%h)) {
     if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
@@ -99,7 +99,7 @@ while (($key,$value) = each(h)) {
 
 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
 
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
 
 $h{'foo'} = '';
diff --git a/t/op/array.t b/t/op/array.t
index db70c3981f..f307655ced 100755
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $
 
-print "1..39\n";
+print "1..40\n";
 
 @ary = (1,2,3,4,5);
 if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
@@ -144,3 +144,7 @@ eval {
 };
 print "not " unless $@ =~ /Can't multiply inherit %FIELDS/;
 print "ok 39\n";
+
+@foo = ( 'foo', 'bar', 'burbl');
+push(foo, 'blah');
+print $#foo == 3 ? "ok 40\n" : "not ok 40\n";
diff --git a/t/op/delete.t b/t/op/delete.t
index 4e00566cd7..6cc447506a 100755
--- a/t/op/delete.t
+++ b/t/op/delete.t
@@ -29,17 +29,17 @@ if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
 if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
 if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
 
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
 if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
 
-foreach $key (keys foo) {
+foreach $key (keys %foo) {
     delete $foo{$key};
 }
 
 $foo{'foo'} = 'x';
 $foo{'bar'} = 'y';
 
-$foo = join('',values(foo));
+$foo = join('',values(%foo));
 print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
 
 $refhash{"top"}->{"foo"} = "FOO";
diff --git a/t/op/each.t b/t/op/each.t
index b92dd1770c..420fdc09c3 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
 
-print "1..14\n";
+print "1..16\n";
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -107,3 +107,15 @@ print "ok 13\n";
 print "not " if keys(%hash) != 10;
 print "ok 14\n";
 
+print keys(hash) != 10 ? "not ok 15\n" : "ok 15\n";
+
+$i = 0;
+%h = (a => A, b => B, c=> C, d => D, abc => ABC);
+@keys = keys(h);
+@values = values(h);
+while (($key, $value) = each(h)) {
+	if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+		$i++;
+	}
+}
+if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
diff --git a/t/op/flip.t b/t/op/flip.t
index 7852d0cee9..20167f3333 100755
--- a/t/op/flip.t
+++ b/t/op/flip.t
@@ -6,7 +6,7 @@ print "1..9\n";
 
 @a = (1,2,3,4,5,6,7,8,9,10,11,12);
 
-while ($_ = shift(a)) {
+while ($_ = shift(@a)) {
     if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
     $y .= /1/../2/;
 }
diff --git a/t/op/pat.t b/t/op/pat.t
index 5ea9bb44ae..e6b90158f9 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -67,7 +67,7 @@ $XXX{234} = 234;
 $XXX{345} = 345;
 
 @XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
-while ($_ = shift(XXX)) {
+while ($_ = shift(@XXX)) {
     ?(.*)? && (print $1,"\n");
     /not/ && reset;
     /not ok 26/ && reset 'X';
diff --git a/t/op/push.t b/t/op/push.t
index f62a4e9d8e..a67caed2b3 100755
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -16,7 +16,7 @@
 -4,			4 5 6 7,	0 1 2 3
 EOF
 
-print "1..", 2 + @tests, "\n";
+print "1..", 4 + @tests, "\n";
 die "blech" unless @tests;
 
 @x = (1,2,3);
@@ -25,7 +25,13 @@ if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
 push(@x,4);
 if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
 
-$test = 3;
+# test for push/pop intuiting @ on array
+push(x,3);
+if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";}
+pop(x);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$test = 5;
 foreach $line (@tests) {
     ($list,$get,$leave) = split(/,\t*/,$line);
     ($pos, $len, @list) = split(' ',$list);
diff --git a/t/op/wantarray.t b/t/op/wantarray.t
new file mode 100755
index 0000000000..0a47b6d3ba
--- /dev/null
+++ b/t/op/wantarray.t
@@ -0,0 +1,16 @@
+#!./perl
+
+print "1..3\n";
+sub context {
+  my ( $cona, $testnum ) = @_;
+  my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+  unless ( $cona eq $conb ) {
+	print "# Context $conb should be $cona\nnot ";
+  }
+  print "ok $testnum\n";
+}
+
+context('V',1);
+$a = context('S',2);
+@a = context('A',3);
+1;
diff --git a/vms/config.vms b/vms/config.vms
index 9c31ace90c..0320012c72 100644
--- a/vms/config.vms
+++ b/vms/config.vms
@@ -1892,6 +1892,51 @@
  */
 #define HAS_GETHOSTENT		/**/      /* config-skip */
 
+/* HAS_GETHOSTBYADDR:
+ *	This symbol, if defined, indicates that the gethostbyaddr routine is
+ *	available to lookup hosts by their IP addresses.
+ */
+#define HAS_GETHOSTBYADDR		/**/
+
+/* Netdb_host_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to gethostbyaddr().
+ */
+#define Netdb_host_t		char * /**/
+
+/* Netdb_hlen_t:
+ *	This symbol holds the type used for the 2nd argument
+ *	to gethostbyaddr().
+ */
+#define Netdb_hlen_t		int
+
+/* HAS_GETHOSTBYNAME:
+ *	This symbol, if defined, indicates that the gethostbyname routine is
+ *	available to lookup hosts by their DNS names.
+ */
+#define HAS_GETHOSTBYNAME		/**/
+
+/* Netdb_name_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to gethostbyname(), the 1st argument to getnetbyname(),
+ *	the 1st argument to getprotobyname(), the 1st argument to
+ *	getservbyname(), the 2nd argument to getservbyname(),
+ *	and the 2nd argument to getservbyport().
+ */
+#define Netdb_name_t	long    /**/
+
+/* HAS_GETNETBYADD:
+ *	This symbol, if defined, indicates that the getnetbyaddr routine is
+ *	available to lookup networks by their IP addresses.
+ */
+#define HAS_GETNETBYADD		/**/
+
+/* Netdb_net_t:
+ *	This symbol holds the type used for the 1st argument
+ *	to getnetbyaddr().
+ */
+#define Netdb_net_t		long
+
 /* HAS_GETHBADD:
  *	This symbol, if defined, indicates that the gethostbyaddr routine is
  *	available to lookup host names by their IP addresses.
diff --git a/win32/Makefile b/win32/Makefile
index 682c5d823e..05fe4ffb16 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -113,9 +113,9 @@ OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
 LINK_DBG = -debug -pdb:none
 !ELSE
 !  IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
 !  ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
 !  ENDIF
 LINK_DBG = -release
 !ENDIF
@@ -315,7 +315,7 @@ CORE_H = ..\av.h	\
 	.\include\sys\socket.h	\
 	.\win32.h
 
-DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread
+DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B
 STATIC_EXT=DynaLoader
 
 DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
@@ -326,6 +326,7 @@ SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
 IO=$(EXTDIR)\IO\IO
 ATTRS=$(EXTDIR)\attrs\attrs
 THREAD=$(EXTDIR)\Thread\Thread
+B=$(EXTDIR)\B\B
 
 SOCKET_DLL=..\lib\auto\Socket\Socket.dll
 FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
@@ -334,6 +335,7 @@ SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
 IO_DLL=..\lib\auto\IO\IO.dll
 ATTRS_DLL=..\lib\auto\attrs\attrs.dll
 THREAD_DLL=..\lib\auto\Thread\Thread.dll
+B_DLL=..\lib\auto\B\B.dll
 
 STATICLINKMODULES=DynaLoader
 DYNALOADMODULES=	\
@@ -343,7 +345,8 @@ DYNALOADMODULES=	\
 	$(SDBM_FILE_DLL)\
 	$(IO_DLL)	\
 	$(ATTRS_DLL)	\
-	$(THREAD_DLL)
+	$(THREAD_DLL)	\
+	$(B_DLL)
 
 POD2HTML=$(PODDIR)\pod2html
 POD2MAN=$(PODDIR)\pod2man
@@ -478,7 +481,7 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
 $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
 	copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
 
-$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+$(B_DLL): $(PERLEXE) $(B).xs
 	cd $(EXTDIR)\$(*B)
 	..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
 	$(MAKE)
@@ -490,6 +493,11 @@ $(THREAD_DLL): $(PERLEXE) $(THREAD).xs
 	$(MAKE)
 	cd ..\..\win32
 
+$(ATTRS_DLL): $(PERLEXE) $(ATTRS).xs
+	cd $(EXTDIR)\$(*B)
+	..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+	$(MAKE)
+	cd ..\..\win32
 
 $(IO_DLL): $(PERLEXE) $(CONFIGPM) $(IO).xs
 	cd $(EXTDIR)\$(*B)
@@ -547,9 +555,9 @@ distclean: clean
 		$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
 	-del /f *.def *.map
 	-del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
-		$(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL)
+		$(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL)
 	-del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
-		$(DYNALOADER).c $(ATTRS).c $(THREAD).c
+		$(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c
 	-del /f $(PODDIR)\*.html
 	-del /f $(PODDIR)\*.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c \
diff --git a/win32/config.gc b/win32/config.gc
index c8d11d88ca..e0617be2ab 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -372,7 +372,7 @@ known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_
 ksh=''
 large=''
 ld='gcc'
-lddlflags='-dll ~LINK_FLAGS~'
+lddlflags='-mdll ~LINK_FLAGS~'
 ldflags='~LINK_FLAGS~'
 less='less'
 lib_ext='.lib'
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 73a7858351..5aceb31794 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -48,7 +48,7 @@ CCTYPE		*= BORLAND
 # set the install locations of the compiler include/libraries
 #CCHOME		*= f:\msdev\vc
 CCHOME		*= C:\bc5
-#CCHOME		*= C:\mingw32
+#CCHOME		*= D:\packages\mingw32
 CCINCDIR	*= $(CCHOME)\include
 CCLIBDIR	*= $(CCHOME)\lib
 
@@ -136,7 +136,7 @@ EXEOUT_FLAG = -e
 .ELIF "$(CCTYPE)" == "GCC"
 
 CC = gcc -pipe
-LINK32 = gcc
+LINK32 = gcc -pipe
 LIB32 = ar
 IMPLIB = dlltool
 
@@ -207,9 +207,9 @@ OPTIMIZE = -Od $(RUNTIME)d -Z7 -D_DEBUG -DDEBUGGING
 LINK_DBG = -debug -pdb:none
 .ELSE
 .IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
 .ELSE
-OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE = -O1 $(RUNTIME) -DNDEBUG
 .ENDIF
 LINK_DBG = -release
 .ENDIF
@@ -243,7 +243,7 @@ o *= .obj
 .SUFFIXES : .c $(o) .dll .lib .exe .a
 
 .c$(o):
-	$(CC) -c -I$(<:d) $(CFLAGS) $(OBJOUT_FLAG)$@ $<
+	$(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS) $(OBJOUT_FLAG)$@ $<
 
 .y.c:
 	$(NOOP)
@@ -434,7 +434,7 @@ CORE_H = ..\av.h	\
 	.\include\sys\socket.h	\
 	.\win32.h
 
-DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread
+DYNAMIC_EXT=Socket IO Fcntl Opcode SDBM_File attrs Thread B
 STATIC_EXT=DynaLoader
 
 DYNALOADER=$(EXTDIR)\DynaLoader\DynaLoader
@@ -445,6 +445,7 @@ SDBM_FILE=$(EXTDIR)\SDBM_File\SDBM_File
 IO=$(EXTDIR)\IO\IO
 ATTRS=$(EXTDIR)\attrs\attrs
 THREAD=$(EXTDIR)\Thread\Thread
+B=$(EXTDIR)\B\B
 
 SOCKET_DLL=..\lib\auto\Socket\Socket.dll
 FCNTL_DLL=..\lib\auto\Fcntl\Fcntl.dll
@@ -453,6 +454,7 @@ SDBM_FILE_DLL=..\lib\auto\SDBM_File\SDBM_File.dll
 IO_DLL=..\lib\auto\IO\IO.dll
 ATTRS_DLL=..\lib\auto\attrs\attrs.dll
 THREAD_DLL=..\lib\auto\Thread\Thread.dll
+B_DLL=..\lib\auto\B\B.dll
 
 STATICLINKMODULES=DynaLoader
 DYNALOADMODULES=	\
@@ -462,7 +464,8 @@ DYNALOADMODULES=	\
 	$(SDBM_FILE_DLL)\
 	$(IO_DLL)	\
 	$(ATTRS_DLL)	\
-	$(THREAD_DLL)
+	$(THREAD_DLL)	\
+	$(B_DLL)
 
 POD2HTML=$(PODDIR)\pod2html
 POD2MAN=$(PODDIR)\pod2man
@@ -568,7 +571,7 @@ $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
 		perldll.def\n)
 	$(IMPLIB) $*.lib $@
 .ELIF "$(CCTYPE)" == "GCC"
-	$(LINK32) -dll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \
+	$(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \
 	    $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \
 	        $(DLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST))
 	dlltool --output-lib $(PERLIMPLIB) \
@@ -576,7 +579,7 @@ $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)
                 --def perldll.def \
                 --base-file perl.base \
                 --output-exp perl.exp
-	$(LINK32) -dll -o $@ $(LINK_FLAGS) \
+	$(LINK32) -mdll -o $@ $(LINK_FLAGS) \
 	    $(mktmp $(LKPRE) $(CORE_OBJ:s,\,\\) $(WIN32_OBJ:s,\,\\) \
 	        $(DLL_OBJ:s,\,\\) $(LIBFILES) perl.exp $(LKPOST))
 .ELSE
@@ -659,6 +662,11 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
 $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
 	copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
 
+$(B_DLL): $(PERLEXE) $(B).xs
+	cd $(EXTDIR)\$(*B) && \
+	..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
+	cd $(EXTDIR)\$(*B) && $(MAKE)
+
 $(THREAD_DLL): $(PERLEXE) $(THREAD).xs
 	cd $(EXTDIR)\$(*B) && \
 	..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl
@@ -716,9 +724,9 @@ distclean: clean
 		$(PERLIMPLIB) ..\miniperl.lib $(MINIMOD)
 	-del /f *.def *.map
 	-del /f $(SOCKET_DLL) $(IO_DLL) $(SDBM_FILE_DLL) $(FCNTL_DLL) \
-		$(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL)
+		$(OPCODE_DLL) $(ATTRS_DLL) $(THREAD_DLL) $(B_DLL)
 	-del /f $(SOCKET).c $(IO).c $(SDBM_FILE).c $(FCNTL).c $(OPCODE).c \
-		$(DYNALOADER).c $(ATTRS).c $(THREAD).c
+		$(DYNALOADER).c $(ATTRS).c $(THREAD).c $(B).c
 	-del /f $(PODDIR)\*.html
 	-del /f $(PODDIR)\*.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
diff --git a/win32/win32.c b/win32/win32.c
index 3eeaa6a988..9d819b518f 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -36,7 +36,7 @@
 #include <stdarg.h>
 #include <float.h>
 #include <time.h>
-#ifdef _MSC_VER
+#if defined(_MSC_VER) || defined(__MINGW32__)
 #include <sys/utime.h>
 #else
 #include <utime.h>
@@ -1193,7 +1193,7 @@ win32_strerror(int e)
 }
 
 DllExport void
-win32_str_os_error(SV *sv, unsigned long dwErr)
+win32_str_os_error(void *sv, DWORD dwErr)
 {
     DWORD dwLen;
     char *sMsg;
@@ -1214,7 +1214,7 @@ win32_str_os_error(SV *sv, unsigned long dwErr)
 			"Unknown error #0x%lX (lookup 0x%lX)",
 			dwErr, GetLastError());
     }
-    sv_setpvn(sv, sMsg, dwLen);
+    sv_setpvn((SV*)sv, sMsg, dwLen);
     LocalFree(sMsg);
 }
 
diff --git a/win32/win32.h b/win32/win32.h
index 31aadf960e..8b9be40130 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -143,6 +143,9 @@ typedef long		gid_t;
 
 typedef long		uid_t;
 typedef long		gid_t;
+#define _environ	environ
+#define flushall	_flushall
+#define fcloseall	_fcloseall
 
 #endif /* __MINGW32__ */
 
@@ -171,7 +174,7 @@ extern	char *	getlogin(void);
 
 DllExport void		Perl_win32_init(int *argcp, char ***argvp);
 DllExport void		Perl_init_os_extras(void);
-DllExport void		win32_str_os_error(struct sv *s, DWORD err);
+DllExport void		win32_str_os_error(void *sv, DWORD err);
 
 #ifndef USE_SOCKETS_AS_HANDLES
 extern FILE *		my_fdopen(int, char *);
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 7e03a9aeb4..a17134b0ff 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -13,7 +13,7 @@
 #endif
 #endif
 
-#ifdef _MSC_VER
+#if defined(_MSC_VER) || defined(__MINGW32__)
 #  include <sys/utime.h>
 #else
 #  include <utime.h>
diff --git a/win32/win32thread.h b/win32/win32thread.h
index acb136c690..512e6296e5 100644
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -166,7 +166,8 @@ END_EXTERN_C
 #define JOIN(t, avp)							\
     STMT_START {							\
 	if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED)	\
-	     || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0))	\
+	     || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0)	\
+	     || (CloseHandle((t)->self) == 0))				\
 	    croak("panic: JOIN");					\
 	*avp = (AV *)((t)->i.retv);					\
     } STMT_END
@@ -174,7 +175,8 @@ END_EXTERN_C
 #define JOIN(t, avp)							\
     STMT_START {							\
 	if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED)	\
-	     || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0))	\
+	     || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0)	\
+	     || (CloseHandle((t)->self) == 0))				\
 	    croak("panic: JOIN");					\
     } STMT_END
 #endif	/* !USE_RTL_THREAD_API || _MSC_VER */
diff --git a/x2p/a2p.h b/x2p/a2p.h
index a7cbcb68b3..2db5f36ebc 100644
--- a/x2p/a2p.h
+++ b/x2p/a2p.h
@@ -20,6 +20,10 @@
 #  include "../config.h"
 #endif
 
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
 #ifdef WIN32
 #undef USE_STDIO_PTR		/* XXX fast gets won't work, must investigate */
 #  ifndef STANDARD_C
@@ -40,10 +44,6 @@
 #  endif
 #endif
 
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
-# define STANDARD_C 1
-#endif
-
 /* Use all the "standard" definitions? */
 #if defined(STANDARD_C) && defined(I_STDLIB)
 #   include <stdlib.h>
author	Gurusamy Sarathy <gsar@cpan.org>	1998-02-22 03:09:55 +0000
committer	Gurusamy Sarathy <gsar@cpan.org>	1998-02-22 03:09:55 +0000
commit	611e57134ef8720264c53f5e0589f41461af4dcb (patch)
tree	7901de389646fca2b4f19dc03c78c679f294afa4
parent	6ad2b1bc3b01dc0cbc9f3d6840532b8e64de9f53 (diff)
parent	2a321948466e7bb48bfd30dd6612a9a479df612a (diff)
download	perl-611e57134ef8720264c53f5e0589f41461af4dcb.tar.gz