Separated the [:foo:] parsing to its own function.

[perl5.git] / cygwin32 / perlld

#
# 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) == 0 or die "system() failed.\n";
	$command = "gcc -c $init.cc\n";
	print $command;	
	system($command) == 0 or die "system() failed.\n";
	
	$command = "echo EXPORTS > $libname.def\n";
	print $command;	
	system($command) == 0 or die "system() failed.\n";
	$command = "nm ".join(" ",@objs)."  $init.o $fixup.o | grep '^........ [TCD] _' | sed 's/[^_]*_//' >> $libname.def\n";
	print $command;	
	system($command) == 0 or die "system() failed.\n";

	$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) == 0 or die "system() failed.\n";

	$command = "dlltool --as=as --dllname $libname.dll --def $libname.def --base-file $libname.base --output-exp $libname.exp\n";
	print $command;	
	system($command) == 0 or die "system() failed.\n";
	
	$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) == 0 or die "system() failed.\n";

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

	$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) == 0 or die "system() failed.\n";

	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) == 0 or die "system() failed.\n";

	# 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) == 0 or die "system() failed.\n";
		$command = "mv $libname.a $path".$libname.".a\n";
		print $command;	
		system($command) == 0 or die "system() failed.\n";
		
	}

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

#---------------------------------------------------------------------------
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;
}