source: trunk/third/perl/cygwin32/perlld @ 10724

#
# Perl script be a wrapper around the gnu ld. When a dll is specified to
#   to be built, special processing is done, else the standard ld is called.
#
#  Modified 3/14/97 to include the impure_ptr setup routine in init.cc
#  Modified to make dll in current directory then copy to another dir if
#     a path name specified on the command name with the -o parm.
#

my $args = join(" ",@ARGV); # get args
my $arg;

my @objs;
my @flags;
my $libname;
my $init = "init";
my $fixup = "fixup";

my $path;


sub writefixup;
sub writeInit;

if( $args=~/\-o (.+?)\.dll/i){
        $libname = $1;
        # print "libname = <$libname>\n";
        # Check for path:
        if( $libname =~ /($\.+?\/)(\w+$)/){
                $path = $1;
                $libname = $2;
                # print "<$path> <$libname>\n";
        }
        
        foreach $arg(@ARGV){
                if( $arg=~/\.[oa]$/){
                        push @objs,$arg;
                        next;
                }
                if( $arg =~/\-o/ or $arg =~ /.+?\.dll/i ){
                        next;
                }
                push @flags,$arg;
        }

        writefixup();
        writeInit();
        $command = "gcc -c $fixup.c\n";
        print $command;
        system($command);
        $command = "gcc -c $init.cc\n";
        print $command; 
        system($command);
        
        $command = "echo EXPORTS > $libname.def\n";
        print $command; 
        system($command);
        $command = "nm ".join(" ",@objs)."  $init.o $fixup.o | grep '^........ [TCD] _' | sed 's/[^_]*_//' >> $libname.def\n";
        print $command; 
        system($command);

        $command = "ld --base-file $libname.base --dll -o $libname.dll ".join(" ",@objs)."  $init.o $fixup.o ";
        $command .= join(" ",@flags)." -e _dll_entry\@12 \n";
        print $command; 
        system($command);

        $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n";
        print $command; 
        system($command);
        
        $command = "ld --base-file $libname.base $libname.exp --dll -o $libname.dll ".join(" ",@objs)."   $init.o $fixup.o ";
        $command .= join(" ",@flags)." -e _dll_entry\@12 \n";
        print $command; 
        system($command);

        $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n";
        print $command; 
        system($command);                       

        $command = "ld $libname.exp --dll -o $libname.dll ".join(" ",@objs)."   $init.o $fixup.o ";
        $command .= join(" ",@flags)." -e _dll_entry\@12 \n";
        print $command; 
        system($command);

        print "Build the import lib\n";
        $command = "dlltool --as=as --dllname $libname.dll --def $libname.def --output-lib $libname.a\n";
        print $command; 
        system($command);

        # if there was originally a path, copy the dll and a to that location:
        if($path && $path ne "./" && $path."\n" ne  "`pwd`"){
                $command = "mv $libname.dll $path".$libname.".dll\n";
                print $command; 
                system($command);
                $command = "mv $libname.a $path".$libname.".a\n";
                print $command; 
                system($command);
                
        }

}
else{  # no special processing, just call ld
        $command = "ld $args\n";
        print $command; 
        system($command);
}

#---------------------------------------------------------------------------
sub writeInit{

open(OUTFILE,">$init.cc") or die("Can't open $init.cc\n");

print OUTFILE <<'EOF';
/* init.cc for WIN32.

   Copyright 1996 Cygnus Solutions

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */

// Added impure_ptr initialization routine. This is needed for any DLL that needs
//   to output to the main (calling) executable's stdout, stderr, etc. This routine
//   needs to be called from the executable using the DLL before any other DLL 
//   routines are called.  jc 3/14/97

#include <windows.h> 

extern "C" 
{
  int WINAPI dll_entry (HANDLE h, DWORD reason, void *ptr);
  void impure_setup(struct _reent *_impure_ptrMain);
};

struct _reent *_impure_ptr;  // this will be the Dlls local copy of impure ptr

int WINAPI dll_entry (HANDLE , 
                     DWORD reason,
                     void *)
{
  switch (reason) 
    {
    case DLL_PROCESS_ATTACH:
      break;
    case DLL_PROCESS_DETACH:
      break;
    case DLL_THREAD_ATTACH:
      break;
    case DLL_THREAD_DETACH:
      break;
    }
  return 1;
}


//********************************************
// Function to set our local (in this dll) copy of impure_ptr to the
// main's (calling executable's) impure_ptr
void impure_setup(struct _reent *_impure_ptrMain){

        _impure_ptr = _impure_ptrMain;

}
EOF

close OUTFILE;

}

#---------------------------------------------------------------------------
sub writefixup{

open(OUTFILE,">$fixup.c") or die("Can't open $fixup.c\n");

print OUTFILE <<'EOF';
/* This is needed to terminate the list of inport stuff */
/* Copied from winsup/dcrt0.cc in the cygwin32 source distribution. */
        asm(".section .idata$3\n" ".long 0,0,0,0, 0,0,0,0");

EOF
close OUTFILE;
}