C-DynaLib
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
}
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;
}
( run in 3.150 seconds using v1.01-cache-2.11-cpan-75ffa21a3d4 )