C-DynaLib
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
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/) {
Makefile.PL view on Meta::CPAN
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/;
}
}
Makefile.PL view on Meta::CPAN
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
( run in 0.756 second using v1.01-cache-2.11-cpan-99c4e6809bf )