mex.pl

此程序是本人编写的在MFC环境下调用Matlab函数进行编程的实例

        $outdir = ".";
    }
    else
    {
        # strip trailing backslash:
        $outdir = substr($outdir, 0, length($outdir) - 1);
    }

    opendir(DIR,$outdir) || die " Can't open dir '$outdir': $!\n";
    while ($file = readdir(DIR)) {
        if ($file =~ /^_lib*.*/) {
            unlink("$outdir\\$file");
        }
    }
    closedir(DIR);

    if ($makefilename)
    {
        close(MAKEFILE);
        if ($_[0] ne "normally")
        {
            unlink $makefilename;
        }
    }

    die "\n  $main::cmd_name: $_[0]\n\n" unless ($_[0] eq "normally");
    exit(0);
}

sub process_response_file
{
# inputs:
    my ($filename) = @_;

# locals:
    my ($rspfile);

    open(RSPFILE, "$filename") || &expire("Error: Can't open response file '$filename': $!");
    while (<RSPFILE>)
    {
        $rspfile .= $_;
    }
    close(RSPFILE);

    # shellwords strips out backslashes thinking they are escape sequences.
    # In DOS we'd rather treat them as DOS path seperators.
    $rspfile =~ s/\\/\\\\/g;
    # return output of shellwords
    &shellwords($rspfile);
}


################################################################################
# Ada S-Functions
#
#
sub build_ada_s_function
{
    my ($ada_sfunction, $ada_include_dirs) = @_;
    $ada_sfunction =~ s/\//\\/g;
    if ($ada_sfunction eq "") {
	&expire("Error: Invalid use of -ada option");
    }

    # get the directorires
    my $mlroot = $main::script_directory;
    $mlroot =~ s/(.*)\\bin.*/$1/i;
    my $sl_ada_dir = $mlroot . "\\simulink\\ada";
    my $cwd = getcwd(); $cwd =~ s/\//\\/g;

    my $sfcn_base = $ada_sfunction;
    $sfcn_base =~ s/(.+\\)*(\w+).ad[bs]/$2/;

    my $sfcn_dir = $ada_sfunction;
    $sfcn_dir =~ s/(.*)$sfcn_base\.ad[sb]/$1/;
    if ($sfcn_dir eq "") {
        $sfcn_dir = $cwd;
    } else {
        # strip trailing backslash:
        $sfcn_dir = substr($sfcn_dir, 0, length($sfcn_dir) - 1);
    }

    my $sfcn_ads = $sfcn_dir . "\\" . $sfcn_base . ".ads";
    my $sfcn_adb = $sfcn_dir . "\\" . $sfcn_base . ".adb";

    # get s-function name
    my $cmd= "$sl_ada_dir\\bin\\win32\\get_defines $ada_sfunction 0";
    my $sfcn_name = RunCmd($cmd);
    if ($? != 0) {
	print "$sfcn_name" unless $verbose;
	&expire("Error: Unable to determine S-Function name - $!");
    }
    chomp($sfcn_name);

    # get s-function defines
    $cmd= "$sl_ada_dir\\bin\\win32\\get_defines $ada_sfunction";
    my $sfcn_defs = RunCmd($cmd);
    if ($? != 0) {
	print "$sfcn_defs" unless $verbose;
	&expire("Error: Unable to determine S-Function methods - $!");
    }
    chomp($sfcn_defs);

    # Make sure that the GNAT Ada Compiler is available.
    my $gnat_check = `gnatdll -v`;
    if ($? != 0) {
	&expire("Error: Unable to find the GNAT Ada compiler.  To use mex to " .
		"build Ada S-function '$ada_sfunction', you need to have the " .
		"GNAT Ada compiler (version 3.12 or higher), correctly " .
		"installed and available on the path.");
    }

    # create obj dir, and cd to it.
    my $obj_dir = $cwd . "\\" . $sfcn_base . "_ada_sfcn_win32";
    if ( !(-e $obj_dir) ) {
	mkdir($obj_dir, 777);
	if ($? != 0) {
	    &expire("Error: Unable to create $obj_dir -> $!");
	}
    }
    chdir($obj_dir);
    if ($? != 0) {
	&expire("Error: Unable to cd to $obj_dir -> $!");
    }

    # compiler flags for gcc
    my $gcc_flags = "-Wall -malign-double";
    if ($debug eq "yes") {
	$gcc_flags = $gcc_flags . " -g";
    } else {
	$gcc_flags = $gcc_flags . " -O2";
    }

    # invoke gnatmake to compile the ada sources (creates .ali file)
    my $sfcn_ali = $sfcn_base . ".ali";
    my $cmd  = "gnatmake -q -c -aI$sl_ada_dir\\interface -aI$sfcn_dir " .
	       "$ada_include_dirs $sfcn_adb -cargs $gcc_flags";
    my $messages = RunCmd($cmd);
    if ($? != 0 || !(-e "$sfcn_ali" || $main::no_execute)) {
	print "$messages" unless $verbose;
	&expire("Error: Unable to compile $sfcn_adb -> $!");
    }

    # Compile the Ada S-Function's entry point
    my $sl_ada_entry = "$sl_ada_dir\\interface\\sl_ada_entry.c";
    my $cmd  = "gcc -I$sl_ada_dir\\interface -I$mlroot\\extern\\include " .
	       "-I$mlroot\\simulink\\include $gcc_flags -DMATLAB_MEX_FILE " .
	       "$sfcn_defs -c $sl_ada_entry";
    my $messages = RunCmd($cmd);
    if ($? != 0 || !(-e "sl_ada_entry.o" || $main::no_execute)) {
	print "$messages" unless $verbose;
	&expire("Error: Unable to compile $sl_ada_entry -> $!");
    }

    # Invoke gnatdll to build the dll (mex file)
    my $mex_file = $sfcn_name . ".dll";
    my $cmd = "gnatdll -q -n -e $sl_ada_dir\\interface\\mex.def " .
	      "-d $sfcn_name.dll $sfcn_ali sl_ada_entry.o " .
	      "-largs $sl_ada_dir\\lib\\\win32\\libmx.lib " .
	      "$sl_ada_dir\\lib\\win32\\libmex.lib";
    my $messages = RunCmd($cmd);
    if ( $? != 0 || !(-e "$mex_file" || $main::no_execute) ) {
	print "$messages" unless $verbose;
	&expire("Error: Unable to build mex-file $mex_file - $!");
    }
    # move it to the
    rename($mex_file, $cwd . "\\" . $mex_file);
    if ($? != 0) {
	print "$messages" unless $verbose;
	&expire("Error: Unable to move $mex_file to $cwd\\$mex_file - $!");
    }
    &expire("normally");
}


#######################################################################
# Expand possible wildcards in the arguments for perl >= 5.00503
#######################################################################
if ($] >= 5.00503) {
    my (@a) = map { /\*/ ? glob($_) : $_ } @ARGV;
    if ( "@a" ne "@ARGV" ) {
	#my ($n) = 0;
	#print join("\n\t", "Old arguments:",
	#	   map { $n++; "$n. $_" } @ARGV), "\n";
	#$n = 0;
	#print join("\n\t", "New arguments:",
	#	   map { $n++; "$n. $_" } @a), "\n";
	@ARGV = @a;
    }
}

#######################################################################
# Initialize variables
#######################################################################

# Correct how the $cmd_name variable looks so that it is presentable
# to DOS users (i.e., trade / with \).
($main::cmd_name = $0) =~ s/\//\\/g;
$main::cmd_name =~ tr/a-z/A-Z/;
($main::script_directory) = ($main::cmd_name =~ /(.*)\\.*/);

if ($main::script_directory) {
    ($main::script_directory) .= "\\mexopts";
} else {
    ($main::script_directory) = ".\\mexopts";
}

$| = 1;                         # Force immediate output flushing
open(STDERR,">&STDOUT");		# redirect stderr to stdout for matlab
select((select(STDERR), $|=1 )[0]);  # force immediate flushing for STDERR

$OPTFILE_NAME = "mexopts.bat";
$sourced_msg = 'none';
$mex_include_dir = "extern\\include";
$main::mbuild = "no";

# Trap case where an invalid options file is used, by checking the
# value of the compiler
$COMPILER = "none";

# $$ should be the pid, but this is not defined for Windows perl
# We'll use a random integer instead.  This is only an issue
# if you build more than one mex file in the same directory at
# the same time, and this way there's a pretty low chance of
# failure.
srand;
$$ = int(rand(10000));

#
# Ada S-Functions: mex [-v] [-g] [-aI<dir1>] ... [-aI<dirN>] -ada sfcn.ads
#
#
$ada_sfunction    = "";
$ada_include_dirs = "";

#######################################################################
# Parse input arguments & determine MEX-file name from 1st source file
#######################################################################

$lang = "c"; # Should always be one of {"c", "cpp", "fortran", "all", "ada"}
$link = "unspecified";
$ENV{'ENTRYPOINT'} = "mexFunction";

for (;$_=shift(@ARGV);) {
    # Perl-style case construct
    # print "DEBUG input argument is $_\n";
  ARGTYPE: {
      /^-argcheck$/ && do {
          $ARG_FLAGS = "$ARG_FLAGS -DARGCHECK";
          $argcheck = "yes";
          last ARGTYPE;
      };
      /^-c$/ && do {
          $compile_only = "yes";
          last ARGTYPE;
      };
      /^-D\S*$/ && do {
          if ($_ eq "-DV4_COMPAT") {
              &expire("Please use -V4 rather than directly passing in -DV4_COMPAT.");
          } elsif ($_ eq "-DARRAY_ACCESS_INLINING") {
              &expire("Please use -inline rather than directly passing in -DARRAY_ACCESS_INLINING.");
          } else {
              $_ =~ s/[=\#]/=/;
              $ARG_FLAGS = "$ARG_FLAGS $_";
              last ARGTYPE;
          }
      };
      /^-U\S*$/ && do {
          $ARG_FLAGS = "$ARG_FLAGS $_";
          last ARGTYPE;
      };
      /^-I.*$/ && do {
          $ARG_FLAGS .= " " . &smart_quote($_);
          last ARGTYPE;
      };
      /^-f$/ && do {
          $filename = shift(@ARGV);
          if (-e $filename) {
              $OPTFILE_NAME =  "$filename";
          } elsif (-e "$main::script_directory\\$filename") {
              $OPTFILE_NAME = "$main::script_directory\\$filename";
          }
          else {
              &expire("Error: Could not find specified options file\n    '$filename'.");
          }
          $sourced_msg = '-> Options file specified on command line';
          last ARGTYPE;
      };
      /^-g$/ && do {
          $debug = "yes";
          last ARGTYPE;
      };
      /^[-\/](h(elp)?)|\?$/ && do {
	  if ($main::mbuild eq "no") {
	      &describe("help");
	  } else {
	      &describe_mb("help");
	  }
	  # &describe("help");
          &expire("normally");
          last ARGTYPE;
      };
      /^-inline$/ && do {
          $inline = "yes";
          last ARGTYPE;
      };

      /^-k$/ && do { # This is an undocumented feature which is subject to change
          $makefilename = shift(@ARGV);
          last ARGTYPE;
      };

      /^-lang$/ && ($main::mbuild eq "yes") && do {
          $lang_override = shift(@ARGV);
          if (!($lang_override =~ /(cpp|c)/)) { &describe_mb("bad_lang_option"); }

          last ARGTYPE;
      };

      /^-link$/ && ($main::mbuild eq "yes") && do {
          # This is an undocumented feature which is subject to change
          $link = shift(@ARGV);

          if (!($link =~ /^(shared|exe)$/)) { &describe_mb("bad_link_option"); }

          last ARGTYPE;
      };

      /^-setup$/ && do {
          $setup = "yes";
          last ARGTYPE;
      };
      /^-called_from_matlab$/ && do {
          $called_from_matlab = "yes";
          last ARGTYPE;
      };
      /^-output$/ && do {
          $output_flag = "yes";
          $ENV{'MEX_NAME'}=shift(@ARGV);
          last ARGTYPE;
      };
      /^-O$/ && do {
          $optimize = "yes";
          last ARGTYPE;
      };
      /^-outdir$/ && do {
          $outdir_flag = "yes";
          my $outdir = shift(@ARGV) . "\\";
          $outdir =~ s/\//\\/g;
          $ENV{'OUTDIR'} = $outdir;
          last ARGTYPE;
      };
      /^-v$/ && do {
	  if ($main::mbuild eq "no") {
	      &describe("general_info");
	  } else {
	      &describe_mb("general_info");
	  }
	  #  &describe("general_info");
          $verbose = "yes";
          last ARGTYPE;
      };
      /^-V4$/ && do {
          $v4 = "yes";
          $ARG_FLAGS = "$ARG_FLAGS -DV4_COMPAT";
          last ARGTYPE;
      };
      /^-matlab$/ && do {
          $matlab = shift(@ARGV);
          $matlab =~ tr/"//d;
          $ENV{'MATLAB'} = $matlab;
          last ARGTYPE;