Re: [PATCH] ExtUtils-{ParseXS,CBuilder} into bleadperl (was: Re: [Module::Build] ANNOUNCE: Module::Build 0.2610 -> CPAN)

Message-ID: <20050518141131.GA2704@efn.org>

p4raw-id: //depot/perl@24500

17 files changed, 3750 insertions, 1813 deletions

diff --git a/lib/ExtUtils/CBuilder.pm b/lib/ExtUtils/CBuilder.pm
new file mode 100644
index 0000000000..deb1fd88a1
--- /dev/null
+++ b/lib/ExtUtils/CBuilder.pm
@@ -0,0 +1,303 @@
+package ExtUtils::CBuilder;
+
+use File::Spec ();
+use File::Path ();
+use File::Basename ();
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.11_01';
+$VERSION = eval $VERSION;
+
+# Okay, this is the brute-force method of finding out what kind of
+# platform we're on.  I don't know of a systematic way.  These values
+# came from the latest (bleadperl) perlport.pod.
+
+my %OSTYPES = qw(
+		 aix       Unix
+		 bsdos     Unix
+		 dgux      Unix
+		 dynixptx  Unix
+		 freebsd   Unix
+		 linux     Unix
+		 hpux      Unix
+		 irix      Unix
+		 darwin    Unix
+		 machten   Unix
+		 next      Unix
+		 openbsd   Unix
+		 netbsd    Unix
+		 dec_osf   Unix
+		 svr4      Unix
+		 svr5      Unix
+		 sco_sv    Unix
+		 unicos    Unix
+		 unicosmk  Unix
+		 solaris   Unix
+		 sunos     Unix
+		 cygwin    Unix
+		 os2       Unix
+		 
+		 dos       Windows
+		 MSWin32   Windows
+
+		 os390     EBCDIC
+		 os400     EBCDIC
+		 posix-bc  EBCDIC
+		 vmesa     EBCDIC
+
+		 MacOS     MacOS
+		 VMS       VMS
+		 VOS       VOS
+		 riscos    RiscOS
+		 amigaos   Amiga
+		 mpeix     MPEiX
+		);
+
+# We only use this once - don't waste a symbol table entry on it.
+# More importantly, don't make it an inheritable method.
+my $load = sub {
+  my $mod = shift;
+  eval "use $mod";
+  die $@ if $@;
+  @ISA = ($mod);
+};
+
+{
+  my @package = split /::/, __PACKAGE__;
+  
+  if (grep {-e File::Spec->catfile($_, @package, 'Platform', $^O) . '.pm'} @INC) {
+    $load->(__PACKAGE__ . "::Platform::$^O");
+    
+  } elsif (exists $OSTYPES{$^O} and
+	   grep {-e File::Spec->catfile($_, @package, 'Platform', $OSTYPES{$^O}) . '.pm'} @INC) {
+    $load->(__PACKAGE__ . "::Platform::$OSTYPES{$^O}");
+    
+  } else {
+    $load->(__PACKAGE__ . "::Base");
+  }
+}
+
+sub os_type { $OSTYPES{$^O} }
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::CBuilder - Compile and link C code for Perl modules
+
+=head1 SYNOPSIS
+
+  use ExtUtils::CBuilder;
+
+  my $b = ExtUtils::CBuilder->new(%options);
+  $obj_file = $b->compile(source => 'MyModule.c');
+  $lib_file = $b->link(objects => $obj_file);
+
+=head1 DESCRIPTION
+
+This module can build the C portions of Perl modules by invoking the
+appropriate compilers and linkers in a cross-platform manner.  It was
+motivated by the C<Module::Build> project, but may be useful for other
+purposes as well.  However, it is I<not> intended as a general
+cross-platform interface to all your C building needs.  That would
+have been a much more ambitious goal!
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Returns a new C<ExtUtils::CBuilder> object.  A C<config> parameter
+lets you override C<Config.pm> settings for all operations performed
+by the object, as in the following example:
+
+  # Use a different compiler than Config.pm says
+  my $b = ExtUtils::CBuilder->new( config =>
+                                   { ld => 'gcc' } );
+
+=item have_compiler
+
+Returns true if the current system has a working C compiler and
+linker, false otherwise.  To determine this, we actually compile and
+link a sample C library.
+
+=item compile
+
+Compiles a C source file and produces an object file.  The name of the
+object file is returned.  The source file is specified in a C<source>
+parameter, which is required; the other parameters listed below are
+optional.
+
+=over 4
+
+=item C<object_file>
+
+Specifies the name of the output file to create.  Otherwise the
+C<object_file()> method will be consulted, passing it the name of the
+C<source> file.
+
+=item C<include_dirs>
+
+Specifies any additional directories in which to search for header
+files.  May be given as a string indicating a single directory, or as
+a list reference indicating multiple directories.
+
+=item C<extra_compiler_flags>
+
+Specifies any additional arguments to pass to the compiler.  Should be
+given as a list reference containing the arguments individually, or if
+this is not possible, as a string containing all the arguments
+together.
+
+=back
+
+The operation of this method is also affected by the
+C<installarchlib>, C<cccdlflags>, C<ccflags>, C<optimize>, and C<cc>
+entries in C<Config.pm>.
+
+=item link
+
+Invokes the linker to produce a library file from object files.  In
+scalar context, the name of the library file is returned.  In list
+context, the library file and any temporary files created are
+returned.  A required C<objects> parameter contains the name of the
+object files to process, either in a string (for one object file) or
+list reference (for one or more files).  The following parameters are
+optional:
+
+
+=over 4
+
+=item lib_file
+
+Specifies the name of the output library file to create.  Otherwise
+the C<lib_file()> method will be consulted, passing it the name of
+the first entry in C<objects>.
+
+=item module_name
+
+Specifies the name of the Perl module that will be created by linking.
+On platforms that need to do prelinking (Win32, OS/2, etc.) this is a
+required parameter.
+
+=item extra_linker_flags
+
+Any additional flags you wish to pass to the linker.
+
+=back
+
+On platforms where C<need_prelink()> returns true, C<prelink()>
+will be called automatically.
+
+The operation of this method is also affected by the C<lddlflags>,
+C<shrpenv>, and C<ld> entries in C<Config.pm>.
+
+=item link_executable
+
+Invokes the linker to produce an executable file from object files.  In
+scalar context, the name of the executable file is returned.  In list
+context, the executable file and any temporary files created are
+returned.  A required C<objects> parameter contains the name of the
+object files to process, either in a string (for one object file) or
+list reference (for one or more files).  The optional parameters are
+the same as C<link> with exception for
+
+
+=over 4
+
+=item exe_file
+
+Specifies the name of the output executable file to create.  Otherwise
+the C<exe_file()> method will be consulted, passing it the name of the
+first entry in C<objects>.
+
+=back
+
+=item object_file
+
+ my $object_file = $b->object_file($source_file);
+
+Converts the name of a C source file to the most natural name of an
+output object file to create from it.  For instance, on Unix the
+source file F<foo.c> would result in the object file F<foo.o>.
+
+=item lib_file
+
+ my $lib_file = $b->lib_file($object_file);
+
+Converts the name of an object file to the most natural name of a
+output library file to create from it.  For instance, on Mac OS X the
+object file F<foo.o> would result in the library file F<foo.bundle>.
+
+=item exe_file
+
+ my $exe_file = $b->exe_file($object_file);
+
+Converts the name of an object file to the most natural name of an
+executable file to create from it.  For instance, on Mac OS X the
+object file F<foo.o> would result in the executable file F<foo>, and
+on Windows it would result in F<foo.exe>.
+
+
+=item prelink
+
+On certain platforms like Win32, OS/2, VMS, and AIX, it is necessary
+to perform some actions before invoking the linker.  The
+C<ExtUtils::Mksymlists> module does this, writing files used by the
+linker during the creation of shared libraries for dynamic extensions.
+The names of any files written will be returned as a list.
+
+Several parameters correspond to C<ExtUtils::Mksymlists::Mksymlists()>
+options, as follows:
+
+    Mksymlists()   prelink()          type
+   -------------|-------------------|-------------------
+    NAME        |  dl_name          | string (required)
+    DLBASE      |  dl_base          | string
+    FILE        |  dl_file          | string
+    DL_VARS     |  dl_vars          | array reference
+    DL_FUNCS    |  dl_funcs         | hash reference
+    FUNCLIST    |  dl_func_list     | array reference
+    IMPORTS     |  dl_imports       | hash reference
+
+Please see the documentation for C<ExtUtils::Mksymlists> for the
+details of what these parameters do.
+
+=item need_prelink
+
+Returns true on platforms where C<prelink()> should be called
+during linking, and false otherwise.
+
+=back
+
+=head1 TO DO
+
+Currently this has only been tested on Unix and doesn't contain any of
+the Windows-specific code from the C<Module::Build> project.  I'll do
+that next.
+
+=head1 HISTORY
+
+This module is an outgrowth of the C<Module::Build> project, to which
+there have been many contributors.  Notably, Randy W. Sims submitted
+lots of code to support 3 compilers on Windows and helped with various
+other platform-specific issues.
+
+=head1 AUTHOR
+
+Ken Williams, kwilliams@cpan.org
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2005 Ken Williams.  All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+perl(1), Module::Build(3)
+
+=cut
diff --git a/lib/ExtUtils/CBuilder/Base.pm b/lib/ExtUtils/CBuilder/Base.pm
new file mode 100644
index 0000000000..fb20773a81
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Base.pm
@@ -0,0 +1,252 @@
+package ExtUtils::CBuilder::Base;
+
+use strict;
+use File::Spec;
+use File::Basename;
+use Config;
+use Text::ParseWords;
+
+use vars qw($VERSION);
+$VERSION = '0.00_02';
+$VERSION = eval $VERSION;
+
+sub new {
+  my $class = shift;
+  my $self = bless {@_}, $class;
+
+  $self->{properties}{perl} = $class->find_perl_interpreter
+    or warn "Warning: Can't locate your perl binary";
+
+  while (my ($k,$v) = each %Config) {
+    $self->{config}{$k} = $v unless exists $self->{config}{$k};
+  }
+  return $self;
+}
+
+sub find_perl_interpreter {
+  my $perl;
+  File::Spec->file_name_is_absolute($perl = $^X)
+    or -f ($perl = $Config::Config{perlpath})
+    or ($perl = $^X);
+  return $perl;
+}
+
+sub add_to_cleanup {
+  my $self = shift;
+  my %files = map {$_, 1} @_;
+}
+
+sub object_file {
+  my ($self, $filename) = @_;
+
+  # File name, minus the suffix
+  (my $file_base = $filename) =~ s/\.[^.]+$//;
+  return "$file_base$self->{config}{obj_ext}";
+}
+
+sub arg_include_dirs {
+  my $self = shift;
+  return map {"-I$_"} @_;
+}
+
+sub arg_nolink { '-c' }
+
+sub arg_object_file {
+  my ($self, $file) = @_;
+  return ('-o', $file);
+}
+
+sub arg_share_object_file {
+  my ($self, $file) = @_;
+  return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file);
+}
+
+sub arg_exec_file {
+  my ($self, $file) = @_;
+  return ('-o', $file);
+}
+
+sub compile {
+  my ($self, %args) = @_;
+  die "Missing 'source' argument to compile()" unless defined $args{source};
+  
+  my $cf = $self->{config}; # For convenience
+
+  $args{object_file} ||= $self->object_file($args{source});
+  
+  my @include_dirs = $self->arg_include_dirs
+    (@{$args{include_dirs} || []},
+     $self->perl_inc());
+  
+  my @extra_compiler_flags = $self->split_like_shell($args{extra_compiler_flags});
+  my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
+  my @ccflags = $self->split_like_shell($cf->{ccflags});
+  my @optimize = $self->split_like_shell($cf->{optimize});
+  my @flags = (@include_dirs, @cccdlflags, @extra_compiler_flags,
+	       $self->arg_nolink,
+	       @ccflags, @optimize,
+	       $self->arg_object_file($args{object_file}),
+	      );
+  
+  my @cc = $self->split_like_shell($cf->{cc});
+  
+  $self->do_system(@cc, @flags, $args{source})
+    or die "error building $args{object_file} from '$args{source}'";
+
+  return $args{object_file};
+}
+
+sub have_compiler {
+  my ($self) = @_;
+  return $self->{have_compiler} if defined $self->{have_compiler};
+  
+  my $tmpfile = File::Spec->catfile(File::Spec->tmpdir, 'compilet.c');
+  {
+    local *FH;
+    open FH, "> $tmpfile" or die "Can't create $tmpfile: $!";
+    print FH "int boot_compilet() { return 1; }\n";
+    close FH;
+  }
+
+  my ($obj_file, @lib_files);
+  eval {
+    $obj_file = $self->compile(source => $tmpfile);
+    @lib_files = $self->link(objects => $obj_file, module_name => 'compilet');
+  };
+  warn $@ if $@;
+  my $result = $self->{have_compiler} = $@ ? 0 : 1;
+  
+  foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
+    1 while unlink;
+  }
+  return $result;
+}
+
+sub lib_file {
+  my ($self, $dl_file) = @_;
+  $dl_file =~ s/\.[^.]+$//;
+  $dl_file =~ tr/"//d;
+  return "$dl_file.$self->{config}{dlext}";
+}
+
+
+sub exe_file {
+  my ($self, $dl_file) = @_;
+  $dl_file =~ s/\.[^.]+$//;
+  $dl_file =~ tr/"//d;
+  return "$dl_file$self->{config}{_exe}";
+}
+
+sub need_prelink { 0 }
+
+sub prelink {
+  my ($self, %args) = @_;
+  
+  ($args{dl_file} = $args{dl_name}) =~ s/.*::// unless $args{dl_file};
+  
+  require ExtUtils::Mksymlists;
+  ExtUtils::Mksymlists::Mksymlists( # dl. abbrev for dynamic library
+    DL_VARS  => $args{dl_vars}      || [],
+    DL_FUNCS => $args{dl_funcs}     || {},
+    FUNCLIST => $args{dl_func_list} || [],
+    IMPORTS  => $args{dl_imports}   || {},
+    NAME     => $args{dl_name},
+    DLBASE   => $args{dl_base},
+    FILE     => $args{dl_file},
+  );
+  
+  # Mksymlists will create one of these files
+  return grep -e, map "$args{dl_file}.$_", qw(ext def opt);
+}
+
+sub link {
+  my ($self, %args) = @_;
+  return $self->_do_link('lib_file', lddl => 1, %args);
+}
+
+sub link_executable {
+  my ($self, %args) = @_;
+  return $self->_do_link('exe_file', lddl => 0, %args);
+}
+				   
+sub _do_link {
+  my ($self, $type, %args) = @_;
+
+  my $cf = $self->{config}; # For convenience
+  
+  my $objects = delete $args{objects};
+  $objects = [$objects] unless ref $objects;
+  my $out = $args{$type} || $self->$type($objects->[0]);
+  
+  my @temp_files;
+  @temp_files =
+    $self->prelink(%args,
+		   dl_name => $args{module_name}) if $self->need_prelink;
+  
+  my @linker_flags = $self->split_like_shell($args{extra_linker_flags});
+  my @output = $args{lddl} ? $self->arg_share_object_file($out) : $self->arg_exec_file($out);
+  my @shrp = $self->split_like_shell($cf->{shrpenv});
+  my @ld = $self->split_like_shell($cf->{ld});
+  $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags)
+    or die "error building $out from @$objects";
+  
+  return wantarray ? ($out, @temp_files) : $out;
+}
+
+
+sub do_system {
+  my ($self, @cmd) = @_;
+  print "@cmd\n" if !$self->{quiet};
+  return !system(@cmd);
+}
+
+sub split_like_shell {
+  my ($self, $string) = @_;
+  
+  return () unless defined($string);
+  return @$string if UNIVERSAL::isa($string, 'ARRAY');
+  $string =~ s/^\s+|\s+$//g;
+  return () unless length($string);
+  
+  return Text::ParseWords::shellwords($string);
+}
+
+# if building perl, perl's main source directory
+sub perl_src {
+  # N.B. makemaker actually searches regardless of PERL_CORE, but
+  # only squawks at not finding it if PERL_CORE is set
+
+  if ($ENV{PERL_CORE}) {
+    my $Updir  = File::Spec->updir;
+    my($dir);
+    foreach $dir ($Updir,
+                  File::Spec->catdir($Updir,$Updir),
+                  File::Spec->catdir($Updir,$Updir,$Updir),
+                  File::Spec->catdir($Updir,$Updir,$Updir,$Updir),
+                  File::Spec->catdir($Updir,$Updir,$Updir,$Updir,$Updir))
+    {
+      if (
+           -f File::Spec->catfile($dir,"config_h.SH")
+           &&
+           -f File::Spec->catfile($dir,"perl.h")
+          &&
+           -f File::Spec->catfile($dir,"lib","Exporter.pm")
+        ) {
+        return $dir;
+      }
+    }
+
+    warn "PERL_CORE is set but I can't find your perl source!\n";
+  }
+
+  return;
+}
+
+# directory of perl's include files
+sub perl_inc {
+  my $self = shift;
+
+  $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE");
+}
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/Unix.pm b/lib/ExtUtils/CBuilder/Platform/Unix.pm
new file mode 100644
index 0000000000..63b725a69b
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/Unix.pm
@@ -0,0 +1,29 @@
+package ExtUtils::CBuilder::Platform::Unix;
+
+use strict;
+use ExtUtils::CBuilder::Base;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+sub link {
+  my $self = shift;
+  my $cf = $self->{config};
+  
+  # Some platforms (notably Mac OS X 10.3, but some others too) expect
+  # the syntax "FOO=BAR /bin/command arg arg" to work in %Config
+  # (notably $Config{ld}).  It usually works in system(SCALAR), but we
+  # use system(LIST). We fix it up here with 'env'.
+  
+  local $cf->{ld} = $cf->{ld};
+  if (ref $cf->{ld}) {
+    unshift @{$cf->{ld}}, 'env' if $cf->{ld}[0] =~ /^\s*\w+=/;
+  } else {
+    $cf->{ld} =~ s/^(\s*\w+=)/env $1/;
+  }
+  
+  return $self->SUPER::link(@_);
+}
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/VMS.pm b/lib/ExtUtils/CBuilder/Platform/VMS.pm
new file mode 100644
index 0000000000..383096093b
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/VMS.pm
@@ -0,0 +1,34 @@
+package ExtUtils::CBuilder::Platform::VMS;
+
+use strict;
+use ExtUtils::CBuilder::Base;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+sub need_prelink { 0 }
+
+sub arg_include_dirs {
+  my $self = shift;
+  return '/include=(' . join(',', @_) . ')';
+}
+
+sub arg_nolink { return; }
+
+sub arg_object_file {
+  my ($self, $file) = @_;
+  return "/obj=$file";
+}
+
+sub arg_exec_file {
+  my ($self, $file) = @_;
+  return ("/exe=$file");
+}
+
+sub arg_share_object_file {
+  my ($self, $file) = @_;
+  return ("$self->{config}{lddlflags}=$file");
+}
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/Windows.pm b/lib/ExtUtils/CBuilder/Platform/Windows.pm
new file mode 100644
index 0000000000..1c0ec97ba1
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/Windows.pm
@@ -0,0 +1,696 @@
+package ExtUtils::CBuilder::Platform::Windows;
+
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Spec;
+
+use ExtUtils::CBuilder::Base;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+sub new {
+  my $class = shift;
+  my $self = $class->SUPER::new(@_);
+  my $cf = $self->{config};
+
+  # Inherit from an appropriate compiler driver class
+  unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
+
+  return $self;
+}
+
+sub _compiler_type {
+  my $self = shift;
+  my $cc = $self->{config}{cc};
+
+  return (  $cc =~ /cl(\.exe)?$/ ? 'MSVC'
+	  : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
+	  : 'GCC');
+}
+
+sub split_like_shell {
+  # As it turns out, Windows command-parsing is very different from
+  # Unix command-parsing.  Double-quotes mean different things,
+  # backslashes don't necessarily mean escapes, and so on.  So we
+  # can't use Text::ParseWords::shellwords() to break a command string
+  # into words.  The algorithm below was bashed out by Randy and Ken
+  # (mostly Randy), and there are a lot of regression tests, so we
+  # should feel free to adjust if desired.
+  
+  (my $self, local $_) = @_;
+  
+  return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
+  
+  my @argv;
+  return @argv unless defined() && length();
+  
+  my $arg = '';
+  my( $i, $quote_mode ) = ( 0, 0 );
+  
+  while ( $i < length() ) {
+    
+    my $ch      = substr( $_, $i  , 1 );
+    my $next_ch = substr( $_, $i+1, 1 );
+    
+    if ( $ch eq '\\' && $next_ch eq '"' ) {
+      $arg .= '"';
+      $i++;
+    } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
+      $arg .= '\\';
+      $i++;
+    } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
+      $quote_mode = !$quote_mode;
+      $arg .= '"';
+      $i++;
+    } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
+	      ( $i + 2 == length()  ||
+		substr( $_, $i + 2, 1 ) eq ' ' )
+	    ) { # for cases like: a"" => [ 'a' ]
+      push( @argv, $arg );
+      $arg = '';
+      $i += 2;
+    } elsif ( $ch eq '"' ) {
+      $quote_mode = !$quote_mode;
+    } elsif ( $ch eq ' ' && !$quote_mode ) {
+      push( @argv, $arg ) if $arg;
+      $arg = '';
+      ++$i while substr( $_, $i + 1, 1 ) eq ' ';
+    } else {
+      $arg .= $ch;
+    }
+    
+    $i++;
+  }
+  
+  push( @argv, $arg ) if defined( $arg ) && length( $arg );
+  return @argv;
+}
+
+sub compile {
+  my ($self, %args) = @_;
+  my $cf = $self->{config};
+
+  die "Missing 'source' argument to compile()" unless defined $args{source};
+
+  my ($basename, $srcdir) =
+    ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
+
+  $srcdir ||= File::Spec->curdir();
+
+  my %spec = (
+    srcdir      => $srcdir,
+    builddir    => $srcdir,
+    basename    => $basename,
+    source      => $args{source},
+    output      => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
+    cc          => $cf->{cc},
+    cflags      => [
+                     $self->split_like_shell($cf->{ccflags}),
+                     $self->split_like_shell($cf->{cccdlflags}),
+                   ],
+    optimize    => [ $self->split_like_shell($cf->{optimize})    ],
+    defines     => [ '' ],
+    includes    => [ @{$args{include_dirs} || []} ],
+    perlinc     => [
+                     $self->perl_inc(),
+                     $self->split_like_shell($cf->{incpath}),
+                   ],
+    use_scripts => 1, # XXX provide user option to change this???
+  );
+
+  $self->add_to_cleanup($spec{output});
+
+  $self->normalize_filespecs(
+    \$spec{source},
+    \$spec{output},
+     $spec{includes},
+     $spec{perlinc},
+  );
+
+  my @cmds = $self->format_compiler_cmd(%spec);
+  while ( my $cmd = shift @cmds ) {
+    $self->do_system( @$cmd )
+      or die "error building $cf->{dlext} file from '$args{source}'";
+  }
+
+  (my $out = $spec{output}) =~ tr/'"//d;
+  return $out;
+}
+
+sub need_prelink { 1 }
+
+sub link {
+  my ($self, %args) = @_;
+  my $cf = $self->{config};
+
+  my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
+  my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
+  $to ||= File::Spec->curdir();
+
+  (my $file_base = $args{module_name}) =~ s/.*:://;
+  my $output = $args{lib_file} ||
+    File::Spec->catfile($to, "$file_base.$cf->{dlext}");
+
+  # if running in perl source tree, look for libs there, not installed
+  my $lddlflags = $cf->{lddlflags};
+  my $perl_src = $self->perl_src();
+  $lddlflags =~ s/\Q$cf->{archlibexp}\E\\CORE/$perl_src/ if $perl_src;
+
+  my %spec = (
+    srcdir        => $to,
+    builddir      => $to,
+    startup       => [ ],
+    objects       => \@objects,
+    libs          => [ ],
+    output        => $output,
+    ld            => $cf->{ld},
+    libperl       => $cf->{libperl},
+    perllibs      => [ $self->split_like_shell($cf->{perllibs})  ],
+    libpath       => [ $self->split_like_shell($cf->{libpth})    ],
+    lddlflags     => [ $self->split_like_shell($lddlflags) ],
+    other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
+    use_scripts   => 1, # XXX provide user option to change this???
+  );
+
+  unless ( $spec{basename} ) {
+    ($spec{basename} = $args{module_name}) =~ s/.*:://;
+  }
+
+  $spec{srcdir}   = File::Spec->canonpath( $spec{srcdir}   );
+  $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
+
+  $spec{output}    ||= File::Spec->catfile( $spec{builddir},
+                                            $spec{basename}  . '.'.$cf->{dlext}   );
+  $spec{implib}    ||= File::Spec->catfile( $spec{builddir},
+                                            $spec{basename}  . $cf->{lib_ext} );
+  $spec{explib}    ||= File::Spec->catfile( $spec{builddir},
+                                            $spec{basename}  . '.exp'  );
+  $spec{def_file}  ||= File::Spec->catfile( $spec{srcdir}  ,
+                                            $spec{basename}  . '.def'  );
+  $spec{base_file} ||= File::Spec->catfile( $spec{srcdir}  ,
+                                            $spec{basename}  . '.base' );
+
+  $self->add_to_cleanup(
+    grep defined,
+    @{[ @spec{qw(output implib explib def_file base_file map_file)} ]}
+  );
+
+  foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
+    $self->normalize_filespecs( \$spec{$opt} );
+  }
+
+  foreach my $opt ( qw(libpath startup objects) ) {
+    $self->normalize_filespecs( $spec{$opt} );
+  }
+
+  (my $def_base = $spec{def_file}) =~ tr/'"//d;
+  $def_base =~ s/\.def$//;
+  $self->prelink( dl_name => $args{module_name},
+                  dl_file => $def_base,
+                  dl_base => $spec{basename} );
+
+  my @cmds = $self->format_linker_cmd(%spec);
+  while ( my $cmd = shift @cmds ) {
+    $self->do_system( @$cmd );
+  }
+
+  $spec{output} =~ tr/'"//d;
+  return wantarray
+    ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
+    : $spec{output};
+}
+
+# canonize & quote paths
+sub normalize_filespecs {
+  my ($self, @specs) = @_;
+  foreach my $spec ( grep defined, @specs ) {
+    if ( ref $spec eq 'ARRAY') {
+      $self->normalize_filespecs( map {\$_} grep defined, @$spec )
+    } elsif ( ref $spec eq 'SCALAR' ) {
+      $$spec =~ tr/"//d if $$spec;
+      next unless $$spec;
+      $$spec = '"' . File::Spec->canonpath($$spec) . '"';
+    } elsif ( ref $spec eq '' ) {
+      $spec = '"' . File::Spec->canonpath($spec) . '"';
+    } else {
+      die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
+    }
+  }
+}
+
+# directory of perl's include files
+sub perl_inc {
+  my $self = shift;
+
+  my $perl_src = $self->perl_src();
+
+  if ($perl_src) {
+    File::Spec->catdir($perl_src, "lib", "CORE");
+  } else {
+    File::Spec->catdir($self->{config}{archlibexp},"CORE");
+  }
+}
+
+1;
+
+########################################################################
+
+=begin comment
+
+The packages below implement functions for generating properly
+formated commandlines for the compiler being used. Each package
+defines two primary functions 'format_linker_cmd()' &
+'format_compiler_cmd()' that accepts a list of named arguments (a
+hash) and returns a list of formated options suitable for invoking the
+compiler. By default, if the compiler supports scripting of its
+operation then a script file is built containing the options while
+those options are removed from the commandline, and a reference to the
+script is pushed onto the commandline in their place. Scripting the
+compiler in this way helps to avoid the problems associated with long
+commandlines under some shells.
+
+=end comment
+
+=cut
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::MSVC;
+
+sub format_compiler_cmd {
+  my ($self, %spec) = @_;
+
+  foreach my $path ( @{ $spec{includes} || [] },
+                     @{ $spec{perlinc}  || [] } ) {
+    $path = '-I' . $path;
+  }
+
+  %spec = $self->write_compiler_script(%spec)
+    if $spec{use_scripts};
+
+  return [ grep {defined && length} (
+    $spec{cc},'-nologo','-c',
+    @{$spec{includes}}      ,
+    @{$spec{cflags}}        ,
+    @{$spec{optimize}}      ,
+    @{$spec{defines}}       ,
+    @{$spec{perlinc}}       ,
+    "-Fo$spec{output}"      ,
+    $spec{source}           ,
+  ) ];
+}
+
+sub write_compiler_script {
+  my ($self, %spec) = @_;
+
+  my $script = File::Spec->catfile( $spec{srcdir},
+                                    $spec{basename} . '.ccs' );
+
+  $self->add_to_cleanup($script);
+
+  print "Generating script '$script'\n" if !$self->{quiet};
+
+  open( SCRIPT, ">$script" )
+    or die( "Could not create script '$script': $!" );
+
+  print SCRIPT join( "\n",
+    map { ref $_ ? @{$_} : $_ }
+    grep defined,
+    delete(
+      @spec{ qw(includes cflags optimize defines perlinc) } )
+  );
+
+  close SCRIPT;
+
+  push @{$spec{includes}}, '@"' . $script . '"';
+
+  return %spec;
+}
+
+sub format_linker_cmd {
+  my ($self, %spec) = @_;
+
+  foreach my $path ( @{$spec{libpath}} ) {
+    $path = "-libpath:$path";
+  }
+
+  $spec{def_file}  &&= '-def:'    . $spec{def_file};
+  $spec{output}    &&= '-out:'    . $spec{output};
+  $spec{implib}    &&= '-implib:' . $spec{implib};
+  $spec{map_file}  &&= '-map:'    . $spec{map_file};
+
+  %spec = $self->write_linker_script(%spec)
+    if $spec{use_scripts};
+
+  return [ grep {defined && length} (
+    $spec{ld}               ,
+    @{$spec{lddlflags}}     ,
+    @{$spec{libpath}}       ,
+    @{$spec{other_ldflags}} ,
+    @{$spec{startup}}       ,
+    @{$spec{objects}}       ,
+    $spec{map_file}         ,
+    $spec{libperl}          ,
+    @{$spec{perllibs}}      ,
+    $spec{def_file}         ,
+    $spec{implib}           ,
+    $spec{output}           ,
+  ) ];
+}
+
+sub write_linker_script {
+  my ($self, %spec) = @_;
+
+  my $script = File::Spec->catfile( $spec{srcdir},
+                                    $spec{basename} . '.lds' );
+
+  $self->add_to_cleanup($script);
+
+  print "Generating script '$script'\n" if !$self->{quiet};
+
+  open( SCRIPT, ">$script" )
+    or die( "Could not create script '$script': $!" );
+
+  print SCRIPT join( "\n",
+    map { ref $_ ? @{$_} : $_ }
+    grep defined,
+    delete(
+      @spec{ qw(lddlflags libpath other_ldflags
+                startup objects libperl perllibs
+                def_file implib map_file)            } )
+  );
+
+  close SCRIPT;
+
+  push @{$spec{lddlflags}}, '@"' . $script . '"';
+
+  return %spec;
+}
+
+1;
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::BCC;
+
+sub format_compiler_cmd {
+  my ($self, %spec) = @_;
+
+  foreach my $path ( @{ $spec{includes} || [] },
+                     @{ $spec{perlinc}  || [] } ) {
+    $path = '-I' . $path;
+  }
+
+  %spec = $self->write_compiler_script(%spec)
+    if $spec{use_scripts};
+
+  return [ grep {defined && length} (
+    $spec{cc}, '-c'         ,
+    @{$spec{includes}}      ,
+    @{$spec{cflags}}        ,
+    @{$spec{optimize}}      ,
+    @{$spec{defines}}       ,
+    @{$spec{perlinc}}       ,
+    "-o$spec{output}"       ,
+    $spec{source}           ,
+  ) ];
+}
+
+sub write_compiler_script {
+  my ($self, %spec) = @_;
+
+  my $script = File::Spec->catfile( $spec{srcdir},
+                                    $spec{basename} . '.ccs' );
+
+  $self->add_to_cleanup($script);
+
+  print "Generating script '$script'\n" if !$self->{quiet};
+
+  open( SCRIPT, ">$script" )
+    or die( "Could not create script '$script': $!" );
+
+  print SCRIPT join( "\n",
+    map { ref $_ ? @{$_} : $_ }
+    grep defined,
+    delete(
+      @spec{ qw(includes cflags optimize defines perlinc) } )
+  );
+
+  close SCRIPT;
+
+  push @{$spec{includes}}, '@"' . $script . '"';
+
+  return %spec;
+}
+
+sub format_linker_cmd {
+  my ($self, %spec) = @_;
+
+  foreach my $path ( @{$spec{libpath}} ) {
+    $path = "-L$path";
+  }
+
+  push( @{$spec{startup}}, 'c0d32.obj' )
+    unless ( $spec{starup} && @{$spec{startup}} );
+
+  %spec = $self->write_linker_script(%spec)
+    if $spec{use_scripts};
+
+  return [ grep {defined && length} (
+    $spec{ld}               ,
+    @{$spec{lddlflags}}     ,
+    @{$spec{libpath}}       ,
+    @{$spec{other_ldflags}} ,
+    @{$spec{startup}}       ,
+    @{$spec{objects}}       , ',',
+    $spec{output}           , ',',
+    $spec{map_file}         , ',',
+    $spec{libperl}          ,
+    @{$spec{perllibs}}      , ',',
+    $spec{def_file}
+  ) ];
+}
+
+sub write_linker_script {
+  my ($self, %spec) = @_;
+
+  # To work around Borlands "unique" commandline syntax,
+  # two scripts are used:
+
+  my $ld_script = File::Spec->catfile( $spec{srcdir},
+                                       $spec{basename} . '.lds' );
+  my $ld_libs   = File::Spec->catfile( $spec{srcdir},
+                                       $spec{basename} . '.lbs' );
+
+  $self->add_to_cleanup($ld_script, $ld_libs);
+
+  print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
+
+  # Script 1: contains options & names of object files.
+  open( LD_SCRIPT, ">$ld_script" )
+    or die( "Could not create linker script '$ld_script': $!" );
+
+  print LD_SCRIPT join( " +\n",
+    map { @{$_} }
+    grep defined,
+    delete(
+      @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
+  );
+
+  close LD_SCRIPT;
+
+  # Script 2: contains name of libs to link against.
+  open( LD_LIBS, ">$ld_libs" )
+    or die( "Could not create linker script '$ld_libs': $!" );
+
+  print LD_LIBS join( " +\n",
+     (delete $spec{libperl}  || ''),
+    @{delete $spec{perllibs} || []},
+  );
+
+  close LD_LIBS;
+
+  push @{$spec{lddlflags}}, '@"' . $ld_script  . '"';
+  push @{$spec{perllibs}},  '@"' . $ld_libs    . '"';
+
+  return %spec;
+}
+
+1;
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::GCC;
+
+sub format_compiler_cmd {
+  my ($self, %spec) = @_;
+
+  foreach my $path ( @{ $spec{includes} || [] },
+                     @{ $spec{perlinc}  || [] } ) {
+    $path = '-I' . $path;
+  }
+
+  # split off any -arguments included in cc
+  my @cc = split / (?=-)/, $spec{cc};
+
+  return [ grep {defined && length} (
+    @cc, '-c'               ,
+    @{$spec{includes}}      ,
+    @{$spec{cflags}}        ,
+    @{$spec{optimize}}      ,
+    @{$spec{defines}}       ,
+    @{$spec{perlinc}}       ,
+    '-o', $spec{output}     ,
+    $spec{source}           ,
+  ) ];
+}
+
+sub format_linker_cmd {
+  my ($self, %spec) = @_;
+
+  # The Config.pm variable 'libperl' is hardcoded to the full name
+  # of the perl import library (i.e. 'libperl56.a'). GCC will not
+  # find it unless the 'lib' prefix & the extension are stripped.
+  $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
+
+  unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
+    if ( $spec{startup} && @{$spec{startup}} );
+
+  # From ExtUtils::MM_Win32:
+  #
+  ## one thing for GCC/Mingw32:
+  ## we try to overcome non-relocateable-DLL problems by generating
+  ##    a (hopefully unique) image-base from the dll's name
+  ## -- BKS, 10-19-1999
+  File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
+  $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
+
+  %spec = $self->write_linker_script(%spec)
+    if $spec{use_scripts};
+
+  foreach my $path ( @{$spec{libpath}} ) {
+    $path = "-L$path";
+  }
+
+  my @cmds; # Stores the series of commands needed to build the module.
+
+  push @cmds, [
+    'dlltool', '--def'        , $spec{def_file},
+               '--output-exp' , $spec{explib}
+  ];
+
+  # split off any -arguments included in ld
+  my @ld = split / (?=-)/, $spec{ld};
+
+  push @cmds, [ grep {defined && length} (
+    @ld                       ,
+    '-o', $spec{output}       ,
+    "-Wl,--base-file,$spec{base_file}"   ,
+    "-Wl,--image-base,$spec{image_base}" ,
+    @{$spec{lddlflags}}       ,
+    @{$spec{libpath}}         ,
+    @{$spec{startup}}         ,
+    @{$spec{objects}}         ,
+    @{$spec{other_ldflags}}   ,
+    $spec{libperl}            ,
+    @{$spec{perllibs}}        ,
+    $spec{explib}             ,
+    $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+  ) ];
+
+  push @cmds, [
+    'dlltool', '--def'        , $spec{def_file},
+               '--output-exp' , $spec{explib},
+               '--base-file'  , $spec{base_file}
+  ];
+
+  push @cmds, [ grep {defined && length} (
+    @ld                       ,
+    '-o', $spec{output}       ,
+    "-Wl,--image-base,$spec{image_base}" ,
+    @{$spec{lddlflags}}       ,
+    @{$spec{libpath}}         ,
+    @{$spec{startup}}         ,
+    @{$spec{objects}}         ,
+    @{$spec{other_ldflags}}   ,
+    $spec{libperl}            ,
+    @{$spec{perllibs}}        ,
+    $spec{explib}             ,
+    $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+  ) ];
+
+  return @cmds;
+}
+
+sub write_linker_script {
+  my ($self, %spec) = @_;
+
+  my $script = File::Spec->catfile( $spec{srcdir},
+                                    $spec{basename} . '.lds' );
+
+  $self->add_to_cleanup($script);
+
+  print "Generating script '$script'\n" if !$self->{quiet};
+
+  open( SCRIPT, ">$script" )
+    or die( "Could not create script '$script': $!" );
+
+  print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
+    for @{delete $spec{libpath} || []};
+
+  # gcc takes only one startup file, so the first object in startup is
+  # specified as the startup file and any others are shifted into the
+  # beginning of the list of objects.
+  if ( $spec{startup} && @{$spec{startup}} ) {
+    print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
+    unshift @{$spec{objects}},
+      @{delete $spec{startup} || []};
+  }
+
+  print SCRIPT 'INPUT(' . join( ',',
+    @{delete $spec{objects}  || []}
+  ) . ")\n";
+
+  print SCRIPT 'INPUT(' . join( ' ',
+     (delete $spec{libperl}  || ''),
+    @{delete $spec{perllibs} || []},
+  ) . ")\n";
+
+  close SCRIPT;
+
+  push @{$spec{other_ldflags}}, '"' . $script . '"';
+
+  return %spec;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
+
+=head1 DESCRIPTION
+
+This module implements the Windows-specific parts of ExtUtils::CBuilder.
+Most of the Windows-specific stuff has to do with compiling and
+linking C code.  Currently we support the 3 compilers perl itself
+supports: MSVC, BCC, and GCC.
+
+This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
+not implemented here will be implemented there.  The interfaces are
+defined by the L<ExtUtils::CBuilder> documentation.
+
+=head1 AUTHOR
+
+Ken Williams <ken@mathforum.org>
+
+Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
+
+=head1 SEE ALSO
+
+perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
+
+=cut
diff --git a/lib/ExtUtils/CBuilder/Platform/aix.pm b/lib/ExtUtils/CBuilder/Platform/aix.pm
new file mode 100644
index 0000000000..892c3448cc
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/aix.pm
@@ -0,0 +1,31 @@
+package ExtUtils::CBuilder::Platform::aix;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+use File::Spec;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub need_prelink { 1 }
+
+sub link {
+  my ($self, %args) = @_;
+  my $cf = $self->{config};
+
+  (my $baseext = $args{module_name}) =~ s/.*:://;
+  my $perl_inc = $self->perl_inc();
+
+  # Massage some very naughty bits in %Config
+  local $cf->{lddlflags} = $cf->{lddlflags};
+  for ($cf->{lddlflags}) {
+    s/\Q$(BASEEXT)\E/$baseext/;
+    s/\Q$(PERL_INC)\E/$perl_inc/;
+  }
+
+  return $self->SUPER::link(%args);
+}
+
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/lib/ExtUtils/CBuilder/Platform/cygwin.pm
new file mode 100644
index 0000000000..5b26c75aa3
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/cygwin.pm
@@ -0,0 +1,30 @@
+package ExtUtils::CBuilder::Platform::cygwin;
+
+use strict;
+use File::Spec;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub link_executable {
+  my $self = shift;
+  # $Config{ld} is set up as a special script for building
+  # perl-linkable libraries.  We don't want that here.
+  local $self->{config}{ld} = 'gcc';
+  return $self->SUPER::link_executable(@_);
+}
+
+sub link {
+  my ($self, %args) = @_;
+
+  $args{extra_linker_flags} = [
+    File::Spec->catdir($self->perl_inc(), 'libperl.dll.a'),
+    $self->split_like_shell($args{extra_linker_flags})
+  ];
+
+  return $self->SUPER::link(%args);
+}
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/darwin.pm b/lib/ExtUtils/CBuilder/Platform/darwin.pm
new file mode 100644
index 0000000000..7ea9114354
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/darwin.pm
@@ -0,0 +1,22 @@
+package ExtUtils::CBuilder::Platform::darwin;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub compile {
+  my $self = shift;
+  my $cf = $self->{config};
+
+  # -flat_namespace isn't a compile flag, it's a linker flag.  But
+  # it's mistakenly in Config.pm as both.  Make the correction here.
+  local $cf->{ccflags} = $cf->{ccflags};
+  $cf->{ccflags} =~ s/-flat_namespace//;
+  $self->SUPER::compile(@_);
+}
+
+
+1;
diff --git a/lib/ExtUtils/CBuilder/Platform/os2.pm b/lib/ExtUtils/CBuilder/Platform/os2.pm
new file mode 100644
index 0000000000..d02ae8a0b2
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/Platform/os2.pm
@@ -0,0 +1,12 @@
+package ExtUtils::CBuilder::Platform::os2;
+
+use strict;
+use ExtUtils::CBuilder::Platform::Unix;
+
+use vars qw($VERSION @ISA);
+$VERSION = '0.01';
+@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
+
+sub need_prelink { 1 }
+
+1;
diff --git a/lib/ExtUtils/CBuilder/t/01-basic.t b/lib/ExtUtils/CBuilder/t/01-basic.t
new file mode 100644
index 0000000000..b62d9e0d53
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/t/01-basic.t
@@ -0,0 +1,58 @@
+#! perl -w
+
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    chdir 't' if -d 't';
+    chdir '../lib/ExtUtils/CBuilder'
+      or die "Can't chdir to lib/ExtUtils/CBuilder: $!";
+    @INC = qw(../..);
+  }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 11 }
+
+use ExtUtils::CBuilder;
+use File::Spec;
+ok 1;
+
+# TEST doesn't like extraneous output
+my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
+ok $b;
+
+ok $b->have_compiler;
+
+my $source_file = File::Spec->catfile('t', 'compilet.c');
+{
+  local *FH;
+  open FH, "> $source_file" or die "Can't create $source_file: $!";
+  print FH "int boot_compilet() { return 1; }\n";
+  close FH;
+}
+ok -e $source_file;
+
+my $object_file = $b->object_file($source_file);
+ok 1;
+
+ok $object_file, $b->compile(source => $source_file);
+
+my $lib_file = $b->lib_file($object_file);
+ok 1;
+
+my ($lib, @temps) = $b->link(objects => $object_file,
+                             module_name => 'compilet');
+$lib =~ tr/"'//d;
+ok $lib_file, $lib;
+
+for ($source_file, $lib_file, $object_file, @temps) {
+  tr/"'//d;
+  1 while unlink;
+}
+
+my @words = $b->split_like_shell(' foo bar');
+ok @words, 2;
+ok $words[0], 'foo';
+ok $words[1], 'bar';
diff --git a/lib/ExtUtils/CBuilder/t/02-link.t b/lib/ExtUtils/CBuilder/t/02-link.t
new file mode 100644
index 0000000000..db9a1c36ff
--- /dev/null
+++ b/lib/ExtUtils/CBuilder/t/02-link.t
@@ -0,0 +1,69 @@
+#! perl -w
+
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    chdir 't' if -d 't';
+    chdir '../lib/ExtUtils/CBuilder'
+      or die "Can't chdir to lib/ExtUtils/CBuilder: $!";
+    @INC = qw(../..);
+  }
+}
+
+use strict;
+use Test;
+BEGIN { 
+  if ($^O eq 'MSWin32') {
+    print "1..0 # Skipped: link_executable() is not implemented yet on Win32\n";
+    exit;
+  }
+  if ($^O eq 'VMS') {
+    # So we can get the return value of system()
+    require vmsish;
+    import vmsish;
+  }
+  plan tests => 5;
+}
+
+use ExtUtils::CBuilder;
+use File::Spec;
+
+# TEST doesn't like extraneous output
+my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
+ok $b;
+
+my $source_file = File::Spec->catfile('t', 'compilet.c');
+{
+  local *FH;
+  open FH, "> $source_file" or die "Can't create $source_file: $!";
+  print FH "int main(void) { return 11; }\n";
+  close FH;
+}
+ok -e $source_file;
+
+# Compile
+my $object_file;
+ok $object_file = $b->compile(source => $source_file);
+
+# Link
+my ($exe_file, @temps);
+($exe_file, @temps) = $b->link_executable(objects => $object_file);
+ok $exe_file;
+
+# Try the executable
+ok my_system($exe_file), 11;
+
+# Clean up
+for ($source_file, $exe_file, $object_file, @temps) {
+  tr/"'//d;
+  1 while unlink;
+}
+
+sub my_system {
+  my $cmd = shift;
+  if ($^O eq 'VMS') {
+    return system("mcr $cmd");
+  }
+  return system($cmd) >> 8;
+}
diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm
new file mode 100644
index 0000000000..bd0e875af8
--- /dev/null
+++ b/lib/ExtUtils/ParseXS.pm
@@ -0,0 +1,2016 @@
+package ExtUtils::ParseXS;
+
+use 5.006;  # We use /??{}/ in regexes
+use Cwd;
+use Config;
+use File::Basename;
+use File::Spec;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(process_file);
+
+# use strict;  # One of these days...
+
+my(@XSStack);	# Stack of conditionals and INCLUDEs
+my($XSS_work_idx, $cpp_next_tmp);
+
+use vars qw($VERSION);
+$VERSION = '2.09_01';
+$VERSION = eval $VERSION;
+
+use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
+	    $cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
+	    $WantOptimize $process_inout $process_argtypes @tm
+	    $dir $filename $filepathname %IncludedFiles
+	    %type_kind %proto_letter
+            %targetable $BLOCK_re $lastline $lastline_no
+            $Package $Prefix @line @BootCode %args_match %defaults %var_types %arg_list @proto_arg
+            $processing_arg_with_types %argtype_seen @outlist %in_out %lengthof
+            $proto_in_this_xsub $scope_in_this_xsub $interface $prepush_done $interface_macro $interface_macro_set
+            $ProtoThisXSUB $ScopeThisXSUB $xsreturn
+            @line_no $ret_type $func_header $orig_args
+	   ); # Add these just to get compilation to happen.
+
+
+sub process_file {
+  
+  # Allow for $package->process_file(%hash) in the future
+  my ($pkg, %args) = @_ % 2 ? @_ : (__PACKAGE__, @_);
+  
+  $ProtoUsed = exists $args{prototypes};
+  
+  # Set defaults.
+  %args = (
+	   # 'C++' => 0, # Doesn't seem to *do* anything...
+	   hiertype => 0,
+	   except => 0,
+	   prototypes => 0,
+	   versioncheck => 1,
+	   linenumbers => 1,
+	   optimize => 1,
+	   prototypes => 0,
+	   inout => 1,
+	   argtypes => 1,
+	   typemap => [],
+	   output => \*STDOUT,
+	   %args,
+	  );
+
+  # Global Constants
+  
+  my ($Is_VMS, $SymSet);
+  if ($^O eq 'VMS') {
+    $Is_VMS = 1;
+    # Establish set of global symbols with max length 28, since xsubpp
+    # will later add the 'XS_' prefix.
+    require ExtUtils::XSSymSet;
+    $SymSet = new ExtUtils::XSSymSet 28;
+  }
+  @XSStack = ({type => 'none'});
+  ($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
+  @InitFileCode = ();
+  $FH = 'File0000' ;
+  $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
+  $Overload = 0;
+  $errors = 0;
+  $Fallback = 'PL_sv_undef';
+
+  # Most of the 1500 lines below uses these globals.  We'll have to
+  # clean this up sometime, probably.  For now, we just pull them out
+  # of %args.  -Ken
+  
+  $cplusplus = $args{'C++'};
+  $hiertype = $args{hiertype};
+  $WantPrototypes = $args{prototypes};
+  $WantVersionChk = $args{versioncheck};
+  $except = $args{except} ? ' TRY' : '';
+  $WantLineNumbers = $args{linenumbers};
+  $WantOptimize = $args{optimize};
+  $process_inout = $args{inout};
+  $process_argtypes = $args{argtypes};
+  @tm = ref $args{typemap} ? @{$args{typemap}} : ($args{typemap});
+  
+  for ($args{filename}) {
+    die "Missing required parameter 'filename'" unless $_;
+    $filepathname = $_;
+    ($dir, $filename) = (dirname($_), basename($_));
+    $filepathname =~ s/\\/\\\\/g;
+    $IncludedFiles{$_}++;
+  }
+  
+  # Open the input file
+  open($FH, $args{filename}) or die "cannot open $args{filename}: $!\n";
+
+  # Open the output file if given as a string.  If they provide some
+  # other kind of reference, trust them that we can print to it.
+  if (not ref $args{output}) {
+    open my($fh), "> $args{output}" or die "Can't create $args{output}: $!";
+    $args{outfile} = $args{output};
+    $args{output} = $fh;
+  }
+
+  # Really, we shouldn't have to chdir() or select() in the first
+  # place.  For now, just save & restore.
+  my $orig_cwd = cwd();
+  my $orig_fh = select();
+  
+  chdir($dir);
+  my $pwd = cwd();
+  
+  if ($WantLineNumbers) {
+    my $cfile;
+    if ( $args{outfile} ) {
+      $cfile = $args{outfile};
+    } else {
+      $cfile = $args{filename};
+      $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+    }
+    tie(*PSEUDO_STDOUT, 'ExtUtils::ParseXS::CountLines', $cfile, $args{output});
+    select PSEUDO_STDOUT;
+  } else {
+    select $args{output};
+  }
+
+  foreach my $typemap (@tm) {
+    die "Can't find $typemap in $pwd\n" unless -r $typemap;
+  }
+
+  push @tm, standard_typemap_locations();
+
+  foreach my $typemap (@tm) {
+    next unless -f $typemap ;
+    # skip directories, binary files etc.
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
+      unless -T $typemap ;
+    open(TYPEMAP, $typemap)
+      or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+    my $mode = 'Typemap';
+    my $junk = "" ;
+    my $current = \$junk;
+    while (<TYPEMAP>) {
+      next if /^\s*		#/;
+        my $line_no = $. + 1;
+      if (/^INPUT\s*$/) {
+	$mode = 'Input';   $current = \$junk;  next;
+      }
+      if (/^OUTPUT\s*$/) {
+	$mode = 'Output';  $current = \$junk;  next;
+      }
+      if (/^TYPEMAP\s*$/) {
+	$mode = 'Typemap'; $current = \$junk;  next;
+      }
+      if ($mode eq 'Typemap') {
+	chomp;
+	my $line = $_ ;
+	TrimWhitespace($_) ;
+	# skip blank lines and comment lines
+	next if /^$/ or /^#/ ;
+	my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
+	  warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
+	$type = TidyType($type) ;
+	$type_kind{$type} = $kind ;
+	# prototype defaults to '$'
+	$proto = "\$" unless $proto ;
+	warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
+	  unless ValidProtoString($proto) ;
+	$proto_letter{$type} = C_string($proto) ;
+      } elsif (/^\s/) {
+	$$current .= $_;
+      } elsif ($mode eq 'Input') {
+	s/\s+$//;
+	$input_expr{$_} = '';
+	$current = \$input_expr{$_};
+      } else {
+	s/\s+$//;
+	$output_expr{$_} = '';
+	$current = \$output_expr{$_};
+      }
+    }
+    close(TYPEMAP);
+  }
+
+  foreach my $key (keys %input_expr) {
+    $input_expr{$key} =~ s/;*\s+\z//;
+  }
+
+  my ($bal, $cast, $size);
+  $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
+  $cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast
+  $size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
+
+  foreach my $key (keys %output_expr) {
+    use re 'eval';
+
+    my ($t, $with_size, $arg, $sarg) =
+      ($output_expr{$key} =~
+       m[^ \s+ sv_set ( [iunp] ) v (n)?	# Type, is_setpvn
+	 \s* \( \s* $cast \$arg \s* ,
+	 \s* ( (??{ $bal }) )	# Set from
+	 ( (??{ $size }) )?	# Possible sizeof set-from
+	 \) \s* ; \s* $
+	]x);
+    $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
+  }
+
+  my $END = "!End!\n\n";		# "impossible" keyword (multiple newline)
+
+  # Match an XS keyword
+  $BLOCK_re= '\s*(' . join('|', qw(
+				   REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
+				   CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+				   SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
+				  )) . "|$END)\\s*:";
+
+  
+  my ($C_group_rex, $C_arg);
+  # Group in C (no support for comments or literals)
+  $C_group_rex = qr/ [({\[]
+		       (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
+		       [)}\]] /x ;
+  # Chunk in C without comma at toplevel (no comments):
+  $C_arg = qr/ (?: (?> [^()\[\]{},"']+ )
+	     |   (??{ $C_group_rex })
+	     |   " (?: (?> [^\\"]+ )
+		   |   \\.
+		   )* "		# String literal
+			    |   ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal
+	     )* /xs;
+  
+  # Identify the version of xsubpp used
+  print <<EOM ;
+/*
+ * This file was generated automatically by ExtUtils::ParseXS version $VERSION from the
+ * contents of $filename. Do not edit this file, edit $filename instead.
+ *
+ *	ANY CHANGES MADE HERE WILL BE LOST! 
+ *
+ */
+
+EOM
+
+
+  print("#line 1 \"$filepathname\"\n")
+    if $WantLineNumbers;
+
+  firstmodule:
+  while (<$FH>) {
+    if (/^=/) {
+      my $podstartline = $.;
+      do {
+	if (/^=cut\s*$/) {
+	  # We can't just write out a /* */ comment, as our embedded
+	  # POD might itself be in a comment. We can't put a /**/
+	  # comment inside #if 0, as the C standard says that the source
+	  # file is decomposed into preprocessing characters in the stage
+	  # before preprocessing commands are executed.
+	  # I don't want to leave the text as barewords, because the spec
+	  # isn't clear whether macros are expanded before or after
+	  # preprocessing commands are executed, and someone pathological
+	  # may just have defined one of the 3 words as a macro that does
+	  # something strange. Multiline strings are illegal in C, so
+	  # the "" we write must be a string literal. And they aren't
+	  # concatenated until 2 steps later, so we are safe.
+	  #     - Nicholas Clark
+	  print("#if 0\n  \"Skipped embedded POD.\"\n#endif\n");
+	  printf("#line %d \"$filepathname\"\n", $. + 1)
+	    if $WantLineNumbers;
+	  next firstmodule
+	}
+	
+      } while (<$FH>);
+      # At this point $. is at end of file so die won't state the start
+      # of the problem, and as we haven't yet read any lines &death won't
+      # show the correct line in the message either.
+      die ("Error: Unterminated pod in $filename, line $podstartline\n")
+	unless $lastline;
+    }
+    last if ($Package, $Prefix) =
+      /^MODULE\s*=\s*[\w:]+(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+    
+    print $_;
+  }
+  unless (defined $_) {
+    warn "Didn't find a 'MODULE ... PACKAGE ... PREFIX' line\n";
+    exit 0; # Not a fatal error for the caller process
+  }
+
+    print <<"EOF";
+#ifndef PERL_UNUSED_VAR
+#  define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+EOF
+
+  print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+
+  $lastline    = $_;
+  $lastline_no = $.;
+
+ PARAGRAPH:
+  while (fetch_para()) {
+    # Print initial preprocessor statements and blank lines
+    while (@line && $line[0] !~ /^[^\#]/) {
+      my $line = shift(@line);
+      print $line, "\n";
+      next unless $line =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
+      my $statement = $+;
+      if ($statement eq 'if') {
+	$XSS_work_idx = @XSStack;
+	push(@XSStack, {type => 'if'});
+      } else {
+	death ("Error: `$statement' with no matching `if'")
+	  if $XSStack[-1]{type} ne 'if';
+	if ($XSStack[-1]{varname}) {
+	  push(@InitFileCode, "#endif\n");
+	  push(@BootCode,     "#endif");
+	}
+	
+	my(@fns) = keys %{$XSStack[-1]{functions}};
+	if ($statement ne 'endif') {
+	  # Hide the functions defined in other #if branches, and reset.
+	  @{$XSStack[-1]{other_functions}}{@fns} = (1) x @fns;
+	  @{$XSStack[-1]}{qw(varname functions)} = ('', {});
+	} else {
+	  my($tmp) = pop(@XSStack);
+	  0 while (--$XSS_work_idx
+		   && $XSStack[$XSS_work_idx]{type} ne 'if');
+	  # Keep all new defined functions
+	  push(@fns, keys %{$tmp->{other_functions}});
+	  @{$XSStack[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
+	}
+      }
+    }
+    
+    next PARAGRAPH unless @line;
+    
+    if ($XSS_work_idx && !$XSStack[$XSS_work_idx]{varname}) {
+      # We are inside an #if, but have not yet #defined its xsubpp variable.
+      print "#define $cpp_next_tmp 1\n\n";
+      push(@InitFileCode, "#if $cpp_next_tmp\n");
+      push(@BootCode,     "#if $cpp_next_tmp");
+      $XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
+    }
+
+    death ("Code is not inside a function"
+	   ." (maybe last function was ended by a blank line "
+	   ." followed by a statement on column one?)")
+      if $line[0] =~ /^\s/;
+    
+    my ($class, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
+    my (@fake_INPUT_pre);	# For length(s) generated variables
+    my (@fake_INPUT);
+    
+    # initialize info arrays
+    undef(%args_match);
+    undef(%var_types);
+    undef(%defaults);
+    undef(%arg_list) ;
+    undef(@proto_arg) ;
+    undef($processing_arg_with_types) ;
+    undef(%argtype_seen) ;
+    undef(@outlist) ;
+    undef(%in_out) ;
+    undef(%lengthof) ;
+    undef($proto_in_this_xsub) ;
+    undef($scope_in_this_xsub) ;
+    undef($interface);
+    undef($prepush_done);
+    $interface_macro = 'XSINTERFACE_FUNC' ;
+    $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
+    $ProtoThisXSUB = $WantPrototypes ;
+    $ScopeThisXSUB = 0;
+    $xsreturn = 0;
+
+    $_ = shift(@line);
+    while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE")) {
+      &{"${kwd}_handler"}() ;
+      next PARAGRAPH unless @line ;
+      $_ = shift(@line);
+    }
+
+    if (check_keyword("BOOT")) {
+      &check_cpp;
+      push (@BootCode, "#line $line_no[@line_no - @line] \"$filepathname\"")
+	if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
+      push (@BootCode, @line, "") ;
+      next PARAGRAPH ;
+    }
+
+
+    # extract return type, function name and arguments
+    ($ret_type) = TidyType($_);
+    $RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//;
+
+    # Allow one-line ANSI-like declaration
+    unshift @line, $2
+      if $process_argtypes
+	and $ret_type =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s;
+
+    # a function definition needs at least 2 lines
+    blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
+      unless @line ;
+
+    $static = 1 if $ret_type =~ s/^static\s+//;
+
+    $func_header = shift(@line);
+    blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
+      unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s;
+
+    ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
+    $class = "$4 $class" if $4;
+    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+    ($clean_func_name = $func_name) =~ s/^$Prefix//;
+    $Full_func_name = "${Packid}_$clean_func_name";
+    if ($Is_VMS) {
+      $Full_func_name = $SymSet->addsym($Full_func_name);
+    }
+
+    # Check for duplicate function definition
+    for my $tmp (@XSStack) {
+      next unless defined $tmp->{functions}{$Full_func_name};
+      Warn("Warning: duplicate function definition '$clean_func_name' detected");
+      last;
+    }
+    $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+    %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
+    $DoSetMagic = 1;
+
+    $orig_args =~ s/\\\s*/ /g;	# process line continuations
+    my @args;
+
+    my %only_C_inlist;		# Not in the signature of Perl function
+    if ($process_argtypes and $orig_args =~ /\S/) {
+      my $args = "$orig_args ,";
+      if ($args =~ /^( (??{ $C_arg }) , )* $ /x) {
+	@args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg);
+	for ( @args ) {
+	  s/^\s+//;
+	  s/\s+$//;
+	  my ($arg, $default) = / ( [^=]* ) ( (?: = .* )? ) /x;
+	  my ($pre, $name) = ($arg =~ /(.*?) \s*
+					     \b ( \w+ | length\( \s*\w+\s* \) )
+					     \s* $ /x);
+	  next unless defined($pre) && length($pre);
+	  my $out_type;
+	  my $inout_var;
+	  if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
+	    my $type = $1;
+	    $out_type = $type if $type ne 'IN';
+	    $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
+	    $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
+	  }
+	  my $islength;
+	  if ($name =~ /^length\( \s* (\w+) \s* \)\z/x) {
+	    $name = "XSauto_length_of_$1";
+	    $islength = 1;
+	    die "Default value on length() argument: `$_'"
+	      if length $default;
+	  }
+	  if (length $pre or $islength) { # Has a type
+	    if ($islength) {
+	      push @fake_INPUT_pre, $arg;
+	    } else {
+	      push @fake_INPUT, $arg;
+	    }
+	    # warn "pushing '$arg'\n";
+	    $argtype_seen{$name}++;
+	    $_ = "$name$default"; # Assigns to @args
+	  }
+	  $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST" or $islength;
+	  push @outlist, $name if $out_type =~ /OUTLIST$/;
+	  $in_out{$name} = $out_type if $out_type;
+	}
+      } else {
+	@args = split(/\s*,\s*/, $orig_args);
+	Warn("Warning: cannot parse argument list '$orig_args', fallback to split");
+      }
+    } else {
+      @args = split(/\s*,\s*/, $orig_args);
+      for (@args) {
+	if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) {
+	  my $out_type = $1;
+	  next if $out_type eq 'IN';
+	  $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST";
+	  push @outlist, $name if $out_type =~ /OUTLIST$/;
+	  $in_out{$_} = $out_type;
+	}
+      }
+    }
+    if (defined($class)) {
+      my $arg0 = ((defined($static) or $func_name eq 'new')
+		  ? "CLASS" : "THIS");
+      unshift(@args, $arg0);
+      ($report_args = "$arg0, $report_args") =~ s/^\w+, $/$arg0/;
+    }
+    my $extra_args = 0;
+    @args_num = ();
+    $num_args = 0;
+    my $report_args = '';
+    foreach my $i (0 .. $#args) {
+      if ($args[$i] =~ s/\.\.\.//) {
+	$elipsis = 1;
+	if ($args[$i] eq '' && $i == $#args) {
+	  $report_args .= ", ...";
+	  pop(@args);
+	  last;
+	}
+      }
+      if ($only_C_inlist{$args[$i]}) {
+	push @args_num, undef;
+      } else {
+	push @args_num, ++$num_args;
+	$report_args .= ", $args[$i]";
+      }
+      if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
+	$extra_args++;
+	$args[$i] = $1;
+	$defaults{$args[$i]} = $2;
+	$defaults{$args[$i]} =~ s/"/\\"/g;
+      }
+      $proto_arg[$i+1] = '$' ;
+    }
+    $min_args = $num_args - $extra_args;
+    $report_args =~ s/"/\\"/g;
+    $report_args =~ s/^,\s+//;
+    my @func_args = @args;
+    shift @func_args if defined($class);
+
+    for (@func_args) {
+      s/^/&/ if $in_out{$_};
+    }
+    $func_args = join(", ", @func_args);
+    @args_match{@args} = @args_num;
+
+    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    $CODE = grep(/^\s*CODE\s*:/, @line);
+    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
+    #   to set explicit return values.
+    $EXPLICIT_RETURN = ($CODE &&
+			("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
+    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
+    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);
+
+    $xsreturn = 1 if $EXPLICIT_RETURN;
+
+    # print function header
+    print Q(<<"EOF");
+#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Full_func_name})
+#[[
+#    dXSARGS;
+EOF
+    print Q(<<"EOF") if $ALIAS ;
+#    dXSI32;
+EOF
+    print Q(<<"EOF") if $INTERFACE ;
+#    dXSFUNCTION($ret_type);
+EOF
+    if ($elipsis) {
+      $cond = ($min_args ? qq(items < $min_args) : 0);
+    } elsif ($min_args == $num_args) {
+      $cond = qq(items != $min_args);
+    } else {
+      $cond = qq(items < $min_args || items > $num_args);
+    }
+
+    print Q(<<"EOF") if $except;
+#    char errbuf[1024];
+#    *errbuf = '\0';
+EOF
+
+    if ($ALIAS)
+      { print Q(<<"EOF") if $cond }
+#    if ($cond)
+#       Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
+EOF
+    else
+      { print Q(<<"EOF") if $cond }
+#    if ($cond)
+#	Perl_croak(aTHX_ "Usage: $pname($report_args)");
+EOF
+    
+     # cv doesn't seem to be used, in most cases unless we go in 
+     # the if of this else
+     print Q(<<"EOF");
+#    PERL_UNUSED_VAR(cv); /* -W */
+EOF
+
+    #gcc -Wall: if an xsub has PPCODE is used
+    #it is possible none of ST, XSRETURN or XSprePUSH macros are used
+    #hence `ax' (setup by dXSARGS) is unused
+    #XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
+    #but such a move could break third-party extensions
+    print Q(<<"EOF") if $PPCODE;
+#    PERL_UNUSED_VAR(ax); /* -Wall */
+EOF
+
+    print Q(<<"EOF") if $PPCODE;
+#    SP -= items;
+EOF
+
+    # Now do a block of some sort.
+
+    $condnum = 0;
+    $cond = '';			# last CASE: condidional
+    push(@line, "$END:");
+    push(@line_no, $line_no[-1]);
+    $_ = '';
+    &check_cpp;
+    while (@line) {
+      &CASE_handler if check_keyword("CASE");
+      print Q(<<"EOF");
+#   $except [[
+EOF
+
+      # do initialization of input variables
+      $thisdone = 0;
+      $retvaldone = 0;
+      $deferred = "";
+      %arg_list = () ;
+      $gotRETVAL = 0;
+	
+      INPUT_handler() ;
+      process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD") ;
+
+      print Q(<<"EOF") if $ScopeThisXSUB;
+#   ENTER;
+#   [[
+EOF
+	
+      if (!$thisdone && defined($class)) {
+	if (defined($static) or $func_name eq 'new') {
+	  print "\tchar *";
+	  $var_types{"CLASS"} = "char *";
+	  &generate_init("char *", 1, "CLASS");
+	}
+	else {
+	  print "\t$class *";
+	  $var_types{"THIS"} = "$class *";
+	  &generate_init("$class *", 1, "THIS");
+	}
+      }
+      
+      # do code
+      if (/^\s*NOT_IMPLEMENTED_YET/) {
+	print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n";
+	$_ = '' ;
+      } else {
+	if ($ret_type ne "void") {
+	  print "\t" . &map_type($ret_type, 'RETVAL') . ";\n"
+	    if !$retvaldone;
+	  $args_match{"RETVAL"} = 0;
+	  $var_types{"RETVAL"} = $ret_type;
+	  print "\tdXSTARG;\n"
+	    if $WantOptimize and $targetable{$type_kind{$ret_type}};
+	}
+	
+	if (@fake_INPUT or @fake_INPUT_pre) {
+	  unshift @line, @fake_INPUT_pre, @fake_INPUT, $_;
+	  $_ = "";
+	  $processing_arg_with_types = 1;
+	  INPUT_handler() ;
+	}
+	print $deferred;
+	
+        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
+	
+	if (check_keyword("PPCODE")) {
+	  print_section();
+	  death ("PPCODE must be last thing") if @line;
+	  print "\tLEAVE;\n" if $ScopeThisXSUB;
+	  print "\tPUTBACK;\n\treturn;\n";
+	} elsif (check_keyword("CODE")) {
+	  print_section() ;
+	} elsif (defined($class) and $func_name eq "DESTROY") {
+	  print "\n\t";
+	  print "delete THIS;\n";
+	} else {
+	  print "\n\t";
+	  if ($ret_type ne "void") {
+	    print "RETVAL = ";
+	    $wantRETVAL = 1;
+	  }
+	  if (defined($static)) {
+	    if ($func_name eq 'new') {
+	      $func_name = "$class";
+	    } else {
+	      print "${class}::";
+	    }
+	  } elsif (defined($class)) {
+	    if ($func_name eq 'new') {
+	      $func_name .= " $class";
+	    } else {
+	      print "THIS->";
+	    }
+	  }
+	  $func_name =~ s/^\Q$args{'s'}//
+	    if exists $args{'s'};
+	  $func_name = 'XSFUNCTION' if $interface;
+	  print "$func_name($func_args);\n";
+	}
+      }
+      
+      # do output variables
+      $gotRETVAL = 0;		# 1 if RETVAL seen in OUTPUT section;
+      undef $RETVAL_code ;	# code to set RETVAL (from OUTPUT section);
+      # $wantRETVAL set if 'RETVAL =' autogenerated
+      ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
+      undef %outargs ;
+      process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
+      
+      &generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic)
+	for grep $in_out{$_} =~ /OUT$/, keys %in_out;
+      
+      # all OUTPUT done, so now push the return value on the stack
+      if ($gotRETVAL && $RETVAL_code) {
+	print "\t$RETVAL_code\n";
+      } elsif ($gotRETVAL || $wantRETVAL) {
+	my $t = $WantOptimize && $targetable{$type_kind{$ret_type}};
+	my $var = 'RETVAL';
+	my $type = $ret_type;
+	
+	# 0: type, 1: with_size, 2: how, 3: how_size
+	if ($t and not $t->[1] and $t->[0] eq 'p') {
+	  # PUSHp corresponds to setpvn.  Treate setpv directly
+	  my $what = eval qq("$t->[2]");
+	  warn $@ if $@;
+	  
+	  print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n";
+	  $prepush_done = 1;
+	}
+	elsif ($t) {
+	  my $what = eval qq("$t->[2]");
+	  warn $@ if $@;
+	  
+	  my $size = $t->[3];
+	  $size = '' unless defined $size;
+	  $size = eval qq("$size");
+	  warn $@ if $@;
+	  print "\tXSprePUSH; PUSH$t->[0]($what$size);\n";
+	  $prepush_done = 1;
+	}
+	else {
+	  # RETVAL almost never needs SvSETMAGIC()
+	  &generate_output($ret_type, 0, 'RETVAL', 0);
+	}
+      }
+      
+      $xsreturn = 1 if $ret_type ne "void";
+      my $num = $xsreturn;
+      my $c = @outlist;
+      print "\tXSprePUSH;" if $c and not $prepush_done;
+      print "\tEXTEND(SP,$c);\n" if $c;
+      $xsreturn += $c;
+      generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
+      
+      # do cleanup
+      process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
+      
+      print Q(<<"EOF") if $ScopeThisXSUB;
+#   ]]
+EOF
+      print Q(<<"EOF") if $ScopeThisXSUB and not $PPCODE;
+#   LEAVE;
+EOF
+      
+      # print function trailer
+      print Q(<<"EOF");
+#    ]]
+EOF
+      print Q(<<"EOF") if $except;
+#    BEGHANDLERS
+#    CATCHALL
+#	sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
+#    ENDHANDLERS
+EOF
+      if (check_keyword("CASE")) {
+	blurt ("Error: No `CASE:' at top of function")
+	  unless $condnum;
+	$_ = "CASE: $_";	# Restore CASE: label
+	next;
+      }
+      last if $_ eq "$END:";
+      death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
+    }
+    
+    print Q(<<"EOF") if $except;
+#    if (errbuf[0])
+#	Perl_croak(aTHX_ errbuf);
+EOF
+    
+    if ($xsreturn) {
+      print Q(<<"EOF") unless $PPCODE;
+#    XSRETURN($xsreturn);
+EOF
+    } else {
+      print Q(<<"EOF") unless $PPCODE;
+#    XSRETURN_EMPTY;
+EOF
+    }
+
+    print Q(<<"EOF");
+#]]
+#
+EOF
+
+    my $newXS = "newXS" ;
+    my $proto = "" ;
+    
+    # Build the prototype string for the xsub
+    if ($ProtoThisXSUB) {
+      $newXS = "newXSproto";
+      
+      if ($ProtoThisXSUB eq 2) {
+	# User has specified empty prototype
+      }
+      elsif ($ProtoThisXSUB eq 1) {
+	my $s = ';';
+	if ($min_args < $num_args)  {
+	  $s = '';
+	  $proto_arg[$min_args] .= ";" ;
+	}
+	push @proto_arg, "$s\@"
+	  if $elipsis ;
+	
+	$proto = join ("", grep defined, @proto_arg);
+      }
+      else {
+	# User has specified a prototype
+	$proto = $ProtoThisXSUB;
+      }
+      $proto = qq{, "$proto"};
+    }
+    
+    if (%XsubAliases) {
+      $XsubAliases{$pname} = 0
+	unless defined $XsubAliases{$pname} ;
+      while ( ($name, $value) = each %XsubAliases) {
+	push(@InitFileCode, Q(<<"EOF"));
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        XSANY.any_i32 = $value ;
+EOF
+	push(@InitFileCode, Q(<<"EOF")) if $proto;
+#        sv_setpv((SV*)cv$proto) ;
+EOF
+      }
+    }
+    elsif (@Attributes) {
+      push(@InitFileCode, Q(<<"EOF"));
+#        cv = newXS(\"$pname\", XS_$Full_func_name, file);
+#        apply_attrs_string("$Package", cv, "@Attributes", 0);
+EOF
+    }
+    elsif ($interface) {
+      while ( ($name, $value) = each %Interfaces) {
+	$name = "$Package\::$name" unless $name =~ /::/;
+	push(@InitFileCode, Q(<<"EOF"));
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        $interface_macro_set(cv,$value) ;
+EOF
+	push(@InitFileCode, Q(<<"EOF")) if $proto;
+#        sv_setpv((SV*)cv$proto) ;
+EOF
+      }
+    }
+    else {
+      push(@InitFileCode,
+	   "        ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+    }
+  }
+
+  if ($Overload) # make it findable with fetchmethod
+  {
+    print Q(<<"EOF");
+#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
+#XS(XS_${Packid}_nil)
+#{
+#   XSRETURN_EMPTY;
+#}
+#
+EOF
+    unshift(@InitFileCode, <<"MAKE_FETCHMETHOD_WORK");
+    /* Making a sub named "${Package}::()" allows the package */
+    /* to be findable via fetchmethod(), and causes */
+    /* overload::Overloaded("${Package}") to return true. */
+    newXS("${Package}::()", XS_${Packid}_nil, file$proto);
+MAKE_FETCHMETHOD_WORK
+  }
+
+  # print initialization routine
+
+  print Q(<<"EOF");
+##ifdef __cplusplus
+#extern "C"
+##endif
+EOF
+
+  print Q(<<"EOF");
+#XS(boot_$Module_cname); /* prototype to pass -Wmissing-prototypes */
+#XS(boot_$Module_cname)
+EOF
+
+  print Q(<<"EOF");
+#[[
+#    dXSARGS;
+EOF
+
+  #-Wall: if there is no $Full_func_name there are no xsubs in this .xs
+  #so `file' is unused
+  print Q(<<"EOF") if $Full_func_name;
+#    char* file = __FILE__;
+EOF
+
+  print Q("#\n");
+
+  print Q(<<"EOF");
+#    PERL_UNUSED_VAR(cv); /* -W */
+#    PERL_UNUSED_VAR(items); /* -W */
+EOF
+    
+  print Q(<<"EOF") if $WantVersionChk ;
+#    XS_VERSION_BOOTCHECK ;
+#
+EOF
+
+  print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+#    {
+#        CV * cv ;
+#
+EOF
+
+  print Q(<<"EOF") if ($Overload);
+#    /* register the overloading (type 'A') magic */
+#    PL_amagic_generation++;
+#    /* The magic for overload gets a GV* via gv_fetchmeth as */
+#    /* mentioned above, and looks in the SV* slot of it for */
+#    /* the "fallback" status. */
+#    sv_setsv(
+#        get_sv( "${Package}::()", TRUE ),
+#        $Fallback
+#    );
+EOF
+
+  print @InitFileCode;
+
+  print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+#    }
+EOF
+
+  if (@BootCode)
+  {
+    print "\n    /* Initialisation Section */\n\n" ;
+    @line = @BootCode;
+    print_section();
+    print "\n    /* End of Initialisation Section */\n\n" ;
+  }
+
+  print Q(<<"EOF");
+#    XSRETURN_YES;
+#]]
+#
+EOF
+
+  warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
+    unless $ProtoUsed ;
+
+  chdir($orig_cwd);
+  select($orig_fh);
+  untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
+
+  return 1;
+}
+
+sub errors { $errors }
+
+sub standard_typemap_locations {
+  # Add all the default typemap locations to the search path
+  my @tm = qw(typemap);
+  
+  my $updir = File::Spec->updir;
+  foreach my $dir (File::Spec->catdir(($updir) x 1), File::Spec->catdir(($updir) x 2),
+		   File::Spec->catdir(($updir) x 3), File::Spec->catdir(($updir) x 4)) {
+    
+    unshift @tm, File::Spec->catfile($dir, 'typemap');
+    unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
+  }
+  foreach my $dir (@INC) {
+    my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
+    unshift @tm, $file if -e $file;
+  }
+  return @tm;
+}
+  
+sub TrimWhitespace
+{
+  $_[0] =~ s/^\s+|\s+$//go ;
+}
+
+sub TidyType
+  {
+    local ($_) = @_ ;
+
+    # rationalise any '*' by joining them into bunches and removing whitespace
+    s#\s*(\*+)\s*#$1#g;
+    s#(\*+)# $1 #g ;
+
+    # change multiple whitespace into a single space
+    s/\s+/ /g ;
+
+    # trim leading & trailing whitespace
+    TrimWhitespace($_) ;
+
+    $_ ;
+}
+
+# Input:  ($_, @line) == unparsed input.
+# Output: ($_, @line) == (rest of line, following lines).
+# Return: the matched keyword if found, otherwise 0
+sub check_keyword {
+	$_ = shift(@line) while !/\S/ && @line;
+	s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
+}
+
+sub print_section {
+    # the "do" is required for right semantics
+    do { $_ = shift(@line) } while !/\S/ && @line;
+
+    print("#line ", $line_no[@line_no - @line -1], " \"$filepathname\"\n")
+	if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	print "$_\n";
+    }
+    print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+}
+
+sub merge_section {
+    my $in = '';
+
+    while (!/\S/ && @line) {
+      $_ = shift(@line);
+    }
+
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+      $in .= "$_\n";
+    }
+    chomp $in;
+    return $in;
+  }
+
+sub process_keyword($)
+  {
+    my($pattern) = @_ ;
+    my $kwd ;
+
+    &{"${kwd}_handler"}()
+      while $kwd = check_keyword($pattern) ;
+  }
+
+sub CASE_handler {
+  blurt ("Error: `CASE:' after unconditional `CASE:'")
+    if $condnum && $cond eq '';
+  $cond = $_;
+  TrimWhitespace($cond);
+  print "   ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
+  $_ = '' ;
+}
+
+sub INPUT_handler {
+  for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+    last if /^\s*NOT_IMPLEMENTED_YET/;
+    next unless /\S/;		# skip blank lines
+
+    TrimWhitespace($_) ;
+    my $line = $_ ;
+
+    # remove trailing semicolon if no initialisation
+    s/\s*;$//g unless /[=;+].*\S/ ;
+
+    # Process the length(foo) declarations
+    if (s/^([^=]*)\blength\(\s*(\w+)\s*\)\s*$/$1 XSauto_length_of_$2=NO_INIT/x) {
+      print "\tSTRLEN\tSTRLEN_length_of_$2;\n";
+      $lengthof{$2} = $name;
+      # $islengthof{$name} = $1;
+      $deferred .= "\n\tXSauto_length_of_$2 = STRLEN_length_of_$2;";
+    }
+
+    # check for optional initialisation code
+    my $var_init = '' ;
+    $var_init = $1 if s/\s*([=;+].*)$//s ;
+    $var_init =~ s/"/\\"/g;
+
+    s/\s+/ /g;
+    my ($var_type, $var_addr, $var_name) = /^(.*?[^&\s])\s*(\&?)\s*\b(\w+)$/s
+      or blurt("Error: invalid argument declaration '$line'"), next;
+
+    # Check for duplicate definitions
+    blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
+      if $arg_list{$var_name}++
+	or defined $argtype_seen{$var_name} and not $processing_arg_with_types;
+
+    $thisdone |= $var_name eq "THIS";
+    $retvaldone |= $var_name eq "RETVAL";
+    $var_types{$var_name} = $var_type;
+    # XXXX This check is a safeguard against the unfinished conversion of
+    # generate_init().  When generate_init() is fixed,
+    # one can use 2-args map_type() unconditionally.
+    if ($var_type =~ / \( \s* \* \s* \) /x) {
+      # Function pointers are not yet supported with &output_init!
+      print "\t" . &map_type($var_type, $var_name);
+      $name_printed = 1;
+    } else {
+      print "\t" . &map_type($var_type);
+      $name_printed = 0;
+    }
+    $var_num = $args_match{$var_name};
+
+    $proto_arg[$var_num] = ProtoString($var_type)
+      if $var_num ;
+    $func_args =~ s/\b($var_name)\b/&$1/ if $var_addr;
+    if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
+	or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/
+	and $var_init !~ /\S/) {
+      if ($name_printed) {
+	print ";\n";
+      } else {
+	print "\t$var_name;\n";
+      }
+    } elsif ($var_init =~ /\S/) {
+      &output_init($var_type, $var_num, $var_name, $var_init, $name_printed);
+    } elsif ($var_num) {
+      # generate initialization code
+      &generate_init($var_type, $var_num, $var_name, $name_printed);
+    } else {
+      print ";\n";
+    }
+  }
+}
+
+sub OUTPUT_handler {
+  for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+    next unless /\S/;
+    if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
+      $DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
+      next;
+    }
+    my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
+    blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
+      if $outargs{$outarg} ++ ;
+    if (!$gotRETVAL and $outarg eq 'RETVAL') {
+      # deal with RETVAL last
+      $RETVAL_code = $outcode ;
+      $gotRETVAL = 1 ;
+      next ;
+    }
+    blurt ("Error: OUTPUT $outarg not an argument"), next
+      unless defined($args_match{$outarg});
+    blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
+      unless defined $var_types{$outarg} ;
+    $var_num = $args_match{$outarg};
+    if ($outcode) {
+      print "\t$outcode\n";
+      print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic;
+    } else {
+      &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
+    }
+    delete $in_out{$outarg} 	# No need to auto-OUTPUT
+      if exists $in_out{$outarg} and $in_out{$outarg} =~ /OUT$/;
+  }
+}
+
+sub C_ARGS_handler() {
+  my $in = merge_section();
+
+  TrimWhitespace($in);
+  $func_args = $in;
+}
+
+sub INTERFACE_MACRO_handler() {
+  my $in = merge_section();
+
+  TrimWhitespace($in);
+  if ($in =~ /\s/) {		# two
+    ($interface_macro, $interface_macro_set) = split ' ', $in;
+  } else {
+    $interface_macro = $in;
+    $interface_macro_set = 'UNKNOWN_CVT'; # catch later
+  }
+  $interface = 1;		# local
+  $Interfaces = 1;		# global
+}
+
+sub INTERFACE_handler() {
+  my $in = merge_section();
+
+  TrimWhitespace($in);
+
+  foreach (split /[\s,]+/, $in) {
+    $Interfaces{$_} = $_;
+  }
+  print Q(<<"EOF");
+#	XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
+EOF
+  $interface = 1;		# local
+  $Interfaces = 1;		# global
+}
+
+sub CLEANUP_handler() { print_section() }
+sub PREINIT_handler() { print_section() }
+sub POSTCALL_handler() { print_section() }
+sub INIT_handler()    { print_section() }
+
+sub GetAliases
+  {
+    my ($line) = @_ ;
+    my ($orig) = $line ;
+    my ($alias) ;
+    my ($value) ;
+
+    # Parse alias definitions
+    # format is
+    #    alias = value alias = value ...
+
+    while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
+      $alias = $1 ;
+      $orig_alias = $alias ;
+      $value = $2 ;
+
+      # check for optional package definition in the alias
+      $alias = $Packprefix . $alias if $alias !~ /::/ ;
+
+      # check for duplicate alias name & duplicate value
+      Warn("Warning: Ignoring duplicate alias '$orig_alias'")
+	if defined $XsubAliases{$alias} ;
+
+      Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
+	if $XsubAliasValues{$value} ;
+
+      $XsubAliases = 1;
+      $XsubAliases{$alias} = $value ;
+      $XsubAliasValues{$value} = $orig_alias ;
+    }
+
+    blurt("Error: Cannot parse ALIAS definitions from '$orig'")
+      if $line ;
+  }
+
+sub ATTRS_handler ()
+  {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+      next unless /\S/;
+      TrimWhitespace($_) ;
+      push @Attributes, $_;
+    }
+  }
+
+sub ALIAS_handler ()
+  {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+      next unless /\S/;
+      TrimWhitespace($_) ;
+      GetAliases($_) if $_ ;
+    }
+  }
+
+sub OVERLOAD_handler()
+{
+  for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+    next unless /\S/;
+    TrimWhitespace($_) ;
+    while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) {
+      $Overload = 1 unless $Overload;
+      my $overload = "$Package\::(".$1 ;
+      push(@InitFileCode,
+	   "        newXS(\"$overload\", XS_$Full_func_name, file$proto);\n");
+    }
+  }  
+}
+
+sub FALLBACK_handler()
+{
+  # the rest of the current line should contain either TRUE, 
+  # FALSE or UNDEF
+  
+  TrimWhitespace($_) ;
+  my %map = (
+	     TRUE => "PL_sv_yes", 1 => "PL_sv_yes",
+	     FALSE => "PL_sv_no", 0 => "PL_sv_no",
+	     UNDEF => "PL_sv_undef",
+	    ) ;
+  
+  # check for valid FALLBACK value
+  death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_} ;
+  
+  $Fallback = $map{uc $_} ;
+}
+
+
+sub REQUIRE_handler ()
+  {
+    # the rest of the current line should contain a version number
+    my ($Ver) = $_ ;
+
+    TrimWhitespace($Ver) ;
+
+    death ("Error: REQUIRE expects a version number")
+      unless $Ver ;
+
+    # check that the version number is of the form n.n
+    death ("Error: REQUIRE: expected a number, got '$Ver'")
+      unless $Ver =~ /^\d+(\.\d*)?/ ;
+
+    death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.")
+      unless $VERSION >= $Ver ;
+  }
+
+sub VERSIONCHECK_handler ()
+  {
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE
+
+    TrimWhitespace($_) ;
+
+    # check for ENABLE/DISABLE
+    death ("Error: VERSIONCHECK: ENABLE/DISABLE")
+      unless /^(ENABLE|DISABLE)/i ;
+
+    $WantVersionChk = 1 if $1 eq 'ENABLE' ;
+    $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+
+  }
+
+sub PROTOTYPE_handler ()
+  {
+    my $specified ;
+
+    death("Error: Only 1 PROTOTYPE definition allowed per xsub")
+      if $proto_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+      next unless /\S/;
+      $specified = 1 ;
+      TrimWhitespace($_) ;
+      if ($_ eq 'DISABLE') {
+	$ProtoThisXSUB = 0
+      } elsif ($_ eq 'ENABLE') {
+	$ProtoThisXSUB = 1
+      } else {
+	# remove any whitespace
+	s/\s+//g ;
+	death("Error: Invalid prototype '$_'")
+	  unless ValidProtoString($_) ;
+	$ProtoThisXSUB = C_string($_) ;
+      }
+    }
+
+    # If no prototype specified, then assume empty prototype ""
+    $ProtoThisXSUB = 2 unless $specified ;
+
+    $ProtoUsed = 1 ;
+
+  }
+
+sub SCOPE_handler ()
+  {
+    death("Error: Only 1 SCOPE declaration allowed per xsub")
+      if $scope_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+      next unless /\S/;
+      TrimWhitespace($_) ;
+      if ($_ =~ /^DISABLE/i) {
+	$ScopeThisXSUB = 0
+      } elsif ($_ =~ /^ENABLE/i) {
+	$ScopeThisXSUB = 1
+      }
+    }
+
+  }
+
+sub PROTOTYPES_handler ()
+  {
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE
+
+    TrimWhitespace($_) ;
+
+    # check for ENABLE/DISABLE
+    death ("Error: PROTOTYPES: ENABLE/DISABLE")
+      unless /^(ENABLE|DISABLE)/i ;
+
+    $WantPrototypes = 1 if $1 eq 'ENABLE' ;
+    $WantPrototypes = 0 if $1 eq 'DISABLE' ;
+    $ProtoUsed = 1 ;
+
+  }
+
+sub INCLUDE_handler ()
+  {
+    # the rest of the current line should contain a valid filename
+
+    TrimWhitespace($_) ;
+
+    death("INCLUDE: filename missing")
+      unless $_ ;
+
+    death("INCLUDE: output pipe is illegal")
+      if /^\s*\|/ ;
+
+    # simple minded recursion detector
+    death("INCLUDE loop detected")
+      if $IncludedFiles{$_} ;
+
+    ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+
+    # Save the current file context.
+    push(@XSStack, {
+		    type		=> 'file',
+		    LastLine        => $lastline,
+		    LastLineNo      => $lastline_no,
+		    Line            => \@line,
+		    LineNo          => \@line_no,
+		    Filename        => $filename,
+		    Handle          => $FH,
+		   }) ;
+
+    ++ $FH ;
+
+    # open the new file
+    open ($FH, "$_") or death("Cannot open '$_': $!") ;
+
+    print Q(<<"EOF");
+#
+#/* INCLUDE:  Including '$_' from '$filename' */
+#
+EOF
+
+    $filename = $_ ;
+
+    # Prime the pump by reading the first
+    # non-blank line
+
+    # skip leading blank lines
+    while (<$FH>) {
+      last unless /^\s*$/ ;
+    }
+
+    $lastline = $_ ;
+    $lastline_no = $. ;
+
+  }
+
+sub PopFile()
+  {
+    return 0 unless $XSStack[-1]{type} eq 'file' ;
+
+    my $data     = pop @XSStack ;
+    my $ThisFile = $filename ;
+    my $isPipe   = ($filename =~ /\|\s*$/) ;
+
+    -- $IncludedFiles{$filename}
+      unless $isPipe ;
+
+    close $FH ;
+
+    $FH         = $data->{Handle} ;
+    $filename   = $data->{Filename} ;
+    $lastline   = $data->{LastLine} ;
+    $lastline_no = $data->{LastLineNo} ;
+    @line       = @{ $data->{Line} } ;
+    @line_no    = @{ $data->{LineNo} } ;
+
+    if ($isPipe and $? ) {
+      -- $lastline_no ;
+      print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n"  ;
+      exit 1 ;
+    }
+
+    print Q(<<"EOF");
+#
+#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+#
+EOF
+
+    return 1 ;
+  }
+
+sub ValidProtoString ($)
+  {
+    my($string) = @_ ;
+
+    if ( $string =~ /^$proto_re+$/ ) {
+      return $string ;
+    }
+
+    return 0 ;
+  }
+
+sub C_string ($)
+  {
+    my($string) = @_ ;
+
+    $string =~ s[\\][\\\\]g ;
+    $string ;
+  }
+
+sub ProtoString ($)
+  {
+    my ($type) = @_ ;
+
+    $proto_letter{$type} or "\$" ;
+  }
+
+sub check_cpp {
+  my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line);
+  if (@cpp) {
+    my ($cpp, $cpplevel);
+    for $cpp (@cpp) {
+      if ($cpp =~ /^\#\s*if/) {
+	$cpplevel++;
+      } elsif (!$cpplevel) {
+	Warn("Warning: #else/elif/endif without #if in this function");
+	print STDERR "    (precede it with a blank line if the matching #if is outside the function)\n"
+	  if $XSStack[-1]{type} eq 'if';
+	return;
+      } elsif ($cpp =~ /^\#\s*endif/) {
+	$cpplevel--;
+      }
+    }
+    Warn("Warning: #if without #endif in this function") if $cpplevel;
+  }
+}
+
+
+sub Q {
+  my($text) = @_;
+  $text =~ s/^#//gm;
+  $text =~ s/\[\[/{/g;
+  $text =~ s/\]\]/}/g;
+  $text;
+}
+
+# Read next xsub into @line from ($lastline, <$FH>).
+sub fetch_para {
+  # parse paragraph
+  death ("Error: Unterminated `#if/#ifdef/#ifndef'")
+    if !defined $lastline && $XSStack[-1]{type} eq 'if';
+  @line = ();
+  @line_no = () ;
+  return PopFile() if !defined $lastline;
+
+  if ($lastline =~
+      /^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
+    $Module = $1;
+    $Package = defined($2) ? $2 : ''; # keep -w happy
+    $Prefix  = defined($3) ? $3 : ''; # keep -w happy
+    $Prefix = quotemeta $Prefix ;
+    ($Module_cname = $Module) =~ s/\W/_/g;
+    ($Packid = $Package) =~ tr/:/_/;
+    $Packprefix = $Package;
+    $Packprefix .= "::" if $Packprefix ne "";
+    $lastline = "";
+  }
+
+  for (;;) {
+    # Skip embedded PODs
+    while ($lastline =~ /^=/) {
+      while ($lastline = <$FH>) {
+	last if ($lastline =~ /^=cut\s*$/);
+      }
+      death ("Error: Unterminated pod") unless $lastline;
+      $lastline = <$FH>;
+      chomp $lastline;
+      $lastline =~ s/^\s+$//;
+    }
+    if ($lastline !~ /^\s*#/ ||
+	# CPP directives:
+	#	ANSI:	if ifdef ifndef elif else endif define undef
+	#		line error pragma
+	#	gcc:	warning include_next
+	#   obj-c:	import
+	#   others:	ident (gcc notes that some cpps have this one)
+	$lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
+      last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
+      push(@line, $lastline);
+      push(@line_no, $lastline_no) ;
+    }
+
+    # Read next line and continuation lines
+    last unless defined($lastline = <$FH>);
+    $lastline_no = $.;
+    my $tmp_line;
+    $lastline .= $tmp_line
+      while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
+
+    chomp $lastline;
+    $lastline =~ s/^\s+$//;
+  }
+  pop(@line), pop(@line_no) while @line && $line[-1] eq "";
+  1;
+}
+
+sub output_init {
+  local($type, $num, $var, $init, $name_printed) = @_;
+  local($arg) = "ST(" . ($num - 1) . ")";
+
+  if (  $init =~ /^=/  ) {
+    if ($name_printed) {
+      eval qq/print " $init\\n"/;
+    } else {
+      eval qq/print "\\t$var $init\\n"/;
+    }
+    warn $@   if  $@;
+  } else {
+    if (  $init =~ s/^\+//  &&  $num  ) {
+      &generate_init($type, $num, $var, $name_printed);
+    } elsif ($name_printed) {
+      print ";\n";
+      $init =~ s/^;//;
+    } else {
+      eval qq/print "\\t$var;\\n"/;
+      warn $@   if  $@;
+      $init =~ s/^;//;
+    }
+    $deferred .= eval qq/"\\n\\t$init\\n"/;
+    warn $@   if  $@;
+  }
+}
+
+sub Warn
+  {
+    # work out the line number
+    my $line_no = $line_no[@line_no - @line -1] ;
+
+    print STDERR "@_ in $filename, line $line_no\n" ;
+  }
+
+sub blurt
+  {
+    Warn @_ ;
+    $errors ++
+  }
+
+sub death
+  {
+    Warn @_ ;
+    exit 1 ;
+  }
+
+sub generate_init {
+  local($type, $num, $var) = @_;
+  local($arg) = "ST(" . ($num - 1) . ")";
+  local($argoff) = $num - 1;
+  local($ntype);
+  local($tk);
+
+  $type = TidyType($type) ;
+  blurt("Error: '$type' not in typemap"), return
+    unless defined($type_kind{$type});
+
+  ($ntype = $type) =~ s/\s*\*/Ptr/g;
+  ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+  $tk = $type_kind{$type};
+  $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
+  if ($tk eq 'T_PV' and exists $lengthof{$var}) {
+    print "\t$var" unless $name_printed;
+    print " = ($type)SvPV($arg, STRLEN_length_of_$var);\n";
+    die "default value not supported with length(NAME) supplied"
+      if defined $defaults{$var};
+    return;
+  }
+  $type =~ tr/:/_/ unless $hiertype;
+  blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
+    unless defined $input_expr{$tk} ;
+  $expr = $input_expr{$tk};
+  if ($expr =~ /DO_ARRAY_ELEM/) {
+    blurt("Error: '$subtype' not in typemap"), return
+      unless defined($type_kind{$subtype});
+    blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
+      unless defined $input_expr{$type_kind{$subtype}} ;
+    $subexpr = $input_expr{$type_kind{$subtype}};
+    $subexpr =~ s/\$type/\$subtype/g;
+    $subexpr =~ s/ntype/subtype/g;
+    $subexpr =~ s/\$arg/ST(ix_$var)/g;
+    $subexpr =~ s/\n\t/\n\t\t/g;
+    $subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
+    $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+    $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
+  }
+  if ($expr =~ m#/\*.*scope.*\*/#i) {  # "scope" in C comments
+    $ScopeThisXSUB = 1;
+  }
+  if (defined($defaults{$var})) {
+    $expr =~ s/(\t+)/$1    /g;
+    $expr =~ s/        /\t/g;
+    if ($name_printed) {
+      print ";\n";
+    } else {
+      eval qq/print "\\t$var;\\n"/;
+      warn $@   if  $@;
+    }
+    if ($defaults{$var} eq 'NO_INIT') {
+      $deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/;
+    } else {
+      $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+    }
+    warn $@   if  $@;
+  } elsif ($ScopeThisXSUB or $expr !~ /^\s*\$var =/) {
+    if ($name_printed) {
+      print ";\n";
+    } else {
+      eval qq/print "\\t$var;\\n"/;
+      warn $@   if  $@;
+    }
+    $deferred .= eval qq/"\\n$expr;\\n"/;
+    warn $@   if  $@;
+  } else {
+    die "panic: do not know how to handle this branch for function pointers"
+      if $name_printed;
+    eval qq/print "$expr;\\n"/;
+    warn $@   if  $@;
+  }
+}
+
+sub generate_output {
+  local($type, $num, $var, $do_setmagic, $do_push) = @_;
+  local($arg) = "ST(" . ($num - ($num != 0)) . ")";
+  local($argoff) = $num - 1;
+  local($ntype);
+
+  $type = TidyType($type) ;
+  if ($type =~ /^array\(([^,]*),(.*)\)/) {
+    print "\t$arg = sv_newmortal();\n";
+    print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
+    print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+  } else {
+    blurt("Error: '$type' not in typemap"), return
+      unless defined($type_kind{$type});
+    blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
+      unless defined $output_expr{$type_kind{$type}} ;
+    ($ntype = $type) =~ s/\s*\*/Ptr/g;
+    $ntype =~ s/\(\)//g;
+    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+    $expr = $output_expr{$type_kind{$type}};
+    if ($expr =~ /DO_ARRAY_ELEM/) {
+      blurt("Error: '$subtype' not in typemap"), return
+	unless defined($type_kind{$subtype});
+      blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
+	unless defined $output_expr{$type_kind{$subtype}} ;
+      $subexpr = $output_expr{$type_kind{$subtype}};
+      $subexpr =~ s/ntype/subtype/g;
+      $subexpr =~ s/\$arg/ST(ix_$var)/g;
+      $subexpr =~ s/\$var/${var}[ix_$var]/g;
+      $subexpr =~ s/\n\t/\n\t\t/g;
+      $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
+      eval "print qq\a$expr\a";
+      warn $@   if  $@;
+      print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
+    } elsif ($var eq 'RETVAL') {
+      if ($expr =~ /^\t\$arg = new/) {
+	# We expect that $arg has refcnt 1, so we need to
+	# mortalize it.
+	eval "print qq\a$expr\a";
+	warn $@   if  $@;
+	print "\tsv_2mortal(ST($num));\n";
+	print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic;
+      } elsif ($expr =~ /^\s*\$arg\s*=/) {
+	# We expect that $arg has refcnt >=1, so we need
+	# to mortalize it!
+	eval "print qq\a$expr\a";
+	warn $@   if  $@;
+	print "\tsv_2mortal(ST(0));\n";
+	print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
+      } else {
+	# Just hope that the entry would safely write it
+	# over an already mortalized value. By
+	# coincidence, something like $arg = &sv_undef
+	# works too.
+	print "\tST(0) = sv_newmortal();\n";
+	eval "print qq\a$expr\a";
+	warn $@   if  $@;
+	# new mortals don't have set magic
+      }
+    } elsif ($do_push) {
+      print "\tPUSHs(sv_newmortal());\n";
+      $arg = "ST($num)";
+      eval "print qq\a$expr\a";
+      warn $@   if  $@;
+      print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+    } elsif ($arg =~ /^ST\(\d+\)$/) {
+      eval "print qq\a$expr\a";
+      warn $@   if  $@;
+      print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
+    }
+  }
+}
+
+sub map_type {
+  my($type, $varname) = @_;
+  
+  # C++ has :: in types too so skip this
+  $type =~ tr/:/_/ unless $hiertype;
+  $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+  if ($varname) {
+    if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) {
+      (substr $type, pos $type, 0) = " $varname ";
+    } else {
+      $type .= "\t$varname";
+    }
+  }
+  $type;
+}
+
+
+#########################################################
+package
+  ExtUtils::ParseXS::CountLines;
+use strict;
+use vars qw($SECTION_END_MARKER);
+
+sub TIEHANDLE {
+  my ($class, $cfile, $fh) = @_;
+  $cfile =~ s/\\/\\\\/g;
+  $SECTION_END_MARKER = qq{#line --- "$cfile"};
+  
+  return bless {buffer => '',
+		fh => $fh,
+		line_no => 1,
+	       }, $class;
+}
+
+sub PRINT {
+  my $self = shift;
+  for (@_) {
+    $self->{buffer} .= $_;
+    while ($self->{buffer} =~ s/^([^\n]*\n)//) {
+      my $line = $1;
+      ++ $self->{line_no};
+      $line =~ s|^\#line\s+---(?=\s)|#line $self->{line_no}|;
+      print {$self->{fh}} $line;
+    }
+  }
+}
+
+sub PRINTF {
+  my $self = shift;
+  my $fmt = shift;
+  $self->PRINT(sprintf($fmt, @_));
+}
+
+sub DESTROY {
+  # Not necessary if we're careful to end with a "\n"
+  my $self = shift;
+  print {$self->{fh}} $self->{buffer};
+}
+
+sub UNTIE {
+  # This sub does nothing, but is neccessary for references to be released.
+}
+
+sub end_marker {
+  return $SECTION_END_MARKER;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::ParseXS - converts Perl XS code into C code
+
+=head1 SYNOPSIS
+
+  use ExtUtils::ParseXS qw(process_file);
+  
+  process_file( filename => 'foo.xs' );
+
+  process_file( filename => 'foo.xs',
+                output => 'bar.c',
+                'C++' => 1,
+                typemap => 'path/to/typemap',
+                hiertype => 1,
+                except => 1,
+                prototypes => 1,
+                versioncheck => 1,
+                linenumbers => 1,
+                optimize => 1,
+                prototypes => 1,
+              );
+=head1 DESCRIPTION
+
+C<ExtUtils::ParseXS> will compile XS code into C code by embedding the constructs
+necessary to let C functions manipulate Perl values and creates the glue
+necessary to let Perl access those functions.  The compiler uses typemaps to
+determine how to map C function parameters and variables to Perl values.
+
+The compiler will search for typemap files called I<typemap>.  It will use
+the following search path to find default typemaps, with the rightmost
+typemap taking precedence.
+
+	../../../typemap:../../typemap:../typemap:typemap
+
+=head1 EXPORT
+
+None by default.  C<process_file()> may be exported upon request.
+
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item process_xs()
+
+This function processes an XS file and sends output to a C file.
+Named parameters control how the processing is done.  The following
+parameters are accepted:
+
+=over 4
+
+=item B<C++>
+
+Adds C<extern "C"> to the C code.  Default is false.
+
+=item B<hiertype>
+
+Retains C<::> in type names so that C++ hierachical types can be
+mapped.  Default is false.
+
+=item B<except>
+
+Adds exception handling stubs to the C code.  Default is false.
+
+=item B<typemap>
+
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps.  A single typemap may be specified as a string, or
+multiple typemaps can be specified in an array reference, with the
+last typemap having the highest precedence.
+
+=item B<prototypes>
+
+Generates prototype code for all xsubs.  Default is false.
+
+=item B<versioncheck>
+
+Makes sure at run time that the object file (derived from the C<.xs>
+file) and the C<.pm> files have the same version number.  Default is
+true.
+
+=item B<linenumbers>
+
+Adds C<#line> directives to the C output so error messages will look
+like they came from the original XS file.  Default is true.
+
+=item B<optimize>
+
+Enables certain optimizations.  The only optimization that is currently
+affected is the use of I<target>s by the output C code (see L<perlguts>).
+Not optimizing may significantly slow down the generated code, but this is the way
+B<xsubpp> of 5.005 and earlier operated.  Default is to optimize.
+
+=item B<inout>
+
+Enable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST>
+declarations.  Default is true.
+
+=item B<argtypes>
+
+Enable recognition of ANSI-like descriptions of function signature.
+Default is true.
+
+=item B<s>
+
+I have no clue what this does.  Strips function prefixes?
+
+=back
+
+=item errors()
+
+This function returns the number of [a certain kind of] errors
+encountered during processing of the XS file.
+
+=back
+
+=head1 AUTHOR
+
+Based on xsubpp code, written by Larry Wall.
+
+Maintained by Ken Williams, <ken@mathforum.org>
+
+=head1 COPYRIGHT
+
+Copyright 2002-2003 Ken Williams.  All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Based on the ExtUtils::xsubpp code by Larry Wall and the Perl 5
+Porters, which was released under the same license terms.
+
+=head1 SEE ALSO
+
+L<perl>, ExtUtils::xsubpp, ExtUtils::MakeMaker, L<perlxs>, L<perlxstut>.
+
+=cut
diff --git a/lib/ExtUtils/ParseXS/t/XSTest.pm b/lib/ExtUtils/ParseXS/t/XSTest.pm
new file mode 100644
index 0000000000..988ef472e8
--- /dev/null
+++ b/lib/ExtUtils/ParseXS/t/XSTest.pm
@@ -0,0 +1,8 @@
+package XSTest;
+
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+$VERSION = '0.01';
+bootstrap XSTest $VERSION;
+
+1;
diff --git a/lib/ExtUtils/ParseXS/t/XSTest.xs b/lib/ExtUtils/ParseXS/t/XSTest.xs
new file mode 100644
index 0000000000..17586b8656
--- /dev/null
+++ b/lib/ExtUtils/ParseXS/t/XSTest.xs
@@ -0,0 +1,67 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+void
+xstest_something (char * some_thing)
+{
+	some_thing = some_thing;
+}
+
+void
+xstest_something2 (char * some_thing)
+{
+	some_thing = some_thing;
+}
+
+
+MODULE = XSTest         PACKAGE = XSTest	PREFIX = xstest_
+
+PROTOTYPES: DISABLE
+
+int
+is_even(input)
+	int     input
+    CODE:
+	RETVAL = (input % 2 == 0);
+    OUTPUT:
+	RETVAL
+
+void
+xstest_something (class, some_thing)
+	char * some_thing
+    C_ARGS:
+	some_thing
+
+void
+xstest_something2 (some_thing)
+	char * some_thing
+
+void
+xstest_something3 (class, some_thing)
+	SV   * class
+	char * some_thing
+    PREINIT:
+    	int i;
+    PPCODE:
+    	/* it's up to us clear these warnings */
+	class = class;
+	some_thing = some_thing;
+	i = i;
+	XSRETURN_UNDEF;
+	
+int
+consts (class)
+	SV * class
+    ALIAS:
+	const_one = 1
+	const_two = 2
+	const_three = 3
+    CODE:
+    	/* it's up to us clear these warnings */
+    	class = class;
+	ix = ix;
+    	RETVAL = 1;
+    OUTPUT:
+	RETVAL
+
diff --git a/lib/ExtUtils/ParseXS/t/basic.t b/lib/ExtUtils/ParseXS/t/basic.t
new file mode 100644
index 0000000000..6aeec44f2a
--- /dev/null
+++ b/lib/ExtUtils/ParseXS/t/basic.t
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    chdir 't' if -d 't';
+    chdir '../lib/ExtUtils/ParseXS'
+      or die "Can't chdir to lib/ExtUtils/ParseXS: $!";
+    @INC = qw(../.. ../../.. .);
+  }
+}
+use strict;
+use Test;
+BEGIN { plan tests => 10 };
+use ExtUtils::ParseXS qw(process_file);
+use ExtUtils::CBuilder;
+ok(1); # If we made it this far, we're loaded.
+
+chdir 't' or die "Can't chdir to t/, $!";
+
+use Carp; $SIG{__WARN__} = \&Carp::cluck;
+
+#########################
+
+# Try sending to filehandle
+tie *FH, 'Foo';
+process_file( filename => 'XSTest.xs', output => \*FH, prototypes => 1 );
+ok tied(*FH)->content, '/is_even/', "Test that output contains some text";
+
+# Try sending to file
+process_file( filename => 'XSTest.xs', output => 'XSTest.c', prototypes => 0 );
+ok -e 'XSTest.c', 1, "Create an output file";
+
+# TEST doesn't like extraneous output
+my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
+
+# Try to compile the file!  Don't get too fancy, though.
+my $b = ExtUtils::CBuilder->new(quiet => $quiet);
+if ($b->have_compiler) {
+  my $module = 'XSTest';
+
+  my $obj_file = $b->compile( source => "$module.c" );
+  ok $obj_file;
+  ok -e $obj_file, 1, "Make sure $obj_file exists";
+
+  my $lib_file = $b->link( objects => $obj_file, module_name => $module );
+  ok $lib_file;
+  ok -e $lib_file, 1, "Make sure $lib_file exists";
+
+  eval {require XSTest};
+  ok $@, '';
+  ok  XSTest::is_even(8);
+  ok !XSTest::is_even(9);
+
+} else {
+  skip "Skipped can't find a C compiler & linker", 1 for 1..6;
+}
+
+#####################################################################
+
+sub Foo::TIEHANDLE { bless {}, 'Foo' }
+sub Foo::PRINT { shift->{buf} .= join '', @_ }
+sub Foo::content { shift->{buf} }
diff --git a/lib/ExtUtils/t/00compile.t b/lib/ExtUtils/t/00compile.t
index 5eb015b13d..e2995dc4a2 100644
--- a/lib/ExtUtils/t/00compile.t
+++ b/lib/ExtUtils/t/00compile.t
@@ -23,7 +23,8 @@ chdir File::Spec->updir;
 my $manifest = File::Spec->catfile('MANIFEST');
 open(MANIFEST, $manifest) or die "Can't open $manifest: $!";
 my @modules = map { m{^lib/(\S+)}; $1 } 
-              grep { m{^lib/ExtUtils/\S*\.pm}  } <MANIFEST>;
+              grep { m{^lib/ExtUtils/\S*\.pm} } 
+              grep { !m{/t/} } <MANIFEST>;
 chomp @modules;
 close MANIFEST;
 
diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 9be40e64ec..d49cbcf2f5 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -1,12 +1,53 @@
 #!./miniperl
 
+require 5.002;
+use ExtUtils::ParseXS qw(process_file);
+use Getopt::Long;
+
+my %args = ();
+
+my $usage = "Usage: xsubpp [-v] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
+
+Getopt::Long::Configure qw(no_auto_abbrev no_ignore_case);
+
+@ARGV = grep {$_ ne '-C++'} @ARGV;  # Allow -C++ for backward compatibility
+GetOptions(\%args, qw(hiertype!
+		      prototypes!
+		      versioncheck!
+		      linenumbers!
+		      optimize!
+		      inout!
+		      argtypes!
+		      object_capi!
+		      except!
+		      v
+		      typemap=s@
+		      output=s
+		      s=s
+		     ))
+  or die $usage;
+
+if ($args{v}) {
+  print "xsubpp version $ExtUtils::ParseXS::VERSION\n";
+  exit;
+}
+
+@ARGV == 1 or die $usage;
+
+$args{filename} = shift @ARGV;
+
+process_file(%args);
+exit( ExtUtils::ParseXS::errors() ? 1 : 0 );
+
+__END__
+
 =head1 NAME
 
 xsubpp - compiler to convert Perl XS code into C code
 
 =head1 SYNOPSIS
 
-B<xsubpp> [B<-v>] [B<-C++>] [B<-csuffix csuffix>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs
+B<xsubpp> [B<-v>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] [B<-output filename>]... file.xs
 
 =head1 DESCRIPTION
 
@@ -23,6 +64,8 @@ typemap taking precedence.
 
 	../../../typemap:../../typemap:../typemap:typemap
 
+It will also use a default typemap installed as C<ExtUtils::typemap>.
+
 =head1 OPTIONS
 
 Note that the C<XSOPT> MakeMaker option may be used to add these options to
@@ -30,16 +73,6 @@ any makefiles generated by MakeMaker.
 
 =over 5
 
-=item B<-C++>
-
-Adds ``extern "C"'' to the C code.
-
-=item B<-csuffix csuffix>
-
-Set the suffix used for the generated C or C++ code.  Defaults to '.c'
-(even with B<-C++>), but some platforms might want to have e.g. '.cpp'.
-Don't forget the '.' from the front.
-
 =item B<-hiertype>
 
 Retains '::' in type names so that C++ hierachical types can be mapped.
@@ -54,6 +87,11 @@ Indicates that a user-supplied typemap should take precedence over the
 default typemaps.  This option may be used multiple times, with the last
 typemap having the highest precedence.
 
+=item B<-output filename>
+
+Specifies the name of the output file to generate.  If no file is
+specified, output will be written to standard output.
+
 =item B<-v>
 
 Prints the I<xsubpp> version number to standard output, then exits.
@@ -88,6 +126,12 @@ Disable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST> declarations.
 
 Disable recognition of ANSI-like descriptions of function signature.
 
+=item B<-C++>
+
+Currently doesn't do anything at all.  This flag has been a no-op for
+many versions of perl, at least as far back as perl5.003_07.  It's
+allowed here for backwards compatibility.
+
 =back
 
 =head1 ENVIRONMENT
@@ -96,1813 +140,16 @@ No environment variables are used.
 
 =head1 AUTHOR
 
-Larry Wall
+Originally by Larry Wall.  Turned into the C<ExtUtils::ParseXS> module
+by Ken Williams.
 
 =head1 MODIFICATION HISTORY
 
-See the file F<changes.pod>.
+See the file F<Changes>.
 
 =head1 SEE ALSO
 
-perl(1), perlxs(1), perlxstut(1)
+perl(1), perlxs(1), perlxstut(1), ExtUtils::ParseXS
 
 =cut
 
-require 5.002;
-use Cwd;
-use vars qw($cplusplus $hiertype);
-use vars '%v';
-
-use Config;
-
-sub Q ;
-
-# Global Constants
-
-$XSUBPP_version = "1.9508";
-
-my ($Is_VMS, $SymSet);
-if ($^O eq 'VMS') {
-    $Is_VMS = 1;
-    # Establish set of global symbols with max length 28, since xsubpp
-    # will later add the 'XS_' prefix.
-    require ExtUtils::XSSymSet;
-    $SymSet = new ExtUtils::XSSymSet 28;
-}
-
-$FH = 'File0000' ;
-
-$usage = "Usage: xsubpp [-v] [-C++] [-csuffix csuffix] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
-
-$proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
-
-$except = "";
-$WantPrototypes = -1 ;
-$WantVersionChk = 1 ;
-$ProtoUsed = 0 ;
-$WantLineNumbers = 1 ;
-$WantOptimize = 1 ;
-$Overload = 0;
-$Fallback = 'PL_sv_undef';
-
-my $process_inout = 1;
-my $process_argtypes = 1;
-my $csuffix = '.c';
-
-SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
-    $flag = shift @ARGV;
-    $flag =~ s/^-// ;
-    $spat = quotemeta shift,	next SWITCH	if $flag eq 's';
-    $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
-    $csuffix   = shift,	next SWITCH	if $flag eq 'csuffix';
-    $hiertype  = 1,	next SWITCH	if $flag eq 'hiertype';
-    $WantPrototypes = 0, next SWITCH	if $flag eq 'noprototypes';
-    $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
-    $WantVersionChk = 0, next SWITCH	if $flag eq 'noversioncheck';
-    $WantVersionChk = 1, next SWITCH	if $flag eq 'versioncheck';
-    # XXX left this in for compat
-    next SWITCH                         if $flag eq 'object_capi';
-    $except = " TRY",	next SWITCH	if $flag eq 'except';
-    push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
-    $WantLineNumbers = 0, next SWITCH	if $flag eq 'nolinenumbers';
-    $WantLineNumbers = 1, next SWITCH	if $flag eq 'linenumbers';
-    $WantOptimize = 0, next SWITCH	if $flag eq 'nooptimize';
-    $WantOptimize = 1, next SWITCH	if $flag eq 'optimize';
-    $process_inout = 0, next SWITCH	if $flag eq 'noinout';
-    $process_inout = 1, next SWITCH	if $flag eq 'inout';
-    $process_argtypes = 0, next SWITCH	if $flag eq 'noargtypes';
-    $process_argtypes = 1, next SWITCH	if $flag eq 'argtypes';
-    (print "xsubpp version $XSUBPP_version\n"), exit
-	if $flag eq 'v';
-    die $usage;
-}
-if ($WantPrototypes == -1)
-  { $WantPrototypes = 0}
-else
-  { $ProtoUsed = 1 }
-
-
-@ARGV == 1 or die $usage;
-($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
-	or ($dir, $filename) = $ARGV[0] =~ m#(.*)\\(.*)#
-	or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
-	or ($dir, $filename) = ('.', $ARGV[0]);
-chdir($dir);
-$pwd = cwd();
-
-++ $IncludedFiles{$ARGV[0]} ;
-
-my(@XSStack) = ({type => 'none'});	# Stack of conditionals and INCLUDEs
-my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
-
-
-sub TrimWhitespace
-{
-    $_[0] =~ s/^\s+|\s+$//go ;
-}
-
-sub TidyType
-{
-    local ($_) = @_ ;
-
-    # rationalise any '*' by joining them into bunches and removing whitespace
-    s#\s*(\*+)\s*#$1#g;
-    s#(\*+)# $1 #g ;
-
-    # change multiple whitespace into a single space
-    s/\s+/ /g ;
-
-    # trim leading & trailing whitespace
-    TrimWhitespace($_) ;
-
-    $_ ;
-}
-
-$typemap = shift @ARGV;
-foreach $typemap (@tm) {
-    die "Can't find $typemap in $pwd\n" unless -r $typemap;
-}
-unshift @tm, qw(../../../../lib/ExtUtils/typemap ../../../lib/ExtUtils/typemap
-                ../../lib/ExtUtils/typemap ../../../typemap ../../typemap
-                ../typemap typemap);
-foreach $typemap (@tm) {
-    next unless -f $typemap ;
-    # skip directories, binary files etc.
-    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
-	unless -T $typemap ;
-    open(TYPEMAP, $typemap)
-	or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
-    $mode = 'Typemap';
-    $junk = "" ;
-    $current = \$junk;
-    while (<TYPEMAP>) {
-	next if /^\s*#/;
-        my $line_no = $. + 1;
-	if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
-	if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
-	if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
-	if ($mode eq 'Typemap') {
-	    chomp;
-	    my $line = $_ ;
-            TrimWhitespace($_) ;
-	    # skip blank lines and comment lines
-	    next if /^$/ or /^#/ ;
-	    my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
-		warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
-            $type = TidyType($type) ;
-	    $type_kind{$type} = $kind ;
-            # prototype defaults to '$'
-            $proto = "\$" unless $proto ;
-            warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
-                unless ValidProtoString($proto) ;
-            $proto_letter{$type} = C_string($proto) ;
-	}
-	elsif (/^\s/) {
-	    $$current .= $_;
-	}
-	elsif ($mode eq 'Input') {
-	    s/\s+$//;
-	    $input_expr{$_} = '';
-	    $current = \$input_expr{$_};
-	}
-	else {
-	    s/\s+$//;
-	    $output_expr{$_} = '';
-	    $current = \$output_expr{$_};
-	}
-    }
-    close(TYPEMAP);
-}
-
-foreach $key (keys %input_expr) {
-    $input_expr{$key} =~ s/;*\s+\z//;
-}
-
-$bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*];	# ()-balanced
-$cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?];		# Optional (SV*) cast
-$size = qr[,\s* (??{ $bal }) ]x;		# Third arg (to setpvn)
-
-foreach $key (keys %output_expr) {
-    use re 'eval';
-
-    my ($t, $with_size, $arg, $sarg) =
-      ($output_expr{$key} =~
-	 m[^ \s+ sv_set ( [iunp] ) v (n)? 	# Type, is_setpvn
-	     \s* \( \s* $cast \$arg \s* ,
-	     \s* ( (??{ $bal }) )		# Set from
-	     ( (??{ $size }) )?			# Possible sizeof set-from
-	     \) \s* ; \s* $
-	  ]x);
-    $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
-}
-
-$END = "!End!\n\n";		# "impossible" keyword (multiple newline)
-
-# Match an XS keyword
-$BLOCK_re= '\s*(' . join('|', qw(
-	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
-	CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
-	)) . "|$END)\\s*:";
-
-# Input:  ($_, @line) == unparsed input.
-# Output: ($_, @line) == (rest of line, following lines).
-# Return: the matched keyword if found, otherwise 0
-sub check_keyword {
-	$_ = shift(@line) while !/\S/ && @line;
-	s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
-}
-
-my ($C_group_rex, $C_arg);
-# Group in C (no support for comments or literals)
-$C_group_rex = qr/ [({\[]
-		   (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
-		   [)}\]] /x ;
-# Chunk in C without comma at toplevel (no comments):
-$C_arg = qr/ (?: (?> [^()\[\]{},"']+ )
-	     |   (??{ $C_group_rex })
-	     |   " (?: (?> [^\\"]+ )
-		   |   \\.
-		   )* "		# String literal
-	     |   ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal
-	     )* /xs;
-
-if ($WantLineNumbers) {
-    {
-	package xsubpp::counter;
-	sub TIEHANDLE {
-	    my ($class, $cfile) = @_;
-	    my $buf = "";
-	    $SECTION_END_MARKER = "#line --- \"$cfile\"";
-	    $line_no = 1;
-	    bless \$buf;
-	}
-
-	sub PRINT {
-	    my $self = shift;
-	    for (@_) {
-		$$self .= $_;
-		while ($$self =~ s/^([^\n]*\n)//) {
-		    my $line = $1;
-		    ++ $line_no;
-		    $line =~ s|^\#line\s+---(?=\s)|#line $line_no|;
-		    print STDOUT $line;
-		}
-	    }
-	}
-
-	sub PRINTF {
-	    my $self = shift;
-	    my $fmt = shift;
-	    $self->PRINT(sprintf($fmt, @_));
-	}
-
-	sub DESTROY {
-	    # Not necessary if we're careful to end with a "\n"
-	    my $self = shift;
-	    print STDOUT $$self;
-	}
-    }
-
-    my $cfile = $filename;
-    $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
-    tie(*PSEUDO_STDOUT, 'xsubpp::counter', $cfile);
-    select PSEUDO_STDOUT;
-}
-
-sub print_section {
-    # the "do" is required for right semantics
-    do { $_ = shift(@line) } while !/\S/ && @line;
-
-    print("#line ", $line_no[@line_no - @line -1], " \"$filename\"\n")
-	if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
-    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	print "$_\n";
-    }
-    print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
-}
-
-sub merge_section {
-    my $in = '';
-
-    while (!/\S/ && @line) {
-        $_ = shift(@line);
-    }
-
-    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	$in .= "$_\n";
-    }
-    chomp $in;
-    return $in;
-}
-
-sub process_keyword($)
-{
-    my($pattern) = @_ ;
-    my $kwd ;
-
-    &{"${kwd}_handler"}()
-        while $kwd = check_keyword($pattern) ;
-}
-
-sub CASE_handler {
-    blurt ("Error: `CASE:' after unconditional `CASE:'")
-	if $condnum && $cond eq '';
-    $cond = $_;
-    TrimWhitespace($cond);
-    print "   ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
-    $_ = '' ;
-}
-
-sub INPUT_handler {
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	last if /^\s*NOT_IMPLEMENTED_YET/;
-	next unless /\S/;	# skip blank lines
-
-	TrimWhitespace($_) ;
-	my $line = $_ ;
-
-	# remove trailing semicolon if no initialisation
-	s/\s*;$//g unless /[=;+].*\S/ ;
-
-	# Process the length(foo) declarations
-	if (s/^([^=]*)\blength\(\s*(\w+)\s*\)\s*$/$1 XSauto_length_of_$2=NO_INIT/x) {
-	  print "\tSTRLEN\tSTRLEN_length_of_$2;\n";
-	  $lengthof{$2} = $name;
-	  # $islengthof{$name} = $1;
-	  $deferred .= "\n\tXSauto_length_of_$2 = STRLEN_length_of_$2;";
-	}
-
-	# check for optional initialisation code
-	my $var_init = '' ;
-	$var_init = $1 if s/\s*([=;+].*)$//s ;
-	$var_init =~ s/"/\\"/g;
-
-	s/\s+/ /g;
-	my ($var_type, $var_addr, $var_name) = /^(.*?[^&\s])\s*(\&?)\s*\b(\w+)$/s
-	    or blurt("Error: invalid argument declaration '$line'"), next;
-
-	# Check for duplicate definitions
-	blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
-	    if $arg_list{$var_name}++
-	      or defined $argtype_seen{$var_name} and not $processing_arg_with_types;
-
-	$thisdone |= $var_name eq "THIS";
-	$retvaldone |= $var_name eq "RETVAL";
-	$var_types{$var_name} = $var_type;
-	# XXXX This check is a safeguard against the unfinished conversion of
-	# generate_init().  When generate_init() is fixed,
-	# one can use 2-args map_type() unconditionally.
-	if ($var_type =~ / \( \s* \* \s* \) /x) {
-	  # Function pointers are not yet supported with &output_init!
-	  print "\t" . &map_type($var_type, $var_name);
-	  $name_printed = 1;
-	} else {
-	  print "\t" . &map_type($var_type);
-	  $name_printed = 0;
-	}
-	$var_num = $args_match{$var_name};
-
-        $proto_arg[$var_num] = ProtoString($var_type)
-	    if $var_num ;
-	$func_args =~ s/\b($var_name)\b/&$1/ if $var_addr;
-	if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
-	    or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/
-	    and $var_init !~ /\S/) {
-	  if ($name_printed) {
-	    print ";\n";
-	  } else {
-	    print "\t$var_name;\n";
-	  }
-	} elsif ($var_init =~ /\S/) {
-	    &output_init($var_type, $var_num, $var_name, $var_init, $name_printed);
-	} elsif ($var_num) {
-	    # generate initialization code
-	    &generate_init($var_type, $var_num, $var_name, $name_printed);
-	} else {
-	    print ";\n";
-	}
-    }
-}
-
-sub OUTPUT_handler {
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	next unless /\S/;
-	if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
-	    $DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
-	    next;
-	}
-	my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
-	blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
-	    if $outargs{$outarg} ++ ;
-	if (!$gotRETVAL and $outarg eq 'RETVAL') {
-	    # deal with RETVAL last
-	    $RETVAL_code = $outcode ;
-	    $gotRETVAL = 1 ;
-	    next ;
-	}
-	blurt ("Error: OUTPUT $outarg not an argument"), next
-	    unless defined($args_match{$outarg});
-	blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
-	    unless defined $var_types{$outarg} ;
-	$var_num = $args_match{$outarg};
-	if ($outcode) {
-	    print "\t$outcode\n";
-	    print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic;
-	} else {
-	    &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic);
-	}
-	delete $in_out{$outarg} 	# No need to auto-OUTPUT
-	  if exists $in_out{$outarg} and $in_out{$outarg} =~ /OUT$/;
-    }
-}
-
-sub C_ARGS_handler() {
-    my $in = merge_section();
-
-    TrimWhitespace($in);
-    $func_args = $in;
-}
-
-sub INTERFACE_MACRO_handler() {
-    my $in = merge_section();
-
-    TrimWhitespace($in);
-    if ($in =~ /\s/) {		# two
-        ($interface_macro, $interface_macro_set) = split ' ', $in;
-    } else {
-        $interface_macro = $in;
-	$interface_macro_set = 'UNKNOWN_CVT'; # catch later
-    }
-    $interface = 1;		# local
-    $Interfaces = 1;		# global
-}
-
-sub INTERFACE_handler() {
-    my $in = merge_section();
-
-    TrimWhitespace($in);
-
-    foreach (split /[\s,]+/, $in) {
-        $Interfaces{$_} = $_;
-    }
-    print Q<<"EOF";
-#	XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
-EOF
-    $interface = 1;		# local
-    $Interfaces = 1;		# global
-}
-
-sub CLEANUP_handler() { print_section() }
-sub PREINIT_handler() { print_section() }
-sub POSTCALL_handler() { print_section() }
-sub INIT_handler()    { print_section() }
-
-sub GetAliases
-{
-    my ($line) = @_ ;
-    my ($orig) = $line ;
-    my ($alias) ;
-    my ($value) ;
-
-    # Parse alias definitions
-    # format is
-    #    alias = value alias = value ...
-
-    while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
-        $alias = $1 ;
-        $orig_alias = $alias ;
-        $value = $2 ;
-
-        # check for optional package definition in the alias
-	$alias = $Packprefix . $alias if $alias !~ /::/ ;
-
-        # check for duplicate alias name & duplicate value
-	Warn("Warning: Ignoring duplicate alias '$orig_alias'")
-	    if defined $XsubAliases{$alias} ;
-
-	Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
-	    if $XsubAliasValues{$value} ;
-
-	$XsubAliases = 1;
-	$XsubAliases{$alias} = $value ;
-	$XsubAliasValues{$value} = $orig_alias ;
-    }
-
-    blurt("Error: Cannot parse ALIAS definitions from '$orig'")
-        if $line ;
-}
-
-sub ATTRS_handler ()
-{
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	next unless /\S/;
-	TrimWhitespace($_) ;
-        push @Attributes, $_;
-    }
-}
-
-sub ALIAS_handler ()
-{
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	next unless /\S/;
-	TrimWhitespace($_) ;
-        GetAliases($_) if $_ ;
-    }
-}
-
-sub OVERLOAD_handler()
-{
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	next unless /\S/;
-	TrimWhitespace($_) ;
-        while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) {
-	    $Overload = 1 unless $Overload;
-	    my $overload = "$Package\::(".$1 ;
-            push(@InitFileCode,
-    	     "        newXS(\"$overload\", XS_$Full_func_name, file$proto);\n");
-        }
-    }
-
-}
-
-sub FALLBACK_handler()
-{
-    # the rest of the current line should contain either TRUE, 
-    # FALSE or UNDEF
-
-    TrimWhitespace($_) ;
-    my %map = (
-	TRUE => "PL_sv_yes", 1 => "PL_sv_yes",
-	FALSE => "PL_sv_no", 0 => "PL_sv_no",
-	UNDEF => "PL_sv_undef",
-    ) ;
-
-    # check for valid FALLBACK value
-    death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_} ;
-
-    $Fallback = $map{uc $_} ;
-}
-
-sub REQUIRE_handler ()
-{
-    # the rest of the current line should contain a version number
-    my ($Ver) = $_ ;
-
-    TrimWhitespace($Ver) ;
-
-    death ("Error: REQUIRE expects a version number")
-	unless $Ver ;
-
-    # check that the version number is of the form n.n
-    death ("Error: REQUIRE: expected a number, got '$Ver'")
-	unless $Ver =~ /^\d+(\.\d*)?/ ;
-
-    death ("Error: xsubpp $Ver (or better) required--this is only $XSUBPP_version.")
-        unless $XSUBPP_version >= $Ver ;
-}
-
-sub VERSIONCHECK_handler ()
-{
-    # the rest of the current line should contain either ENABLE or
-    # DISABLE
-
-    TrimWhitespace($_) ;
-
-    # check for ENABLE/DISABLE
-    death ("Error: VERSIONCHECK: ENABLE/DISABLE")
-        unless /^(ENABLE|DISABLE)/i ;
-
-    $WantVersionChk = 1 if $1 eq 'ENABLE' ;
-    $WantVersionChk = 0 if $1 eq 'DISABLE' ;
-
-}
-
-sub PROTOTYPE_handler ()
-{
-    my $specified ;
-
-    death("Error: Only 1 PROTOTYPE definition allowed per xsub")
-        if $proto_in_this_xsub ++ ;
-
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-	next unless /\S/;
-	$specified = 1 ;
-	TrimWhitespace($_) ;
-        if ($_ eq 'DISABLE') {
-	   $ProtoThisXSUB = 0
-        }
-        elsif ($_ eq 'ENABLE') {
-	   $ProtoThisXSUB = 1
-        }
-        else {
-            # remove any whitespace
-            s/\s+//g ;
-            death("Error: Invalid prototype '$_'")
-                unless ValidProtoString($_) ;
-            $ProtoThisXSUB = C_string($_) ;
-        }
-    }
-
-    # If no prototype specified, then assume empty prototype ""
-    $ProtoThisXSUB = 2 unless $specified ;
-
-    $ProtoUsed = 1 ;
-
-}
-
-sub SCOPE_handler ()
-{
-    death("Error: Only 1 SCOPE declaration allowed per xsub")
-        if $scope_in_this_xsub ++ ;
-
-    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
-		next unless /\S/;
-		TrimWhitespace($_) ;
-        if ($_ =~ /^DISABLE/i) {
-		   $ScopeThisXSUB = 0
-        }
-        elsif ($_ =~ /^ENABLE/i) {
-		   $ScopeThisXSUB = 1
-        }
-    }
-
-}
-
-sub PROTOTYPES_handler ()
-{
-    # the rest of the current line should contain either ENABLE or
-    # DISABLE
-
-    TrimWhitespace($_) ;
-
-    # check for ENABLE/DISABLE
-    death ("Error: PROTOTYPES: ENABLE/DISABLE")
-        unless /^(ENABLE|DISABLE)/i ;
-
-    $WantPrototypes = 1 if $1 eq 'ENABLE' ;
-    $WantPrototypes = 0 if $1 eq 'DISABLE' ;
-    $ProtoUsed = 1 ;
-
-}
-
-sub INCLUDE_handler ()
-{
-    # the rest of the current line should contain a valid filename
-
-    TrimWhitespace($_) ;
-
-    death("INCLUDE: filename missing")
-        unless $_ ;
-
-    death("INCLUDE: output pipe is illegal")
-        if /^\s*\|/ ;
-
-    # simple minded recursion detector
-    death("INCLUDE loop detected")
-        if $IncludedFiles{$_} ;
-
-    ++ $IncludedFiles{$_} unless /\|\s*$/ ;
-
-    # Save the current file context.
-    push(@XSStack, {
-	type		=> 'file',
-        LastLine        => $lastline,
-        LastLineNo      => $lastline_no,
-        Line            => \@line,
-        LineNo          => \@line_no,
-        Filename        => $filename,
-        Handle          => $FH,
-        }) ;
-
-    ++ $FH ;
-
-    # open the new file
-    open ($FH, "$_") or death("Cannot open '$_': $!") ;
-
-    print Q<<"EOF" ;
-#
-#/* INCLUDE:  Including '$_' from '$filename' */
-#
-EOF
-
-    $filename = $_ ;
-
-    # Prime the pump by reading the first
-    # non-blank line
-
-    # skip leading blank lines
-    while (<$FH>) {
-        last unless /^\s*$/ ;
-    }
-
-    $lastline = $_ ;
-    $lastline_no = $. ;
-
-}
-
-sub PopFile()
-{
-    return 0 unless $XSStack[-1]{type} eq 'file' ;
-
-    my $data     = pop @XSStack ;
-    my $ThisFile = $filename ;
-    my $isPipe   = ($filename =~ /\|\s*$/) ;
-
-    -- $IncludedFiles{$filename}
-        unless $isPipe ;
-
-    close $FH ;
-
-    $FH         = $data->{Handle} ;
-    $filename   = $data->{Filename} ;
-    $lastline   = $data->{LastLine} ;
-    $lastline_no = $data->{LastLineNo} ;
-    @line       = @{ $data->{Line} } ;
-    @line_no    = @{ $data->{LineNo} } ;
-
-    if ($isPipe and $? ) {
-        -- $lastline_no ;
-        print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n"  ;
-        exit 1 ;
-    }
-
-    print Q<<"EOF" ;
-#
-#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
-#
-EOF
-
-    return 1 ;
-}
-
-sub ValidProtoString ($)
-{
-    my($string) = @_ ;
-
-    if ( $string =~ /^$proto_re+$/ ) {
-        return $string ;
-    }
-
-    return 0 ;
-}
-
-sub C_string ($)
-{
-    my($string) = @_ ;
-
-    $string =~ s[\\][\\\\]g ;
-    $string ;
-}
-
-sub ProtoString ($)
-{
-    my ($type) = @_ ;
-
-    $proto_letter{$type} or "\$" ;
-}
-
-sub check_cpp {
-    my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line);
-    if (@cpp) {
-	my ($cpp, $cpplevel);
-	for $cpp (@cpp) {
-	    if ($cpp =~ /^\#\s*if/) {
-		$cpplevel++;
-	    } elsif (!$cpplevel) {
-		Warn("Warning: #else/elif/endif without #if in this function");
-		print STDERR "    (precede it with a blank line if the matching #if is outside the function)\n"
-		    if $XSStack[-1]{type} eq 'if';
-		return;
-	    } elsif ($cpp =~ /^\#\s*endif/) {
-		$cpplevel--;
-	    }
-	}
-	Warn("Warning: #if without #endif in this function") if $cpplevel;
-    }
-}
-
-
-sub Q {
-    my($text) = @_;
-    $text =~ s/^#//gm;
-    $text =~ s/\[\[/{/g;
-    $text =~ s/\]\]/}/g;
-    $text;
-}
-
-open($FH, $filename) or die "cannot open $filename: $!\n";
-
-# Identify the version of xsubpp used
-print <<EOM ;
-/*
- * This file was generated automatically by xsubpp version $XSUBPP_version from the
- * contents of $filename. Do not edit this file, edit $filename instead.
- *
- *	ANY CHANGES MADE HERE WILL BE LOST!
- *
- */
-
-EOM
-
-
-print("#line 1 \"$filename\"\n")
-    if $WantLineNumbers;
-
-firstmodule:
-while (<$FH>) {
-    if (/^=/) {
-        my $podstartline = $.;
-    	do {
-	    if (/^=cut\s*$/) {
-		# We can't just write out a /* */ comment, as our embedded
-		# POD might itself be in a comment. We can't put a /**/
-		# comment inside #if 0, as the C standard says that the source
-		# file is decomposed into preprocessing characters in the stage
-		# before preprocessing commands are executed.
-		# I don't want to leave the text as barewords, because the spec
-		# isn't clear whether macros are expanded before or after
-		# preprocessing commands are executed, and someone pathological
-		# may just have defined one of the 3 words as a macro that does
-		# something strange. Multiline strings are illegal in C, so
-		# the "" we write must be a string literal. And they aren't
-		# concatenated until 2 steps later, so we are safe.
-		print("#if 0\n  \"Skipped embedded POD.\"\n#endif\n");
-		printf("#line %d \"$filename\"\n", $. + 1)
-		  if $WantLineNumbers;
-		next firstmodule
-	    }
-
-	} while (<$FH>);
-	# At this point $. is at end of file so die won't state the start
-	# of the problem, and as we haven't yet read any lines &death won't
-	# show the correct line in the message either.
-	die ("Error: Unterminated pod in $filename, line $podstartline\n")
-	  unless $lastline;
-    }
-    last if ($Module, $Package, $Prefix) =
-	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
-
-    print $_;
-}
-&Exit unless defined $_;
-
-print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
-
-$lastline    = $_;
-$lastline_no = $.;
-
-# Read next xsub into @line from ($lastline, <$FH>).
-sub fetch_para {
-    # parse paragraph
-    death ("Error: Unterminated `#if/#ifdef/#ifndef'")
-	if !defined $lastline && $XSStack[-1]{type} eq 'if';
-    @line = ();
-    @line_no = () ;
-    return PopFile() if !defined $lastline;
-
-    if ($lastline =~
-	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
-	$Module = $1;
-	$Package = defined($2) ? $2 : '';	# keep -w happy
-	$Prefix  = defined($3) ? $3 : '';	# keep -w happy
-	$Prefix = quotemeta $Prefix ;
-	($Module_cname = $Module) =~ s/\W/_/g;
-	($Packid = $Package) =~ tr/:/_/;
-	$Packprefix = $Package;
-	$Packprefix .= "::" if $Packprefix ne "";
-	$lastline = "";
-    }
-
-    for(;;) {
-	# Skip embedded PODs
-	while ($lastline =~ /^=/) {
-    	    while ($lastline = <$FH>) {
-	    	last if ($lastline =~ /^=cut\s*$/);
-	    }
-	    death ("Error: Unterminated pod") unless $lastline;
-	    $lastline = <$FH>;
-	    chomp $lastline;
-	    $lastline =~ s/^\s+$//;
-	}
-	if ($lastline !~ /^\s*#/ ||
-	    # CPP directives:
-	    #	ANSI:	if ifdef ifndef elif else endif define undef
-	    #		line error pragma
-	    #	gcc:	warning include_next
-	    #   obj-c:	import
-	    #   others:	ident (gcc notes that some cpps have this one)
-	    $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
-	    last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
-	    push(@line, $lastline);
-	    push(@line_no, $lastline_no) ;
-	}
-
-	# Read next line and continuation lines
-	last unless defined($lastline = <$FH>);
-	$lastline_no = $.;
-	my $tmp_line;
-	$lastline .= $tmp_line
-	    while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
-
-	chomp $lastline;
-	$lastline =~ s/^\s+$//;
-    }
-    pop(@line), pop(@line_no) while @line && $line[-1] eq "";
-    1;
-}
-
-PARAGRAPH:
-while (fetch_para()) {
-    # Print initial preprocessor statements and blank lines
-    while (@line && $line[0] !~ /^[^\#]/) {
-	my $line = shift(@line);
-	print $line, "\n";
-	next unless $line =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
-	my $statement = $+;
-	if ($statement eq 'if') {
-	    $XSS_work_idx = @XSStack;
-	    push(@XSStack, {type => 'if'});
-	} else {
-	    death ("Error: `$statement' with no matching `if'")
-		if $XSStack[-1]{type} ne 'if';
-	    if ($XSStack[-1]{varname}) {
-		push(@InitFileCode, "#endif\n");
-		push(@BootCode,     "#endif");
-	    }
-
-	    my(@fns) = keys %{$XSStack[-1]{functions}};
-	    if ($statement ne 'endif') {
-		# Hide the functions defined in other #if branches, and reset.
-		@{$XSStack[-1]{other_functions}}{@fns} = (1) x @fns;
-		@{$XSStack[-1]}{qw(varname functions)} = ('', {});
-	    } else {
-		my($tmp) = pop(@XSStack);
-		0 while (--$XSS_work_idx
-			 && $XSStack[$XSS_work_idx]{type} ne 'if');
-		# Keep all new defined functions
-		push(@fns, keys %{$tmp->{other_functions}});
-		@{$XSStack[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
-	    }
-	}
-    }
-
-    next PARAGRAPH unless @line;
-
-    if ($XSS_work_idx && !$XSStack[$XSS_work_idx]{varname}) {
-	# We are inside an #if, but have not yet #defined its xsubpp variable.
-	print "#define $cpp_next_tmp 1\n\n";
-	push(@InitFileCode, "#if $cpp_next_tmp\n");
-	push(@BootCode,     "#if $cpp_next_tmp");
-	$XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
-    }
-
-    death ("Code is not inside a function"
-	   ." (maybe last function was ended by a blank line "
-	   ." followed by a statement on column one?)")
-	if $line[0] =~ /^\s/;
-
-    # initialize info arrays
-    undef(%args_match);
-    undef(%var_types);
-    undef(%defaults);
-    undef($class);
-    undef($externC);
-    undef($static);
-    undef($elipsis);
-    undef($wantRETVAL) ;
-    undef($RETVAL_no_return) ;
-    undef(%arg_list) ;
-    undef(@proto_arg) ;
-    undef(@fake_INPUT_pre) ;	# For length(s) generated variables
-    undef(@fake_INPUT) ;
-    undef($processing_arg_with_types) ;
-    undef(%argtype_seen) ;
-    undef(@outlist) ;
-    undef(%in_out) ;
-    undef(%lengthof) ;
-    # undef(%islengthof) ;
-    undef($proto_in_this_xsub) ;
-    undef($scope_in_this_xsub) ;
-    undef($interface);
-    undef($prepush_done);
-    $interface_macro = 'XSINTERFACE_FUNC' ;
-    $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
-    $ProtoThisXSUB = $WantPrototypes ;
-    $ScopeThisXSUB = 0;
-    $xsreturn = 0;
-
-    $_ = shift(@line);
-    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE")) {
-        &{"${kwd}_handler"}() ;
-        next PARAGRAPH unless @line ;
-        $_ = shift(@line);
-    }
-
-    if (check_keyword("BOOT")) {
-	&check_cpp;
-	push (@BootCode, "#line $line_no[@line_no - @line] \"$filename\"")
-	  if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
-        push (@BootCode, @line, "") ;
-        next PARAGRAPH ;
-    }
-
-
-    # extract return type, function name and arguments
-    ($ret_type) = TidyType($_);
-    $RETVAL_no_return = 1 if $ret_type =~ s/^NO_OUTPUT\s+//;
-
-    # Allow one-line ANSI-like declaration
-    unshift @line, $2
-      if $process_argtypes
-	and $ret_type =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s;
-
-    # a function definition needs at least 2 lines
-    blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
-	unless @line ;
-
-    $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
-    $static  = 1 if $ret_type =~ s/^static\s+//;
-
-    $func_header = shift(@line);
-    blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
-	unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s;
-
-    ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
-    $class = "$4 $class" if $4;
-    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
-    ($clean_func_name = $func_name) =~ s/^$Prefix//;
-    $Full_func_name = "${Packid}_$clean_func_name";
-    if ($Is_VMS) { $Full_func_name = $SymSet->addsym($Full_func_name); }
-
-    # Check for duplicate function definition
-    for $tmp (@XSStack) {
-	next unless defined $tmp->{functions}{$Full_func_name};
-	Warn("Warning: duplicate function definition '$clean_func_name' detected");
-	last;
-    }
-    $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
-    %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
-    $DoSetMagic = 1;
-
-    $orig_args =~ s/\\\s*/ /g;		# process line continuations
-
-    my %only_C_inlist;	# Not in the signature of Perl function
-    if ($process_argtypes and $orig_args =~ /\S/) {
-	my $args = "$orig_args ,";
-	if ($args =~ /^( (??{ $C_arg }) , )* $ /x) {
-	    @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg);
-	    for ( @args ) {
-		s/^\s+//;
-		s/\s+$//;
-		my ($arg, $default) = / ( [^=]* ) ( (?: = .* )? ) /x;
-		my ($pre, $name) = ($arg =~ /(.*?) \s*
-					     \b ( \w+ | length\( \s*\w+\s* \) )
-					     \s* $ /x);
-		next unless length $pre;
-		my $out_type;
-		my $inout_var;
-		if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
-		    my $type = $1;
-		    $out_type = $type if $type ne 'IN';
-		    $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
-		    $pre =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//;
-		}
-		my $islength;
-		if ($name =~ /^length\( \s* (\w+) \s* \)\z/x) {
-		  $name = "XSauto_length_of_$1";
-		  $islength = 1;
-		  die "Default value on length() argument: `$_'"
-		    if length $default;
-		}
-		if (length $pre or $islength) {	# Has a type
-		    if ($islength) {
-		      push @fake_INPUT_pre, $arg;
-		    } else {
-		      push @fake_INPUT, $arg;
-		    }
-		    # warn "pushing '$arg'\n";
-		    $argtype_seen{$name}++;
-		    $_ = "$name$default"; # Assigns to @args
-		}
-		$only_C_inlist{$_} = 1 if $out_type eq "OUTLIST" or $islength;
-		push @outlist, $name if $out_type =~ /OUTLIST$/;
-		$in_out{$name} = $out_type if $out_type;
-	    }
-	} else {
-	    @args = split(/\s*,\s*/, $orig_args);
-	    Warn("Warning: cannot parse argument list '$orig_args', fallback to split");
-	}
-    } else {
-	@args = split(/\s*,\s*/, $orig_args);
-	for (@args) {
-	    if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\s+//) {
-		my $out_type = $1;
-		next if $out_type eq 'IN';
-		$only_C_inlist{$_} = 1 if $out_type eq "OUTLIST";
-		push @outlist, $name if $out_type =~ /OUTLIST$/;
-		$in_out{$_} = $out_type;
-	    }
-	}
-    }
-    if (defined($class)) {
-	my $arg0 = ((defined($static) or $func_name eq 'new')
-		    ? "CLASS" : "THIS");
-	unshift(@args, $arg0);
-	($report_args = "$arg0, $report_args") =~ s/^\w+, $/$arg0/;
-    }
-    my $extra_args = 0;
-    @args_num = ();
-    $num_args = 0;
-    my $report_args = '';
-    foreach $i (0 .. $#args) {
-	    if ($args[$i] =~ s/\.\.\.//) {
-		    $elipsis = 1;
-		    if ($args[$i] eq '' && $i == $#args) {
-		        $report_args .= ", ...";
-			pop(@args);
-			last;
-		    }
-	    }
-	    if ($only_C_inlist{$args[$i]}) {
-		push @args_num, undef;
-	    } else {
-		push @args_num, ++$num_args;
-		$report_args .= ", $args[$i]";
-	    }
-	    if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
-		    $extra_args++;
-		    $args[$i] = $1;
-		    $defaults{$args[$i]} = $2;
-		    $defaults{$args[$i]} =~ s/"/\\"/g;
-	    }
-	    $proto_arg[$i+1] = "\$" ;
-    }
-    $min_args = $num_args - $extra_args;
-    $report_args =~ s/"/\\"/g;
-    $report_args =~ s/^,\s+//;
-    my @func_args = @args;
-    shift @func_args if defined($class);
-
-    for (@func_args) {
-	s/^/&/ if $in_out{$_};
-    }
-    $func_args = join(", ", @func_args);
-    @args_match{@args} = @args_num;
-
-    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
-    $CODE = grep(/^\s*CODE\s*:/, @line);
-    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
-    #   to set explicit return values.
-    $EXPLICIT_RETURN = ($CODE &&
-		("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
-    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
-    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);
-
-    $xsreturn = 1 if $EXPLICIT_RETURN;
-
-    $externC = $externC ? qq[extern "C"] : "";
-
-    # print function header
-    print Q<<"EOF";
-#$externC
-#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
-#XS(XS_${Full_func_name})
-#[[
-#    dXSARGS;
-EOF
-    print Q<<"EOF" if $ALIAS ;
-#    dXSI32;
-EOF
-    print Q<<"EOF" if $INTERFACE ;
-#    dXSFUNCTION($ret_type);
-EOF
-    if ($elipsis) {
-	$cond = ($min_args ? qq(items < $min_args) : 0);
-    }
-    elsif ($min_args == $num_args) {
-	$cond = qq(items != $min_args);
-    }
-    else {
-	$cond = qq(items < $min_args || items > $num_args);
-    }
-
-    print Q<<"EOF" if $except;
-#    char errbuf[1024];
-#    *errbuf = '\0';
-EOF
-
-    if ($ALIAS)
-      { print Q<<"EOF" if $cond }
-#    if ($cond)
-#       Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
-EOF
-    else
-      { print Q<<"EOF" if $cond }
-#    if ($cond)
-#	Perl_croak(aTHX_ "Usage: $pname($report_args)");
-EOF
-
-    #gcc -Wall: if an xsub has no arguments and PPCODE is used
-    #it is likely none of ST, XSRETURN or XSprePUSH macros are used
-    #hence `ax' (setup by dXSARGS) is unused
-    #XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
-    #but such a move could break third-party extensions
-    print Q<<"EOF" if $PPCODE and $num_args == 0;
-#   PERL_UNUSED_VAR(ax); /* -Wall */
-EOF
-
-    print Q<<"EOF" if $PPCODE;
-#    SP -= items;
-EOF
-
-    # Now do a block of some sort.
-
-    $condnum = 0;
-    $cond = '';			# last CASE: condidional
-    push(@line, "$END:");
-    push(@line_no, $line_no[-1]);
-    $_ = '';
-    &check_cpp;
-    while (@line) {
-	&CASE_handler if check_keyword("CASE");
-	print Q<<"EOF";
-#   $except [[
-EOF
-
-	# do initialization of input variables
-	$thisdone = 0;
-	$retvaldone = 0;
-	$deferred = "";
-	%arg_list = () ;
-        $gotRETVAL = 0;
-
-	INPUT_handler() ;
-	process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD") ;
-
-	print Q<<"EOF" if $ScopeThisXSUB;
-#   ENTER;
-#   [[
-EOF
-	
-	if (!$thisdone && defined($class)) {
-	    if (defined($static) or $func_name eq 'new') {
-		print "\tchar *";
-		$var_types{"CLASS"} = "char *";
-		&generate_init("char *", 1, "CLASS");
-	    }
-	    else {
-		print "\t$class *";
-		$var_types{"THIS"} = "$class *";
-		&generate_init("$class *", 1, "THIS");
-	    }
-	}
-
-	# do code
-	if (/^\s*NOT_IMPLEMENTED_YET/) {
-		print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n";
-		$_ = '' ;
-	} else {
-		if ($ret_type ne "void") {
-			print "\t" . &map_type($ret_type, 'RETVAL') . ";\n"
-				if !$retvaldone;
-			$args_match{"RETVAL"} = 0;
-			$var_types{"RETVAL"} = $ret_type;
-			print "\tdXSTARG;\n"
-				if $WantOptimize and $targetable{$type_kind{$ret_type}};
-		}
-
-		if (@fake_INPUT or @fake_INPUT_pre) {
-		    unshift @line, @fake_INPUT_pre, @fake_INPUT, $_;
-		    $_ = "";
-		    $processing_arg_with_types = 1;
-		    INPUT_handler() ;
-		}
-		print $deferred;
-
-        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
-
-		if (check_keyword("PPCODE")) {
-			print_section();
-			death ("PPCODE must be last thing") if @line;
-			print "\tLEAVE;\n" if $ScopeThisXSUB;
-			print "\tPUTBACK;\n\treturn;\n";
-		} elsif (check_keyword("CODE")) {
-			print_section() ;
-		} elsif (defined($class) and $func_name eq "DESTROY") {
-			print "\n\t";
-			print "delete THIS;\n";
-		} else {
-			print "\n\t";
-			if ($ret_type ne "void") {
-				print "RETVAL = ";
-				$wantRETVAL = 1;
-			}
-			if (defined($static)) {
-			    if ($func_name eq 'new') {
-				$func_name = "$class";
-			    } else {
-				print "${class}::";
-			    }
-			} elsif (defined($class)) {
-			    if ($func_name eq 'new') {
-				$func_name .= " $class";
-			    } else {
-				print "THIS->";
-			    }
-			}
-			$func_name =~ s/^($spat)//
-			    if defined($spat);
-			$func_name = 'XSFUNCTION' if $interface;
-			print "$func_name($func_args);\n";
-		}
-	}
-
-	# do output variables
-	$gotRETVAL = 0;		# 1 if RETVAL seen in OUTPUT section;
-	undef $RETVAL_code ;	# code to set RETVAL (from OUTPUT section);
-	# $wantRETVAL set if 'RETVAL =' autogenerated
-	($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
-	undef %outargs ;
-	process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
-
-	&generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic)
-	  for grep $in_out{$_} =~ /OUT$/, keys %in_out;
-
-	# all OUTPUT done, so now push the return value on the stack
-	if ($gotRETVAL && $RETVAL_code) {
-	    print "\t$RETVAL_code\n";
-	} elsif ($gotRETVAL || $wantRETVAL) {
-	    my $t = $WantOptimize && $targetable{$type_kind{$ret_type}};
-	    my $var = 'RETVAL';
-	    my $type = $ret_type;
-
-	    # 0: type, 1: with_size, 2: how, 3: how_size
-	    if ($t and not $t->[1] and $t->[0] eq 'p') {
-		# PUSHp corresponds to setpvn.  Treate setpv directly
-		my $what = eval qq("$t->[2]");
-		warn $@ if $@;
-
-		print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n";
-		$prepush_done = 1;
-	    }
-	    elsif ($t) {
-		my $what = eval qq("$t->[2]");
-		warn $@ if $@;
-
-		my $size = $t->[3];
-		$size = '' unless defined $size;
-		$size = eval qq("$size");
-		warn $@ if $@;
-		print "\tXSprePUSH; PUSH$t->[0]($what$size);\n";
-		$prepush_done = 1;
-	    }
-	    else {
-		# RETVAL almost never needs SvSETMAGIC()
-		&generate_output($ret_type, 0, 'RETVAL', 0);
-	    }
-	}
-
-	$xsreturn = 1 if $ret_type ne "void";
-	my $num = $xsreturn;
-	my $c = @outlist;
-	# (PP)CODE set different values of SP; reset to PPCODE's with 0 output
-	print "\tXSprePUSH;"    if $c and not $prepush_done;
-	# Take into account stuff already put on stack
-	print "\t++SP;"         if $c and not $prepush_done and $xsreturn;
-	# Now SP corresponds to ST($xsreturn), so one can combine PUSH and ST()
-	print "\tEXTEND(SP,$c);\n" if $c;
-	$xsreturn += $c;
-	generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
-
-	# do cleanup
-	process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
-
-	print Q<<"EOF" if $ScopeThisXSUB;
-#   ]]
-EOF
-	print Q<<"EOF" if $ScopeThisXSUB and not $PPCODE;
-#   LEAVE;
-EOF
-
-	# print function trailer
-	print Q<<EOF;
-#    ]]
-EOF
-	print Q<<EOF if $except;
-#    BEGHANDLERS
-#    CATCHALL
-#	sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
-#    ENDHANDLERS
-EOF
-	if (check_keyword("CASE")) {
-	    blurt ("Error: No `CASE:' at top of function")
-		unless $condnum;
-	    $_ = "CASE: $_";	# Restore CASE: label
-	    next;
-	}
-	last if $_ eq "$END:";
-	death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
-    }
-
-    print Q<<EOF if $except;
-#    if (errbuf[0])
-#	Perl_croak(aTHX_ errbuf);
-EOF
-
-    if ($xsreturn) {
-        print Q<<EOF unless $PPCODE;
-#    XSRETURN($xsreturn);
-EOF
-    } else {
-        print Q<<EOF unless $PPCODE;
-#    XSRETURN_EMPTY;
-EOF
-    }
-
-    print Q<<EOF;
-#]]
-#
-EOF
-
-    my $newXS = "newXS" ;
-    my $proto = "" ;
-
-    # Build the prototype string for the xsub
-    if ($ProtoThisXSUB) {
-	$newXS = "newXSproto";
-
-	if ($ProtoThisXSUB eq 2) {
-	    # User has specified empty prototype
-	    $proto = ', ""' ;
-	}
-        elsif ($ProtoThisXSUB ne 1) {
-            # User has specified a prototype
-            $proto = ', "' . $ProtoThisXSUB . '"';
-        }
-        else {
-	    my $s = ';';
-            if ($min_args < $num_args)  {
-                $s = '';
-		$proto_arg[$min_args] .= ";" ;
-	    }
-            push @proto_arg, "$s\@"
-                if $elipsis ;
-
-            $proto = ', "' . join ("", @proto_arg) . '"';
-        }
-    }
-
-    if (%XsubAliases) {
-	$XsubAliases{$pname} = 0
-	    unless defined $XsubAliases{$pname} ;
-	while ( ($name, $value) = each %XsubAliases) {
-	    push(@InitFileCode, Q<<"EOF");
-#        cv = newXS(\"$name\", XS_$Full_func_name, file);
-#        XSANY.any_i32 = $value ;
-EOF
-	push(@InitFileCode, Q<<"EOF") if $proto;
-#        sv_setpv((SV*)cv$proto) ;
-EOF
-        }
-    }
-    elsif (@Attributes) {
-	    push(@InitFileCode, Q<<"EOF");
-#        cv = newXS(\"$pname\", XS_$Full_func_name, file);
-#        apply_attrs_string("$Package", cv, "@Attributes", 0);
-EOF
-    }
-    elsif ($interface) {
-	while ( ($name, $value) = each %Interfaces) {
-	    $name = "$Package\::$name" unless $name =~ /::/;
-	    push(@InitFileCode, Q<<"EOF");
-#        cv = newXS(\"$name\", XS_$Full_func_name, file);
-#        $interface_macro_set(cv,$value) ;
-EOF
-	    push(@InitFileCode, Q<<"EOF") if $proto;
-#        sv_setpv((SV*)cv$proto) ;
-EOF
-        }
-    }
-    else {
-	push(@InitFileCode,
-	     "        ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
-    }
-}
-
-if ($Overload) # make it findable with fetchmethod
-{
-    
-    print Q<<"EOF"; 
-#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
-#XS(XS_${Packid}_nil)
-#{
-#   XSRETURN_EMPTY;
-#}
-#
-EOF
-    unshift(@InitFileCode, <<"MAKE_FETCHMETHOD_WORK");
-    /* Making a sub named "${Package}::()" allows the package */
-    /* to be findable via fetchmethod(), and causes */
-    /* overload::Overloaded("${Package}") to return true. */
-    newXS("${Package}::()", XS_${Packid}_nil, file$proto);
-MAKE_FETCHMETHOD_WORK
-}
-
-# print initialization routine
-
-print Q<<"EOF";
-##ifdef __cplusplus
-#extern "C"
-##endif
-EOF
-
-print Q<<"EOF";
-#XS(boot_$Module_cname); /* prototype to pass -Wmissing-prototypes */
-#XS(boot_$Module_cname)
-EOF
-
-print Q<<"EOF";
-#[[
-#    dXSARGS;
-EOF
-
-#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
-#so `file' is unused
-print Q<<"EOF" if $Full_func_name;
-#    char* file = __FILE__;
-EOF
-
-print Q "#\n";
-
-print Q<<"EOF" if $WantVersionChk ;
-#    XS_VERSION_BOOTCHECK ;
-#
-EOF
-
-print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
-#    {
-#        CV * cv ;
-#
-EOF
-
-print Q<<"EOF" if ($Overload);
-#    /* register the overloading (type 'A') magic */
-#    PL_amagic_generation++;
-#    /* The magic for overload gets a GV* via gv_fetchmeth as */
-#    /* mentioned above, and looks in the SV* slot of it for */
-#    /* the "fallback" status. */
-#    sv_setsv(
-#        get_sv( "${Package}::()", TRUE ),
-#        $Fallback
-#    );
-EOF
-
-print @InitFileCode;
-
-print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
-#    }
-EOF
-
-if (@BootCode)
-{
-    print "\n    /* Initialisation Section */\n\n" ;
-    @line = @BootCode;
-    print_section();
-    print "\n    /* End of Initialisation Section */\n\n" ;
-}
-
-print Q<<"EOF";;
-#    XSRETURN_YES;
-#]]
-#
-EOF
-
-warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
-    unless $ProtoUsed ;
-&Exit;
-
-sub output_init {
-    local($type, $num, $var, $init, $name_printed) = @_;
-    local($arg) = "ST(" . ($num - 1) . ")";
-
-    if(  $init =~ /^=/  ) {
-        if ($name_printed) {
-	  eval qq/print " $init\\n"/;
-	} else {
-	  eval qq/print "\\t$var $init\\n"/;
-	}
-	warn $@   if  $@;
-    } else {
-	if(  $init =~ s/^\+//  &&  $num  ) {
-	    &generate_init($type, $num, $var, $name_printed);
-	} elsif ($name_printed) {
-	    print ";\n";
-	    $init =~ s/^;//;
-	} else {
-	    eval qq/print "\\t$var;\\n"/;
-	    warn $@   if  $@;
-	    $init =~ s/^;//;
-	}
-	$deferred .= eval qq/"\\n\\t$init\\n"/;
-	warn $@   if  $@;
-    }
-}
-
-sub Warn
-{
-    # work out the line number
-    my $line_no = $line_no[@line_no - @line -1] ;
-
-    print STDERR "@_ in $filename, line $line_no\n" ;
-}
-
-sub blurt
-{
-    Warn @_ ;
-    $errors ++
-}
-
-sub death
-{
-    Warn @_ ;
-    exit 1 ;
-}
-
-sub generate_init {
-    local($type, $num, $var) = @_;
-    local($arg) = "ST(" . ($num - 1) . ")";
-    local($argoff) = $num - 1;
-    local($ntype);
-    local($tk);
-
-    $type = TidyType($type) ;
-    blurt("Error: '$type' not in typemap"), return
-	unless defined($type_kind{$type});
-
-    ($ntype = $type) =~ s/\s*\*/Ptr/g;
-    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
-    $tk = $type_kind{$type};
-    $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
-    if ($tk eq 'T_PV' and exists $lengthof{$var}) {
-      print "\t$var" unless $name_printed;
-      print " = ($type)SvPV($arg, STRLEN_length_of_$var);\n";
-      die "default value not supported with length(NAME) supplied"
-	if defined $defaults{$var};
-      return;
-    }
-    $type =~ tr/:/_/ unless $hiertype;
-    blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
-        unless defined $input_expr{$tk} ;
-    $expr = $input_expr{$tk};
-    if ($expr =~ /DO_ARRAY_ELEM/) {
-        blurt("Error: '$subtype' not in typemap"), return
-	    unless defined($type_kind{$subtype});
-        blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
-            unless defined $input_expr{$type_kind{$subtype}} ;
-	$subexpr = $input_expr{$type_kind{$subtype}};
-        $subexpr =~ s/\$type/\$subtype/g;
-	$subexpr =~ s/ntype/subtype/g;
-	$subexpr =~ s/\$arg/ST(ix_$var)/g;
-	$subexpr =~ s/\n\t/\n\t\t/g;
-	$subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
-	$subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
-	$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
-    }
-    if ($expr =~ m#/\*.*scope.*\*/#i) { # "scope" in C comments
-    	$ScopeThisXSUB = 1;
-    }
-    if (defined($defaults{$var})) {
-	    $expr =~ s/(\t+)/$1    /g;
-	    $expr =~ s/        /\t/g;
-	    if ($name_printed) {
-	      print ";\n";
-	    } else {
-	      eval qq/print "\\t$var;\\n"/;
-	      warn $@   if  $@;
-	    }
-	    if ($defaults{$var} eq 'NO_INIT') {
-		$deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/;
-	    } else {
-		$deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
-	    }
-	    warn $@   if  $@;
-    } elsif ($ScopeThisXSUB or $expr !~ /^\s*\$var =/) {
-	    if ($name_printed) {
-	      print ";\n";
-	    } else {
-	      eval qq/print "\\t$var;\\n"/;
-	      warn $@   if  $@;
-	    }
-	    $deferred .= eval qq/"\\n$expr;\\n"/;
-	    warn $@   if  $@;
-    } else {
-	    die "panic: do not know how to handle this branch for function pointers"
-	      if $name_printed;
-	    eval qq/print "$expr;\\n"/;
-	    warn $@   if  $@;
-    }
-}
-
-sub generate_output {
-    local($type, $num, $var, $do_setmagic, $do_push) = @_;
-    local($arg) = "ST(" . ($num - ($num != 0)) . ")";
-    local($argoff) = $num - 1;
-    local($ntype);
-
-    $type = TidyType($type) ;
-    if ($type =~ /^array\(([^,]*),(.*)\)/) {
-            print "\t$arg = sv_newmortal();\n";
-	    print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
-	    print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
-    } else {
-	    blurt("Error: '$type' not in typemap"), return
-		unless defined($type_kind{$type});
-            blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
-                unless defined $output_expr{$type_kind{$type}} ;
-	    ($ntype = $type) =~ s/\s*\*/Ptr/g;
-	    $ntype =~ s/\(\)//g;
-	    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
-	    $expr = $output_expr{$type_kind{$type}};
-	    if ($expr =~ /DO_ARRAY_ELEM/) {
-	        blurt("Error: '$subtype' not in typemap"), return
-		    unless defined($type_kind{$subtype});
-                blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
-                    unless defined $output_expr{$type_kind{$subtype}} ;
-		$subexpr = $output_expr{$type_kind{$subtype}};
-		$subexpr =~ s/ntype/subtype/g;
-		$subexpr =~ s/\$arg/ST(ix_$var)/g;
-		$subexpr =~ s/\$var/${var}[ix_$var]/g;
-		$subexpr =~ s/\n\t/\n\t\t/g;
-		$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
-		eval "print qq\a$expr\a";
-		warn $@   if  $@;
-		print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic;
-	    }
-	    elsif ($var eq 'RETVAL') {
-		if ($expr =~ /^\t\$arg = new/) {
-		    # We expect that $arg has refcnt 1, so we need to
-		    # mortalize it.
-		    eval "print qq\a$expr\a";
-		    warn $@   if  $@;
-		    print "\tsv_2mortal(ST($num));\n";
-		    print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic;
-		}
-		elsif ($expr =~ /^\s*\$arg\s*=/) {
-		    # We expect that $arg has refcnt >=1, so we need
-		    # to mortalize it!
-		    eval "print qq\a$expr\a";
-		    warn $@   if  $@;
-		    print "\tsv_2mortal(ST(0));\n";
-		    print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic;
-		}
-		else {
-		    # Just hope that the entry would safely write it
-		    # over an already mortalized value. By
-		    # coincidence, something like $arg = &sv_undef
-		    # works too.
-		    print "\tST(0) = sv_newmortal();\n";
-		    eval "print qq\a$expr\a";
-		    warn $@   if  $@;
-		    # new mortals don't have set magic
-		}
-	    }
-	    elsif ($do_push) {
-	        print "\tPUSHs(sv_newmortal());\n";
-		$arg = "ST($num)";
-		eval "print qq\a$expr\a";
-		warn $@   if  $@;
-		print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
-	    }
-	    elsif ($arg =~ /^ST\(\d+\)$/) {
-		eval "print qq\a$expr\a";
-		warn $@   if  $@;
-		print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
-	    }
-    }
-}
-
-sub map_type {
-    my($type, $varname) = @_;
-
-    # C++ has :: in types too so skip this
-    $type =~ tr/:/_/ unless $hiertype;
-    $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
-    if ($varname) {
-      if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) {
-	(substr $type, pos $type, 0) = " $varname ";
-      } else {
-	$type .= "\t$varname";
-      }
-    }
-    $type;
-}
-
-
-sub Exit {
-# If this is VMS, the exit status has meaning to the shell, so we
-# use a predictable value (SS$_Normal or SS$_Abort) rather than an
-# arbitrary number.
-#    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
-    exit ($errors ? 1 : 0);
-}