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 )