view release on metacpan or  search on metacpan

ASM.pm  view on Meta::CPAN

#==============================================================================
# Generate the XS glue code
#==============================================================================
sub write_XS {
    my $o = shift;
    my ($pkg, $module, $modfname) = @{$o->{API}}{qw(pkg module modfname)};
    my $prefix = (($o->{ILSM}{XS}{PREFIX}) ?
		  "PREFIX = $o->{ILSM}{XS}{PREFIX}" :
		  '');
		  
    $o->mkpath($o->{API}{build_dir});
    open XS, "> $o->{API}{build_dir}/$modfname.xs"
      or croak "Inline::ASM::write_XS: $!";

    print XS <<END;
$o->{ILSM}{AUTO_INCLUDE}
END

    for my $sym (keys %{$o->{parser}{bound}}) {
	my ($rtype, $args) = $o->{ILSM}{PROTOTYPES}{$sym}
	  =~ m!([^\(]+)(\([^\)]*\))!g;
	print XS "extern $rtype $sym $args;\n";
    }

    print XS <<END;

MODULE = $module	PACKAGE = $pkg	$prefix

PROTOTYPES: DISABLE
END

    warn("Warning. No Inline ASM functions bound to Perl\n" .
         "Check your PROTO option(s) for Inline compatibility\n\n")
      if ((not scalar keys %{$o->{parser}{bound}}) and ($^W));

    my $parm = "neil";
    for my $function (keys %{$o->{parser}{bound}}) {
	my ($rtype, $args) = $o->{ILSM}{PROTOTYPES}{$function}
	  =~ m!([^\(]+)(\([^\)]*\))!g;

	$args =~ s/\(([^\)]*)\)/$1/;
	my @arg_types = split/\s*,\s*/, $args;
	my @arg_names = map { $parm++ } @arg_types;

	print XS ("\n$rtype\n$function (", 
		  join(', ', @arg_names), ")\n");

	for my $arg_name (@arg_names) {
	    my $arg_type = shift @arg_types;
	    last if $arg_type eq '...';
	    print XS "\t$arg_type\t$arg_name\n";
	}

	my $listargs = '';
	my $arg_name_list = join(', ', @arg_names);

	if ($rtype eq 'void') {
	    print XS <<END;
	PREINIT:
	I32* temp;
	PPCODE:
	temp = PL_markstack_ptr++;
	$function($arg_name_list);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */
END
	}
    }
    print XS "\n";

    if (defined $o->{ILSM}{XS}{BOOT} and
	$o->{ILSM}{XS}{BOOT}) {
	print XS <<END;
BOOT:
$o->{ILSM}{XS}{BOOT}
END
    }

    close XS;
}

#==============================================================================
# Generate the Makefile.PL
#==============================================================================
sub write_Makefile_PL {
    my $o = shift;

    $o->{ILSM}{xsubppargs} = '';
    for (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
	$o->{ILSM}{xsubppargs} .= "-typemap $_ ";
    }

    my %options = (
		   VERSION => '0.00',
		   %{$o->{ILSM}{MAKEFILE}},
		   NAME => $o->{API}{module},
		   OBJECT => qq{\$(BASEEXT)\$(OBJ_EXT) $o->{API}{modfname}_asm\$(OBJ_EXT)},
		  );

    open MF, "> $o->{API}{build_dir}/Makefile.PL"
      or croak "Inline::ASM::write_Makefile_PL: $!\n";

    print MF <<END;
use ExtUtils::MakeMaker;
my %options = %\{
END

    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 1;
    print MF Data::Dumper::Dumper(\ %options);

    my $asmcmd;
    # This neato little hack notices that GASP is being used, and substitutes
    # 'gasp' for 'gasp <filename.asm> | as -o <filename.o>'
    if ($o->{ILSM}{AS} =~ /^\s*gasp/) {
        $asmcmd = $o->{ILSM}{AS};