Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 7edc3117c7
Fetching contributors…

Cannot retrieve contributors at this time

executable file 754 lines (682 sloc) 21.017 kb
use ExtUtils::MakeMaker;
use strict;
require 5.002;
use Config;
my(@convention, $convention,
$num_callbacks, %cflags, $object, $devnull,
$conv_xs, $cbfunc_c, $cdecl_h, $postamble,
$is_gcc, $is_msvc, $is_borland, $is_dynamic,
$is_win32, $Verbose,
$stack_reserve, $stack_adjust, $stack_align,
$do_reverse);
my $Cpp; # run testcall through -E -P (might break, just for debugging)
$conv_xs = "conv.xsi";
$cbfunc_c = "cbfunc.c";
$cdecl_h = "cdecl.h";
$object = '$(BASEEXT)$(OBJ_EXT)';
$is_gcc = $Config{cc} =~ /gcc/i && $Config{gccversion} >= 2;
$is_msvc = ($^O eq 'MSWin32' and $Config{cc} =~ /^cl/i);
$is_borland = $Config{cc} =~ /\bbcc/i;
$is_dynamic = ($Config{usedl} eq 'define');
$is_win32 = $^O =~ /MSWin32|cygwin/;
use subs qw(write_conv write_cbfunc write_cdecl_h is_big_endian check_ieee_fp);
$postamble = "
clean::
\$(RM_F) $conv_xs $cbfunc_c *.core *.stackdump
$conv_xs: $0 \$(CONFIGDEP)
$cbfunc_c: $0 \$(CONFIGDEP)
DynaLib.c: $conv_xs
";
$is_dynamic or warn <<STATIC;
*** NOTE
*** According to $INC{"Config.pm"},
*** this perl does not know how to use dynamic loading. The test
*** program for this module will fail, and you will not be able to
*** invoke functions in dynamic libraries. If you need this feature,
*** you have to rebuild perl. Choose "y" when Configure asks, "Do
*** you wish to use dynamic loading?".
STATIC
@convention = ();
%cflags = ();
for (@ARGV) {
/^DECL=(.*)$/ and push @convention, split(",", $1);
/^CALLBACKS=(\d+)$/ and $num_callbacks = $1;
/^(-D.*)(?:\=(.*))?$/ and $cflags{$1} = $2;
/^Verbose$/i and $Verbose = 1;
/^Cpp$/i and $Cpp = 1;
/^STACK_RESERVE=(\d+)$/ and $stack_reserve = $1;
/^STACK_ADJUST=(\d+)$/ and $stack_adjust = $1;
/^STACK_ALIGN=(\d+)$/ and $stack_align = $1;
}
# Appease MakeMaker:
@ARGV = grep { !/^(DECL=|CALLBACKS=\d+$|-D.|STACK_\w+=\d+)/ } @ARGV;
my $ccflags = $Config{ccflags};
my $archname = $Config{archname};
# cc can also be gcc
if (!$is_gcc and $Config{cc} =~ /^cc/) {
my $test = `$Config{cc} -dumpversion`;
$is_gcc = 1 if $test and $test eq $Config{gccversion}."\n";
$is_gcc = 1 if $test and !$is_gcc and $test =~ /^[34]./;
}
# TODO: support more fastcall derivates (ia64/x86_64: first six in regs, rest in args)
unless (@convention) {
for (
#[ '^i?[x3-6]86', sub {'cdecl'} ],
[ '^sun4-', sub {'sparc'} ],
[ 'sparc', sub {'sparc'} ],
[ '(alpha|axp)',
sub {
unless ($is_gcc) {
$postamble .= "\nalpha-cc\$(OBJ_EXT): alpha-cc.s\n"
. "\t\$(CC) -c alpha-cc.s -o \$\@\n"
. "\n#alpha-cc.s: alpha-cc.c\n"
. "#\tgcc -O2 -S alpha-cc.c -o \$\@\n";
$object .= " alpha-cc.o";
}
'alpha'} ],
[ 'win32', sub {'stdcall'} ],
#[ '^cygwin', sub {my $CDECL_ADJUST = -32; ('cdecl','stdcall')} ],
[ '', sub { () } ],
)
{ @convention = &{$_->[1]}, last if $archname =~ /$_->[0]/i }
}
# when? see 75b18f7c2d75e
# freebsd7 gcc3.4.6 cdecl ok one_by_one=0,do_adjust=0,stack_reserve=0,do_reverse=0,arg_align=4
# freebsd7 gcc4.2.1 cdecl ok one_by_one=0,do_adjust=0,stack_reserve=0,do_reverse=0,arg_align=4
#---
# freebsd7 gcc4.2.1 cdecl3 ok one_by_one=0,do_adjust=-16,stack_reserve=3,do_reverse=0,arg_align=4
# cygwin7 gcc4.3.4 cdecl3 ok one_by_one=0,do_adjust=-16,stack_reserve=3,do_reverse=0,arg_align=4
# mingw gcc3.4.5 cdecl fail one_by_one=0,do_adjust=-16,stack_reserve=3,do_reverse=0,arg_align=4
# msvc6 cl 12 cdecl ok one_by_one=1,do_adjust=0,stack_reserve=0,do_reverse=0,arg_align=4
# debian64 gcc4.4.4 cdecl6 ok one_by_one=0,do_adjust=-16,stack_reserve=6,do_reverse=0,arg_align=8
# Disable cc optimization
my $optimize = $Config{optimize};
if ($is_msvc) {
$optimize = '/Od';
$ccflags =~ s|[-/]O\d ||;
} elsif ($Config{optimize} =~ /[\-\/]O\w/) {
; #$optimize =~ s/O\w/O0/; # changing to -O0 turned out to be contra-productive
}
if ($is_gcc and $ccflags =~ /-DDEBUGGING/) {
$optimize .= " -g";
}
#if ($is_gcc and $ccflags !~ /omit-frame-pointer/) {
# # but it does not work as expected on linux+win32. use the same as perl
# $optimize .= " -fomit-frame-pointer";
#}
WriteMakefile(
'NAME' => 'C::DynaLib',
'VERSION_FROM' => 'lib/C/DynaLib.pm',
'DEFINE' => '',
'OBJECT' => $object,
# Don't let MakeMaker set up a dependency loop.
# cdecl.h depends on testcall.o, not the other way around!
'H' => [],
'C' => ['DynaLib.c'],
'INC' => '-I.',
'OPTIMIZE' => $optimize,
'PREREQ_PM' => {
'Convert::Binary::C' => 0.70, # 0.70 structs only
($is_gcc ? ('GCC::TranslationUnit' => "1.00") : ()),
'Test' => 0,
'Test::More' => 0,
},
($] >= 5.005 ?
('AUTHOR' => 'John Tobey <John.Tobey@gmail.com>, Reini Urban <rurban@cpan.org>',
'ABSTRACT_FROM' => 'lib/C/DynaLib.pm') : ()),
($ExtUtils::MakeMaker::VERSION gt '6.46' ?
('META_MERGE'
=> {recommends =>
{
"GCC::TranslationUnit" => "1.01",
"Convert::Binary::C" => "0.74",
},
resources =>
{
license => 'http://dev.perl.org/licenses/',
repository => 'http://github.com/rurban/c-dynalib',
},
}
) : ()),
clean => { FILES =>
"*.core *.stackdump *.exe test*.ilk test*.obj test*.pdb test*.pdb vc*.pdb ".
"*.err *.bak *.o dll.base dll.exp"
},
);
sub is_big_endian
{
my $byteorder = $Config{byteorder}
|| unpack( "a*", pack "L", 0x34333231 );
die "Native byte order ($byteorder) not supported!\n"
if $byteorder ne '1234' and $byteorder ne '4321'
and $byteorder ne '12345678' and $byteorder ne '87654321';
$byteorder eq '4321' or $byteorder eq '87654321';
}
sub check_ieee_fp
{
my @test = (
{
value => '-1.0',
double => pack( 'C*', 0xBF, 0xF0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ),
single => pack( 'C*', 0xBF, 0x80, 0x00, 0x00 ),
},
{
value => '0.0',
double => pack( 'C*', 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ),
single => pack( 'C*', 0x00, 0x00, 0x00, 0x00 ),
},
{
value => '0.4',
double => pack( 'C*', 0x3F, 0xD9, 0x99, 0x99, 0x99, 0x99, 0x99, 0x9A ),
single => pack( 'C*', 0x3E, 0xCC, 0xCC, 0xCD ),
},
{
value => '1.0',
double => pack( 'C*', 0x3F, 0xF0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ),
single => pack( 'C*', 0x3F, 0x80, 0x00, 0x00 ),
},
{
value => '3.1415926535',
double => pack( 'C*', 0x40, 0x09, 0x21, 0xFB, 0x54, 0x41, 0x17, 0x44 ),
single => pack( 'C*', 0x40, 0x49, 0x0F, 0xDB ),
},
{
value => '1.220703125e-4',
double => pack( 'C*', 0x3F, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ),
single => pack( 'C*', 0x39, 0x00, 0x00, 0x00 ),
},
);
my @fail;
for my $t ( @test ) {
my $s = pack 'f', $t->{value};
my $d = pack 'd', $t->{value};
unless( &is_big_endian ) { for( $s, $d ) { $_ = reverse $_ } }
$s eq $t->{single} or push @fail,
{ value => $t->{value}, check => 'single', expected => $t->{single}, got => $s };
$d eq $t->{double} or push @fail,
{ value => $t->{value}, check => 'double', expected => $t->{double}, got => $d };
}
return @fail;
}
sub pretest {
my $self = shift;
my @candidate;
my $cleanup = sub {
unlink ("testtest.c", "testtest.txt", "testtest$self->{EXE_EXT}",
"testtest$self->{OBJ_EXT}");
};
my $cant = sub {
&$cleanup;
print "I don't know how run the test program,\n",
"so I'll try to find a default configuration.\n"
if $Verbose;
return undef;
};
my $try = sub {
open HELLO, "testtest.txt" or return undef;
my $hello = <HELLO>;
close HELLO;
if ($hello =~ /hello, world/) {
&$cleanup;
return 1;
}
return 0;
};
&$cleanup;
unless (open PROG, ">testtest.c") {
print ("Can't write testtest.c\n");
return &$cant;
}
print PROG <<'PROG';
#define main notmain
#include <EXTERN.h>
#include <perl.h>
#undef main
#undef fprintf
#undef fopen
#undef fclose
#include <stdio.h>
int main()
{
FILE *fp = fopen("testtest.txt", "w");
if (fp == NULL) {
return 1;
}
fprintf(fp, "hello, world!\n");
fclose(fp);
return 0;
}
PROG
close PROG;
@candidate = ();
$devnull = $^O eq 'MSWin32' ? "> NUL" : ">/dev/null 2>&1";
my $cmd1 = "$Config{cc} $ccflags $optimize -DNARF -I$self->{PERL_INC} testtest.c";
push @candidate, "$cmd1 -o testtest$self->{EXE_EXT} $devnull"
unless $Verbose;
push @candidate, "$cmd1 -otesttest$self->{EXE_EXT} $devnull"
unless $Verbose;
push @candidate, "$cmd1 -o testtest$self->{EXE_EXT}";
push @candidate, "$cmd1 -otesttest$self->{EXE_EXT}";
while ($self->{how_to_compile} = shift (@candidate)) {
unlink "testtest$self->{EXE_EXT}";
print "$self->{how_to_compile}\n" if $Verbose;
system ($self->{how_to_compile});
last if $? == 0 && -x "testtest$self->{EXE_EXT}";
}
return &$cant unless $self->{how_to_compile};
@candidate = ();
push @candidate, "./testtest$self->{EXE_EXT} $devnull"
if !$is_msvc and !$Verbose;
push @candidate, "./testtest$self->{EXE_EXT}"
if !$is_msvc;
push @candidate, "testtest$self->{EXE_EXT} $devnull"
unless $Verbose;
push @candidate, "testtest$self->{EXE_EXT}";
push @candidate, "run testtest$self->{EXE_EXT}";
unlink ("testtest.txt");
while ($self->{how_to_run} = shift (@candidate)) {
print "$self->{how_to_run}\n" if $Verbose;
system ($self->{how_to_run});
$? == 0 && &$try and return 1;
}
return &$cant;
}
sub guess_cdecl_h {
my $self = shift;
open CONFIG, ">$cdecl_h" or die "can't write $cdecl_h";
$do_reverse = 0;
print "Testing stack layout...\n" if $Verbose;
$self->{how_to_compile} =~ s/testtest/testreverse/g;
$self->{how_to_run} =~ s/testtest/testreverse/g;
my $defines;
for ("-DINCLUDE_ALLOCA", "", "-DINCLUDE_MALLOC") {
$defines = $_;
my $cmd = $self->{how_to_compile};
$defines .= " -g" if $is_gcc;
$defines .= " -DVERBOSE" if $Verbose;
$cmd =~ s/-DNARF/$defines/g;
unlink ("testreverse$self->{EXE_EXT}", $cdecl_h);
print "$cmd\n" if $Verbose;
system ($cmd);
if ($? == 0 && -x "testreverse$self->{EXE_EXT}") {
$cmd = $self->{how_to_run};
print "$cmd\n" if $Verbose;
system ($cmd);
if ($? == 0) {
$do_reverse = 0;
} else {
$do_reverse = 1;
}
print "CDECL_REVERSE = $do_reverse\n" if $Verbose;
}
}
my $define_if_not = sub {
my ($macro, $def) = @_;
return "#ifndef $macro\n#define $macro $def\n#endif\n\n";
};
print CONFIG <<CONFIG;
/*
* $cdecl_h generated by $0. Do not edit this file, edit $0.
*/
CONFIG
print CONFIG "#include <alloca.h>\n"
if $self->{CC} =~ /\bcc$/;
print CONFIG "#include <malloc.h>\n"
if $is_borland;
print CONFIG (&$define_if_not("CDECL_ONE_BY_ONE",
(($archname =~ /win32/i && ! $is_borland)
|| $is_gcc) ? 1 : 0));
print CONFIG (&$define_if_not("CDECL_ADJUST",
($is_borland ? -12 : 0)));
print CONFIG (&$define_if_not("CDECL_REVERSE", $do_reverse));
close CONFIG;
}
sub make_postamble {
my $self = shift;
$postamble .= "\nDynaLib\$(OBJ_EXT): DynaLib.c $cbfunc_c"
. " @{[ map { \"$_.c\" } @convention ]}\n";
! @convention || grep { $_ eq "cdecl" } @convention
or return $postamble;
print "Writing $cdecl_h\n";
if (write_cdecl_h($self)) {
unless (@convention) {
# check cdecl/cdecl3/cdecl6
local $/;
open F, "<", $cdecl_h;
my $file = <F>;
my ($cdecl3) = $file =~ /CDECL_STACK_RESERVE (\d)/;
my ($reverse) = $file =~ /CDECL_REVERSE (\d)/;
close F;
if ($cdecl3 == 3) {
@convention = ('cdecl3');
} elsif ($cdecl3 == 6) {
@convention = ('cdecl6');
} else {
@convention = ('cdecl');
}
if ($reverse or $is_win32) {
push @convention, 'stdcall' unless grep /^stdcall$/, @convention;
print "Using conventions: @convention\n";
}
}
} elsif (@convention) {
print "Can't figure out this system. I'll have to guess.\n"
if $Verbose;
guess_cdecl_h($self);
if ($do_reverse and !grep /^stdcall$/, @convention) {
push @convention, 'stdcall';
print "Using conventions: @convention\n";
}
elsif ($is_win32) {
push @convention, 'stdcall' unless grep /^stdcall$/, @convention;
push @convention, 'hack30' unless grep /^hack30$/, @convention;
print "Using conventions: @convention\n";
}
} else {
print <<WARN;
***
*** WARNING
***
*** I can not figure out the correct way to pass arguments to a C function
*** on this system. This may be due to porting issues, a perl installation
*** problem, or any number of things. Maybe 'perl Makefile.PL Verbose'
*** will shed some light.
***
*** I will use the "hack30" calling convention, which may work some or most
*** of the time for integers alike. Or it may crash your programs. A better
*** solution would be to add support for your systems calling convention.
***
*** See perldoc lib/C/DynaLib.pm for a discussion of "hack30".
***
WARN
@convention = ('hack30');
return $postamble;
}
$postamble .= "
clean::
\$(RM_F) testreverse\$(EXE_EXT) testreverse\$(OBJ_EXT) testcall\$(EXE_EXT) testcall\$(OBJ_EXT) $cdecl_h
DynaLib\$(OBJ_EXT): $cdecl_h ";
$postamble .= join(" ", map { $_.".c"} @convention);
$postamble .= "
$cdecl_h: $0 \$(CONFIGDEP) testcall\$(EXE_EXT)
$self->{how_to_run}
testcall\$(EXE_EXT) : testcall.c
\$(CC) `\$(PERL) -MExtUtils::Embed -e ccopts` \$(OPTIMIZE) testcall.c -o\$\@
testreverse\$(EXE_EXT) : testreverse.c
\$(CC) `\$(PERL) -MExtUtils::Embed -e ccopts` \$(OPTIMIZE) testreverse.c -o\$\@
";
}
sub MY::postamble {
my $self = shift;
my $postamble = make_postamble($self);
print "Using calling convention(s): @convention\n"
if $Verbose;
for (@convention) {
# $cflags{"-DDYNALIB_DECL=\\\"$_\\\""} = undef;
$cflags{"-DDYNALIB_USE_$_"} = undef;
}
print "Default calling convention: $convention[0]\n"
if $Verbose;
$cflags{"-DDYNALIB_DEFAULT_CONV"} = "\\\"$convention[0]\\\"";
$num_callbacks = 4 unless defined($num_callbacks);
print "Maximum number of callbacks: $num_callbacks\n"
if $Verbose;
$cflags{"-DDYNALIB_NUM_CALLBACKS"} = $num_callbacks;
my $defines = "\nDEFINE =";
for (sort keys %cflags) {
$defines .= " $_";
$defines .= "=$cflags{$_}" if defined $cflags{$_};
}
$postamble .= $defines;
print "Additional definitions: $defines\n"
if $Verbose and scalar(keys %cflags)>1;
write_conv();
write_cbfunc();
parse_perl_types();
return $postamble;
}
sub write_cdecl_h {
my $self = shift;
print "Testing how to compile and run a program...\n"
if $Verbose;
pretest($self) or return undef;
print "Testing how to pass args to a function...\n"
if $Verbose;
$self->{how_to_compile} =~ s/testtest/testcall/g;
$self->{how_to_run} =~ s/testtest/testcall/g;
my $defines;
for $defines ("-DINCLUDE_ALLOCA", "", "-DINCLUDE_MALLOC") {
my $cmd = $self->{how_to_compile};
$cmd =~ s/-DNARF/$defines/g;
$cmd .= " -g" if $is_gcc;
$cmd .= " -DVERBOSE" if $Verbose;
if ($is_gcc and $Cpp) { # expand DO_CALL for gdb
$cmd =~ s/-o\s+testcall/-o testcall.E.c -E -P/;
print "$cmd\n" if $Verbose;
system ($cmd);
if ($? == 0 && -f "testcall.E.c") {
# add \n to DO_CALL and fix linenumbers for gdb
open IN, "<", "testcall.E.c";
open OUT, ">", "testcall.E1.c";
while (<IN>){
# line numbers stripped with -P, but keep this code.
if (/^# (\d+) "testcall.E1.c"$/) {
if ($1 > 50) {
s/^.*$//;
next;
}
}
s/^# (\d+) "testcall.c"/# $. "testcall.E1.c"/;
if (/ char \*arg; int i; void \*d1/) {
s/(;|\{|\}) /$1\n\t/g;
}
print OUT;
}
close IN;
close OUT;
$cmd =~ s/testcall.c -o testcall.E.c -E -P/testcall.E1.c -o testcall/;
}
}
AGAIN:
unlink ("testcall$self->{EXE_EXT}", $cdecl_h);
print "$cmd\n" if $Verbose;
system ($cmd);
if ($? == 0 && -x "testcall$self->{EXE_EXT}") {
my $runcmd = $self->{how_to_run};
print "$runcmd\n" if $Verbose;
system ($runcmd);
if ($? == 0 && -e $cdecl_h) {
print "Succeeded.\n" if $Verbose;
return 1;
}
# compiled okay and executable: no need to try the two
# other options no header and malloc
if ($cmd =~ / -DRESERVE/) {
last;
} else {
print "Try again with -DRESERVE\n" if $Verbose;
$cmd .= " -DRESERVE";
goto AGAIN;
}
}
}
return undef;
}
sub write_conv {
# Write conv.xsi, to be included in DynaLib.xs
open XS, ">$conv_xs"
or die "Can't write file \"$conv_xs\": $!\n";
print "Writing $conv_xs\n";
print XS <<XS;
#
# $conv_xs generated by $0. Don't edit this file, edit $0.
#
XS
#
# conv.xsi XS definition for the "glue" function that calls C.
#
for $convention (@convention) {
print XS <<XS;
void
${convention}_call_packed(symref, ret_type, ...)
void * symref
char * ret_type
PROTOTYPE: \$\$\@
PPCODE:
{
SV *sv;
#ifdef HAS_QUAD
Quad_t aquad;
unsigned Quad_t auquad;
#endif
if (*ret_type != '\\0') {
sv = sv_newmortal();
}
switch (*ret_type) {
case '\\0' :
(void) ${convention}_CALL(symref, int);
XSRETURN_EMPTY;
case 'i' :
sv_setiv(sv, (IV) ${convention}_CALL(symref, int));
break;
case 'l' :
sv_setiv(sv, (IV) ${convention}_CALL(symref, I32));
break;
case 's' :
sv_setiv(sv, (IV) ${convention}_CALL(symref, I16));
break;
case 'c' :
sv_setiv(sv, (IV) ${convention}_CALL(symref, char));
break;
case 'I' :
sv_setuv(sv, (UV) ${convention}_CALL(symref, uint));
break;
case 'L' :
sv_setuv(sv, (UV) ${convention}_CALL(symref, U32));
break;
case 'S' :
sv_setuv(sv, (UV) ${convention}_CALL(symref, U16));
break;
case 'C' :
sv_setuv(sv, (UV) ${convention}_CALL(symref, uchar));
break;
#ifdef HAS_QUAD
case 'q' :
aquad = ${convention}_CALL(symref, Quad_t);
if (aquad >= IV_MIN && aquad <= IV_MAX)
sv_setiv(sv, (IV)aquad);
else
sv_setnv(sv, (double)aquad);
break;
case 'Q' :
aquad = ${convention}_CALL(symref, Uquad_t);
if (aquad <= UV_MAX)
sv_setuv(sv, (UV)auquad);
else
sv_setnv(sv, (double)auquad);
break;
#endif
case 'f' :
sv_setnv(sv, (double) ${convention}_CALL(symref, float));
break;
case 'd' :
sv_setnv(sv, ${convention}_CALL(symref, double));
break;
case 'Z' :
case 'p' :
sv_setpv(sv, (char *) ${convention}_CALL(symref, char*));
break;
case 'P' :
sv_setpvn(sv, (unsigned char *) ${convention}_CALL(symref, char*),
atoi(&ret_type[1]));
break;
default :
croak("Unsupported function return type: '%c'", *ret_type);
}
XPUSHs(sv);
XSRETURN(1);
}
XS
}
close XS;
}
sub write_cbfunc {
my ($i);
# Write cbfunc.c, to be included in DynaLib.xs
open FUNCS, ">$cbfunc_c"
or die "Can't write file \"$cbfunc_c\": $!\n";
print "Writing $cbfunc_c\n";
print FUNCS <<FUNCS;
/*
* $cbfunc_c generated by $0. Don't edit this file, edit $0.
*/
FUNCS
#
# The callback functions.
#
for $i (0 .. $num_callbacks - 1) {
print FUNCS <<FUNCS;
static long
#ifdef I_STDARG
_cb_func$i(void * first, ...)
#else
_cb_func$i(first, va_alist)
void * first;
va_dcl
#endif
{
va_list ap;
long result;
#ifdef I_STDARG
va_start(ap,first);
#else
va_start(ap);
#endif
result = cb_call_sub($i, first, ap);
va_end(ap);
return result;
}
FUNCS
}
#
# Array of callback entry pointers.
#
print FUNCS "\nstatic const cb_callback cb_arr[DYNALIB_NUM_CALLBACKS] = {\n";
for $i (0 .. $num_callbacks - 1) {
print FUNCS "\t_cb_func$i,\n";
}
print FUNCS "};\n";
}
sub parse_perl_types
{
unless (eval "require Convert::Binary::C;") {
print "Warning: Convert::Binary::C not installed. PerlTypes not generated.\n";
return;
}
Convert::Binary::C->import;
use Data::Dumper;
my $byteorder = is_big_endian();
my $c = new Convert::Binary::C('ByteOrder' => $byteorder ? 'BigEndian' : 'LittleEndian');
$c->Include(["$Config{archlib}/CORE", '/usr/include', $Config{incpath},
$Config{locincpth}, @{$c->Include}]);
eval { $c->parse("#include <EXTERN.h>\n#include <perl.h>"); };
my $cfg = $c->configure;
my $dump = Data::Dumper->Dump([$cfg], ['PerlTypes']);
my $fname = "lib/C/DynaLib/PerlTypes.pm";
open XS, "> $fname"
or die "Can't write file \"$fname\": $!\n";
print "Adding Convert::Binary::C configuration to $fname\n";
print XS <<XS;
# PerlTypes.pm generated by Makefile.PL. Don't edit this file, edit Makefile.PL.
# From Convert::Binary::C \$c->parse("#include <EXTERN.h>\n#include <perl.h>")->configure
package C::DynaLib::PerlTypes;
$dump;
1;
__END__
XS
# eval C::DynaLib::PERLTYPES => %C::DynaLib::Struct::PerlTypes;
close XS;
}
# Local Variables:
# cperl-indent-level: 4
# End
Jump to Line
Something went wrong with that request. Please try again.