+

+use 5.005_64;

+our(@ISA, @EXPORT, $VERSION);

+ my $xsinit_proto = "pTHXo";

+ print $fh "EXTERN_C void xs_init ($xsinit_proto);\n\n";

+ my $boot_proto = "pTHXo_ CV* cv";

+ my($ccode) = "EXTERN_C void boot_${cname} ($boot_proto);\n";

+to the C B<boot_Socket> function and writes it to a file named F<xsinit.c>.

+Keep in mind that you can always supply B</my/own/path/ModuleName.a>

+Where:

+

+use 5.005_64;

+our $VERSION = '0.02';

+$self->{Perl}{version} = $Config{version};

+ $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!s;

+ $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!s;

+package ExtUtils::MM_Cygwin;

+

+use Config;

+#use Cwd;

+#use File::Basename;

+require Exporter;

+

+Exporter::import('ExtUtils::MakeMaker',

+ qw( $Verbose &neatvalue));

+

+unshift @MM::ISA, 'ExtUtils::MM_Cygwin';

+

+sub canonpath {

+ my($self,$path) = @_;

+ $path =~ s|\\|/|g;

+ return $self->ExtUtils::MM_Unix::canonpath($path);

+}

+

+sub cflags {

+ my($self,$libperl)=@_;

+ return $self->{CFLAGS} if $self->{CFLAGS};

+ my $base =$self->ExtUtils::MM_Unix::cflags($libperl);

+ foreach (split /\n/, $base) {

+ / *= */ and $self->{$`} = $';

+ };

+ $self->{CCFLAGS} .= " -DUSEIMPORTLIB" if ($Config{useshrplib} eq 'true');

+

+ return $self->{CFLAGS} = qq{

+CCFLAGS = $self->{CCFLAGS}

+OPTIMIZE = $self->{OPTIMIZE}

+PERLTYPE = $self->{PERLTYPE}

+LARGE = $self->{LARGE}

+SPLIT = $self->{SPLIT}

+};

+

+}

+

+sub manifypods {

+ my($self, %attribs) = @_;

+ return "\nmanifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless

+ %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};

+ my($dist);

+ my($pod2man_exe);

+ if (defined $self->{PERL_SRC}) {

+ $pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');

+ } else {

+ $pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');

+ }

+ unless ($self->perl_script($pod2man_exe)) {

+ # No pod2man but some MAN3PODS to be installed

+ print <<END;

+

+Warning: I could not locate your pod2man program. Please make sure,

+ your pod2man program is in your PATH before you execute 'make'

+

+END

+ $pod2man_exe = "-S pod2man";

+ }

+ my(@m);

+ push @m,

+qq[POD2MAN_EXE = $pod2man_exe\n],

+qq[POD2MAN = \$(PERL) -we '%m=\@ARGV;for (keys %m){' \\\n],

+q[-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "],

+ $self->{MAKEFILE}, q[";' \\

+-e 'print "Manifying $$m{$$_}\n"; $$m{$$_} =~ s/::/./g;' \\

+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\

+-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'

+];

+ push @m, "\nmanifypods : pure_all ";

+ push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};

+

+ push(@m,"\n");

+ if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {

+ push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t";

+ push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}};

+ }

+ join('', @m);

+}

+

+sub perl_archive

+{

+ return '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a");

+}

+

+1;

+__END__

+

+=head1 NAME

+

+ExtUtils::MM_Cygwin - methods to override UN*X behaviour in ExtUtils::MakeMaker

+

+=head1 SYNOPSIS

+

+ use ExtUtils::MM_Cygwin; # Done internally by ExtUtils::MakeMaker if needed

+

+=head1 DESCRIPTION

+

+See ExtUtils::MM_Unix for a documentation of the methods provided there.

+

+=over

+

+=item canonpath

+

+replaces backslashes with forward ones. then acts as *nixish.

+

+=item cflags

+

+if configured for dynamic loading, triggers #define EXT in EXTERN.h

+

+=item manifypods

+

+replaces strings '::' with '.' in man page names

+

+=item perl_archive

+

+points to libperl.a

+

+=back

+

+=cut

+

+ Mksymlists("NAME" => "$(NAME)", "DLBASE" => "$(DLBASE)", ',

+ '"VERSION" => "$(VERSION)", "DISTNAME" => "$(DISTNAME)", ',

+ '"INSTALLDIRS" => "$(INSTALLDIRS)", ',

+ '"DL_FUNCS" => ',neatvalue($funcs),

+ ', "DL_VARS" => ', neatvalue($vars), ');\'

+use File::Spec;

+our($Revision, @ISA);

+$Revision = '5.56 (27-Apr-1999)';

+@ISA = qw( File::Spec );

+ `$name -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {

+ if (`MCR $vmsfile -e "require $ver; print ""VER_OK\\n"""` =~ /VER_OK/) {

+ # Be kind about case for pollution

+ for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }

+

+ my(@terms) = split(/\s+/,$self->{DEFINE});

+ my(@defs,@udefs);

+ foreach $def (@terms) {

+ my $targ = \@defs;

+ if ($def =~ s/^-([DU])//) { # If it was a Unix-style definition

+ if ($1 eq 'U') { $targ = \@udefs; }

+ push @$targ, $def;

+ $self->{DEFINE} = '';

+ if (@defs) { $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; }

+ if (@udefs) { $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; }

+ $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};

+ # ($self->{DEFINE} has already been VMSified in constants() above)

+ if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }

+ for $type (qw(Def Undef)) {

+ my(@terms);

+ while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {

+ my $term = $1;

+ $term =~ s:^\((.+)\)$:$1:;

+ push @terms, $term;

+ }

+ if ($type eq 'Def') {

+ push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];

+ }

+ if (@terms) {

+ $quals =~ s:/${type}i?n?e?=[^/]+::ig;

+ $quals .= "/${type}ine=(" . join(',',@terms) . ')';

+ }

+# $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;

+ if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }

+ push @m,'

+ q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];

+

+ push @m, ' $(PERL) -e "print ""$(INST_STATIC)/Include=';

+ if ($self->{OBJECT} =~ /\bBASEEXT\b/ or

+ $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) {

+ push @m, ($Config{d_vms_case_sensitive_symbols}

+ ? uc($self->{BASEEXT}) :'$(BASEEXT)');

+ }

+ else { # We don't have a "main" object file, so pull 'em all in

+ # Upcase module names if linker is being case-sensitive

+ my($upcase) = $Config{d_vms_case_sensitive_symbols};

+ my(@omods) = map { s/\.[^.]*$//; # Trim off file type

+ s[\$\(\w+_EXT\)][]; # even as a macro

+ s/.*[:>\/\]]//; # Trim off dir spec

+ $upcase ? uc($_) : $_;

+ } split ' ', $self->eliminate_macros($self->{OBJECT});

+ my($tmp,@lines,$elt) = '';

+ my $tmp = shift @omods;

+ foreach $elt (@omods) {

+ $tmp .= ",$elt";

+ if (length($tmp) > 80) { push @lines, $tmp; $tmp = ''; }

+ }

+ push @lines, $tmp;

+ push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';

+ }

+ push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";

+ push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";

+ foreach $lib (split ' ', $self->{EXTRALIBS}) {

+ MAKEAPERL=1 NORECURS=1 };

+

+ push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{

+ # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)

+ push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];

+# a few workarounds for command.com (very basic)

+{

+ package ExtUtils::MM_Win95;

+

+ # the $^O test may be overkill, but we want to be sure Win32::IsWin95()

+ # exists before we try it

+

+ unshift @MM::ISA, 'ExtUtils::MM_Win95'

+ if ($^O =~ /Win32/ && Win32::IsWin95());

+

+ sub xs_c {

+ my($self) = shift;

+ return '' unless $self->needs_linking();

+ '

+.xs.c:

+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\

+ $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c

+ '

+ }

+

+ sub xs_cpp {

+ my($self) = shift;

+ return '' unless $self->needs_linking();

+ '

+.xs.cpp:

+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\

+ $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp

+ ';

+ }

+

+ # many makes are too dumb to use xs_c then c_o

+ sub xs_o {

+ my($self) = shift;

+ return '' unless $self->needs_linking();

+ '

+.xs$(OBJ_EXT):

+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\

+ $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c

+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c

+ ';

+ }

+} # end of command.com workarounds

+

+HTMLLIBPODS = ".join(" \\\n\t", sort keys %{$self->{HTMLLIBPODS}})."

+HTMLSCRIPTPODS = ".join(" \\\n\t", sort keys %{$self->{HTMLSCRIPTPODS}})."

+ INST_HTMLPRIVLIBDIR INSTALLHTMLPRIVLIBDIR

+ INST_HTMLSITELIBDIR INSTALLHTMLSITELIBDIR

+ INST_HTMLSCRIPTDIR INSTALLHTMLSCRIPTDIR

+ INST_HTMLLIBDIR HTMLEXT

+ INST_MAN1DIR INSTALLMAN1DIR MAN1EXT

+ INST_MAN3DIR INSTALLMAN3DIR MAN3EXT

+

+# 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

+ if ($GCC) {

+ my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};

+ $dllname =~ /(....)(.{0,4})/;

+ my $baseaddr = unpack("n", $1 ^ $2);

+ $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);

+ }

+

+ return $file if -r $file && -f _;

+ return "$file.bat" if -r "$file.bat" && -f _;

+all :: pure_all htmlifypods manifypods

+ push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);

+

+ if (%{$self->{HTMLLIBPODS}}) {

+ push @m, qq[

+config :: \$(INST_HTMLLIBDIR)/.exists

+];

+ push @m, $self->dir_target(qw[$(INST_HTMLLIBDIR)]);

+ }

+ if (%{$self->{HTMLSCRIPTPODS}}) {

+ push @m, qq[

+config :: \$(INST_HTMLSCRIPTDIR)/.exists

+ $self->{NOECHO}\$(NOOP)

+

+];

+ push @m, $self->dir_target(qw[$(INST_HTMLSCRIPTDIR)]);

+ }

+=item htmlifypods (o)

+

+Defines targets and routines to translate the pods into HTML manpages

+and put them into the INST_HTMLLIBDIR and INST_HTMLSCRIPTDIR

+directories.

+

+Same as MM_Unix version (changes command-line quoting).

+

+=cut

+

+sub htmlifypods {

+ my($self, %attribs) = @_;

+ return "\nhtmlifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless

+ %{$self->{HTMLLIBPODS}} || %{$self->{HTMLSCRIPTPODS}};

+ my($dist);

+ my($pod2html_exe);

+ if (defined $self->{PERL_SRC}) {

+ $pod2html_exe = $self->catfile($self->{PERL_SRC},'pod','pod2html');

+ } else {

+ $pod2html_exe = $self->catfile($Config{scriptdirexp},'pod2html');

+ }

+ unless ($pod2html_exe = $self->perl_script($pod2html_exe)) {

+ # No pod2html but some HTMLxxxPODS to be installed

+ print <<END;

+

+Warning: I could not locate your pod2html program. Please make sure,

+ your pod2html program is in your PATH before you execute 'make'

+

+END

+ $pod2html_exe = "-S pod2html";

+ }

+ my(@m);

+ push @m,

+qq[POD2HTML_EXE = $pod2html_exe\n],

+qq[POD2HTML = \$(PERL) -we "use File::Basename; use File::Path qw(mkpath); %m=\@ARGV;for (keys %m){" \\\n],

+q[-e "next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M '],

+ $self->{MAKEFILE}, q[';" \\

+-e "print qq(Htmlifying $$m{$$_}\n);" \\

+-e "$$dir = dirname($$m{$$_}); mkpath($$dir) unless -d $$dir;" \\

+-e "system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2HTML_EXE) ].qq[$$_>$$m{$$_}])==0 or warn qq(Couldn\\047t install $$m{$$_}\n);" \\

+-e "chmod(oct($(PERM_RW))), $$m{$$_} or warn qq(chmod $(PERM_RW) $$m{$$_}: $$!\n);}"

+];

+ push @m, "\nhtmlifypods : pure_all ";

+ push @m, join " \\\n\t", keys %{$self->{HTMLLIBPODS}}, keys %{$self->{HTMLSCRIPTPODS}};

+

+ push(@m,"\n");

+ if (%{$self->{HTMLLIBPODS}} || %{$self->{HTMLSCRIPTPODS}}) {

+ push @m, "\t$self->{NOECHO}\$(POD2HTML) \\\n\t";

+ push @m, join " \\\n\t", %{$self->{HTMLLIBPODS}}, %{$self->{HTMLSCRIPTPODS}};

+ }

+ join('', @m);

+}

+

+We don't want manpage process.

+ no warnings;

+ require ExtUtils::Manifest;

+ ExtUtils::Manifest::mkmanifest;

+ ExtUtils::Manifest::manicheck;

+ ExtUtils::Manifest::filecheck;

+ ExtUtils::Manifest::fullcheck;

+ ExtUtils::Manifest::skipcheck;

+ ExtUtils::Manifest::manifind();

+ ExtUtils::Manifest::maniread($file);

+ ExtUtils::Manifest::manicopy($read,$target,$how);

+mkmanifest() writes all files in and below the current directory to a

+manicheck() checks if all the files within a C<MANIFEST> in the

+filecheck() finds files below the current directory that are not

+fullcheck() does both a manicheck() and a filecheck().

+skipcheck() lists all the files that are skipped due to your

+manifind() returns a hash reference. The keys of the hash are the

+maniread($file) reads a named C<MANIFEST> file (defaults to

+C<manicopy($read,$target,$how)> copies the files that are the keys in

+$read is typically returned by the maniread() function. This

+There is no C<*.bs> file supplied with the extension. Instead, there may

+be a C<*_BS> file which has code for the special cases, like posix for

+

+use 5.005_64;

+our(@ISA, @EXPORT, $VERSION);

+ my $distname = $data->{DISTNAME} || $data->{NAME};

+ $distname = "Distribution $distname";

+ my $comment = "Perl (v$Config::Config{version}$threaded) module $data->{NAME}";

+ if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {

+ $distname = 'perl5-porters@perl.org';

+ $comment = "Core $comment";

+ }

+ print DEF "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";

+ my($isvax) = $Config::Config{'archname'} =~ /VAX/i;

+ print OPT "case_sensitive=yes\n"

+ if $Config::Config{d_vms_case_sensitive_symbols};

+

+use 5.005_64;

+our $VERSION = '0.03';

+# $Header: /home/rmb1/misc/CVS/perl5.005_61/lib/ExtUtils/typemap,v 1.3 1999/09/13 09:46:43 rmb1 Exp $

+UV T_UV

+ $var = INT2PTR($type,SvIV($arg))

+ $var = INT2PTR($type,tmp);

+ $var = INT2PTR($type,tmp);

+ $var = *INT2PTR($type,tmp);

+ $var = *INT2PTR($type,tmp);

+ sv_setpvn($arg, (char *)$var, sizeof(*$var));

+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs

+This compiler is typically run by the makefiles created by L<ExtUtils::MakeMaker>.

+

+Note that the C<XSOPT> MakeMaker option may be used to add these options to

+any makefiles generated by MakeMaker.

+

+=item B<-nooptimize>

+

+Disables certain optimizations. The only optimization that is currently

+affected is the use of I<target>s by the output C code (see L<perlguts>).

+This may significantly slow down the generated code, but this is the way

+B<xsubpp> of 5.005 and earlier operated.

+

+=item B<-noinout>

+Disable recognition of C<IN>, C<OUT_LIST> and C<INOUT_LIST> declarations.

+=item B<-noargtypes>

+

+Disable recognition of ANSI-like descriptions of function signature.

+

+=back

+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";

+$WantOptimize = 1 ;

+

+my $process_inout = 1;

+my $process_argtypes = 1;

+

+ # XXX left this in for compat

+ $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

+$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;

+}

+

+ SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL

+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 $arg_list{$var_name}++

+ or defined $arg_types{$var_name} and not $processing_arg_with_types;

+ # 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;

+ }

+ if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/

+ or $in_out{$var_name} and $in_out{$var_name} eq 'OUTLIST'

+ and $var_init !~ /\S/) {

+ if ($name_printed) {

+ print ";\n";

+ } else {

+ }

+ &output_init($var_type, $var_num, $var_name, $var_init, $name_printed);

+ &generate_init($var_type, $var_num, $var_name, $name_printed);

+sub POSTCALL_handler() { print_section() }

+

+ undef($RETVAL_no_return) ;

+ undef(@arg_with_types) ;

+ undef($processing_arg_with_types) ;

+ undef(%arg_types) ;

+ undef(@in_out) ;

+ undef(%in_out) ;

+ undef($prepush_done);

+ $xsreturn = 0;

+ $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;

+ unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s;

+ $orig_args =~ s/\\\s*/ /g; # process line continuations

+

+ my %out_vars;

+ 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 = $_;

+ my $default;

+ ($arg, $default) = / ( [^=]* ) ( (?: = .* )? ) /x;

+ my ($pre, $name) = ($arg =~ /(.*?) \s* \b(\w+) \s* $ /x);

+ next unless length $pre;

+ my $out_type;

+ my $inout_var;

+ if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) {

+ my $type = $1;

+ $out_type = $type if $type ne 'IN';

+ $arg =~ s/^(IN|IN_OUTLIST|OUTLIST)\s+//;

+ }

+ if (/\W/) { # Has a type

+ push @arg_with_types, $arg;

+ # warn "pushing '$arg'\n";

+ $arg_types{$name} = $arg;

+ $_ = "$name$default";

+ }

+ $out_vars{$_} = 1 if $out_type eq 'OUTLIST';

+ push @in_out, $name if $out_type;

+ $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)\s+//) {

+ my $out_type = $1;

+ next if $out_type eq 'IN';

+ $out_vars{$_} = 1 if $out_type eq 'OUTLIST';

+ push @in_out, $name;

+ $in_out{$_} = $out_type;

+ }

+ }

+ }

+ ($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] eq '' && $i == $#args) {

+ $report_args .= ", ...";

+ if ($out_vars{$args[$i]}) {

+ push @args_num, undef;

+ } else {

+ push @args_num, ++$num_args;

+ $report_args .= ", $args[$i]";

+ }

+ $extra_args++;

+ $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;

+ $xsreturn = 1 if $EXPLICIT_RETURN;

+

+# Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));

+# Perl_croak(aTHX_ "Usage: $pname($report_args)");

+ print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n";

+ print "\t" . &map_type($ret_type, 'RETVAL') . ";\n"

+ print "\tdXSTARG;\n"

+ if $WantOptimize and $targetable{$type_kind{$ret_type}};

+ if (@arg_with_types) {

+ unshift @line, @arg_with_types, $_;

+ $_ = "";

+ $processing_arg_with_types = 1;

+ INPUT_handler() ;

+ }

+ $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;

+ process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE");

+ 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 = @in_out;

+ 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 @in_out;

+

+# Perl_croak(aTHX_ errbuf);

+ if ($xsreturn) {

+# XSRETURN($xsreturn);

+ local($type, $num, $var, $init, $name_printed) = @_;

+ if ($name_printed) {

+ eval qq/print " $init\\n"/;

+ } else {

+ eval qq/print "\\t$var $init\\n"/;

+ }

+ &generate_init($type, $num, $var, $name_printed);

+ } elsif ($name_printed) {

+ print ";\n";

+ $init =~ s/^;//;

+ blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return

+ blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return

+ 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"/;

+ }

+ if ($name_printed) {

+ print ";\n";

+ } else {

+ eval qq/print "\\t$var;\\n"/;

+ warn $@ if $@;

+ }

+ die "panic: do not know how to handle this branch for function pointers"

+ if $name_printed;

+ local($type, $num, $var, $do_setmagic, $do_push) = @_;

+ print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";

+ blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return

+ blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return

+ print "\tsv_2mortal(ST($num));\n";

+ print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic;

+ 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;

+ }

+ my($type, $varname) = @_;

+ if ($varname) {

+ if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) {

+ (substr $type, pos $type, 0) = " $varname ";

+ } else {

+ $type .= "\t$varname";

+ }

+ }