#!/usr/bin/perl
#-------------------------------------------------------------------------------
# unicc_wat.pl
#
# Copyright (C) 2006-2008 Oliver Hamann.
#
# Homepage: http://eaglemode.sourceforge.net/
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU General Public License version 3 as published by the
# Free Software Foundation.
#
# 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 version 3 for
# more details.
#
# You should have received a copy of the GNU General Public License version 3
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#-------------------------------------------------------------------------------

use strict;
use warnings;
use File::Basename;
use File::Spec::Functions;
use File::stat;


#=============================== Parse arguments ===============================

my $Type="cexe";
my $Name="unnamed";
my $ObjDir=".";
my $BinDir=".";
my $LibDir=".";
my @LibSearchDirs=();
my @IncSearchDirs=();
my @Links=();
my $Math=0;
my $Rtti=0;
my $Exceptions=0;
my $Debug=0;
my @Defs=();
my @Srcs=();

for (my $i=0; $i<@ARGV; $i++) {
	if ($ARGV[$i] eq "--type" and $i+1<@ARGV) {
		$Type=$ARGV[++$i];
	}
	elsif ($ARGV[$i] eq "--name" and $i+1<@ARGV) {
		$Name=$ARGV[++$i];
	}
	elsif ($ARGV[$i] eq "--obj-dir" and $i+1<@ARGV) {
		$ObjDir=$ARGV[++$i];
	}
	elsif ($ARGV[$i] eq "--bin-dir" and $i+1<@ARGV) {
		$BinDir=$ARGV[++$i];
	}
	elsif ($ARGV[$i] eq "--lib-dir" and $i+1<@ARGV) {
		$LibDir=$ARGV[++$i];
		push(@LibSearchDirs,$LibDir);
	}
	elsif ($ARGV[$i] eq "--lib-search-dir" and $i+1<@ARGV) {
		push(@LibSearchDirs,$ARGV[++$i]);
	}
	elsif ($ARGV[$i] eq "--inc-search-dir" and $i+1<@ARGV) {
		push(@IncSearchDirs,$ARGV[++$i]);
	}
	elsif ($ARGV[$i] eq "--link" and $i+1<@ARGV) {
		push(@Links,$ARGV[++$i]);
	}
	elsif ($ARGV[$i] eq "--math") {
		$Math=1;
	}
	elsif ($ARGV[$i] eq "--rtti") {
		$Rtti=1;
	}
	elsif ($ARGV[$i] eq "--exceptions") {
		$Exceptions=1;
	}
	elsif ($ARGV[$i] eq "--debug") {
		$Debug=1;
	}
	elsif ($ARGV[$i] eq "--def" and $i+1<@ARGV) {
		push(@Defs,$ARGV[++$i]);
	}
	elsif ($ARGV[$i]=~/^--/) {
		die("Unknown option '$ARGV[$i]', stopped");
	}
	else {
		push(@Srcs,$ARGV[$i]);
	}
}

if (@Srcs <= 0) {
	die("No source files, stopped");
}


#====================== Translate '/' to '\' in all paths ======================

$ObjDir=~tr/\//\\/;
$BinDir=~tr/\//\\/;
$LibDir=~tr/\//\\/;
for (my $i=0; $i<@LibSearchDirs; $i++) { $LibSearchDirs[$i]=~tr/\//\\/; }
for (my $i=0; $i<@IncSearchDirs; $i++) { $IncSearchDirs[$i]=~tr/\//\\/; }
for (my $i=0; $i<@Srcs; $i++) { $Srcs[$i]=~tr/\//\\/; }


#================= Have paths of output files and other infos ==================

my @CSuffixes;
my @CppSuffixes;
my @Objs=();
my @IsCpp=();
my $AnyCpp;
my $Output;
my $ExportsFile;
my $ImportLib;

@CSuffixes=(".c", ".C");
@CppSuffixes=(".cpp", ".cxx", ".cc");
$AnyCpp=0;
for (my $i=0; $i<@Srcs; $i++) {
	my ($f,$d,$s)=fileparse($Srcs[$i],@CSuffixes);
	if ($s eq "") {
		($f,$d,$s)=fileparse($Srcs[$i],@CppSuffixes);
		if ($s eq "") {
			die("Source file '$Srcs[$i]' has illegal suffix, stopped");
		}
		push(@IsCpp,1);
		$AnyCpp=1;
	}
	else {
		push(@IsCpp,0);
	}
	push(@Objs,catfile($ObjDir,"$f.obj"));
}

if ($Type eq "cexe" or $Type eq "wexe") {
	$Output=catfile($BinDir,"$Name.exe");
}
elsif ($Type eq "lib") {
	$Output=catfile($LibDir,"$Name.lib");
}
elsif ($Type eq "dynlib") {
	$Output=catfile($LibDir,"$Name.dll");
	$ExportsFile=catfile($ObjDir,"$Name.lk");
	$ImportLib=catfile($LibDir,"$Name.lib");
}
else {
	die("Illegal type of output: '$Type', stopped");
}


#==================== GetDirectIncludes & GetSrcUpdateTime =====================

my %DirectIncludesCache;
my %SrcUpdateTimeCache;

sub GetDirectIncludes
{
	my $srcFile=shift;
	my @result;
	my $fh;

	if (exists $DirectIncludesCache{$srcFile}) {
		return @{$DirectIncludesCache{$srcFile}};
	}
	@result=();
	open($fh,$srcFile);
	while (defined(my $s=readline($fh))) {
		if (index($s,"#")<0) { next; }
		while (ord($s)<=32) { $s=substr($s,1); }
		if (substr($s,0,1) ne "#") { next; }
		$s=substr($s,1);
		while (ord($s)<=32) { $s=substr($s,1); }
		if (substr($s,0,7) ne "include") { next; }
		$s=substr($s,7);
		while (ord($s)<=32) { $s=substr($s,1); }
		my $e;
		if (substr($s,0,1) eq "<") { $e=">"; }
		elsif (substr($s,0,1) eq "\"") { $e="\""; }
		else { next; }
		my $i=index($s,$e,2);
		if ($i<2) { next; }
		$s=substr($s,1,$i-1);
		my @dirs=@IncSearchDirs;
		if ($e eq "\"") {
			my ($f,$d)=fileparse($s);
			@dirs=($d,@dirs);
		}
		for (my $i=0; $i<@dirs; $i++) {
			my $p=catfile($dirs[$i],$s);
			if (! -f $p) { next; }
			push(@result,$p);
			last;
		}
	}
	close($fh);
	$DirectIncludesCache{$srcFile}=[@result];
	return @result;
}

sub GetSrcUpdateTime
{
	my $srcFile=shift;
	my $r;

	$r=$SrcUpdateTimeCache{$srcFile};
	if (defined($r)) {
		if ($r!=-1) { return $r; }
		my @a=($srcFile);
		for (my $i=0; $i<@a; $i++) {
			my $s=stat($a[$i]);
			if ($i==0 or $r<$s->mtime) { $r=$s->mtime; }
			my @d=GetDirectIncludes($a[$i]);
			for (my $j=0; $j<@d; $j++) {
				my $k;
				for ($k=0; $k<@a; $k++) {
					if ($d[$j] eq $a[$k]) { last; }
				}
				if ($k>=@a) { push(@a,$d[$j]); }
			}
		}
	}
	else {
		$SrcUpdateTimeCache{$srcFile}=-1;
		my $s=stat($srcFile);
		$r=$s->mtime;
		my @d=GetDirectIncludes($srcFile);
		for (my $i=0; $i<@d; $i++) {
			my $t=GetSrcUpdateTime($d[$i]);
			if ($r<$t) { $r=$t }
		}
	}
	$SrcUpdateTimeCache{$srcFile}=$r;
	return $r;
}


#==================== Compile source files to object files =====================

for (my $i=0; $i<@Srcs; $i++) {
	if (-f $Objs[$i]) {
		my $s=stat($Objs[$i]);
		if ($s->mtime>=GetSrcUpdateTime($Srcs[$i])) { next; }
	}
	my @args=();
	push(@args,"wcl386");
	push(@args,"-zq");
	push(@args,"-fr");
	push(@args,"-bt=nt");
	if ($Type eq "cexe") { push(@args,"-bc"); }
	if ($Type eq "wexe") { push(@args,"-bg"); }
	if ($Type eq "dynlib") { push(@args,"-bd"); }
	push(@args,"-br");
	push(@args,"-mf");
	push(@args,"-6r");
	push(@args,"-otexan");
	if ($Debug) { push(@args,"-d2"); }
	if ($IsCpp[$i]) {
		if ($Rtti) { push(@args,"-xr"); }
		if ($Exceptions) { push(@args,"-xs"); }
	}
	push(@args,"-e4");
	push(@args,"-wx");
	push(@args,"-wcd=549");
	push(@args,"-wcd=594");
	push(@args,"-wcd=604");
	push(@args,"-wcd=656");
	push(@args,"-wcd=657");
	push(@args,"-wcd=726");
	for (my $j=0; $j<@IncSearchDirs; $j++) {
		push(@args,"-i=$IncSearchDirs[$j]");
	}
	for (my $j=0; $j<@Defs; $j++) {
		push(@args,"-d$Defs[$j]");
	}
	push(@args,"-c");
	push(@args,$Srcs[$i]);
	push(@args,"-fo=$Objs[$i]");
	print("@args\n");
	if (system(@args)!=0) { exit(1); }
}


#=========================== Output file up-to-date? ===========================

if (-e $Output) {
	my $t=0;
	for (my $i=0; $i<@Objs; $i++) {
		my $s=stat($Objs[$i]);
		if ($t<$s->mtime) { $t=$s->mtime; }
	}
	for (my $i=0; $i<@Links; $i++) {
		for (my $j=0; $j<@LibSearchDirs; $j++) {
			my $p;
			$p=catfile($LibSearchDirs[$j],"$Links[$i].lib");
			if (-e $p) {
				my $s=stat($p);
				if ($t<$s->mtime) { $t=$s->mtime; }
			}
		}
	}
	my $s=stat($Output);
	if ($s->mtime>=$t) { exit(0); }
}


#============================ Produce exports file =============================

if ($Type eq "dynlib") {
	print("Creating Exports-File: $ExportsFile\n");
	my $dfh;
	open($dfh,">",$ExportsFile);
	my %exports;
	my $n=0;
	for (my $i=0; $i<@Objs; $i++) {
		my @dump=`wdis /a $Objs[$i]`;
		if ($? != 0) { exit(1); }
		for (my $j=0; $j<@dump; $j++) {
			my $str=$dump[$j];
			my $k=index($str,"PUBLIC");
			if ($k<0) { next; }
			while (ord($str)<=32) { $str=substr($str,1); }
			if (index($str,"PUBLIC")!=0) { next; }
			$str=substr($str,6);
			while (ord($str)<=32) { $str=substr($str,1); }
			my $str2;
			if (substr($str,0,1) eq "`") {
				$str=substr($str,1);
				$k=0;
				while ($k<length($str) and substr($str,$k,1) ne "`") { $k++; }
				$str=substr($str,0,$k);
				if (index($str,"(")<0) { next; }
				if (index($str,")")<0) { next; }
				$str2=$str;
			}
			else {
				while ($k<length($str) and ord(substr($str,$k,1))>32) { $k++; }
				$str=substr($str,0,$k);
				if (substr($str,length($str)-1,1) eq "_") { $str2=substr($str,0,length($str)-1); }
				else { $str2=$str; }
			}
			if (exists $exports{$str}) { next; }
			$exports{$str}=1;
			$n++;
			print($dfh "EXP '$str'.$n\n");
			if ($str2 ne $str) {
				$n++;
				print($dfh "EXP '$str2'.$n='$str'\n");
			}
		}
	}
	close($dfh);
}


#============================= Produce output file =============================

# Delete old output file.
if (-e $Output) { unlink($Output); }

# Create new one.
if ($Type eq "cexe" or $Type eq "wexe" or $Type eq "dynlib") {
	my @args=();
	push(@args,"wlink");
	push(@args,"OP"); push(@args,"Q");
	if ($Debug) {
		push(@args,"DEBUG"); push(@args,"all");
	}
	push(@args,"OP"); push(@args,"ST=2048576"); #??? stack size
	for (my $i=0; $i<@LibSearchDirs; $i++) {
		push(@args,"LIBP"); push(@args,$LibSearchDirs[$i]);
	}
	for (my $i=0; $i<@Links; $i++) {
		push(@args,"L"); push(@args,$Links[$i]);
	}
	for (my $i=0; $i<@Objs; $i++) {
		push(@args,"F"); push(@args,$Objs[$i]);
	}
	push(@args,"N"); push(@args,$Output);
	if ($Type eq "cexe") {
		push(@args,"SYS"); push(@args,"nt");
	}
	elsif ($Type eq "wexe") {
		push(@args,"SYS"); push(@args,"nt_win");
	}
	else {
		push(@args,"SYS"); push(@args,"nt_dll");
		push(@args,"\@$ExportsFile");
		push(@args,"OP"); push(@args,"IMPLIB=$ImportLib");
	}
	print("@args\n");
	if (system(@args)!=0) { exit(1); }
}
elsif ($Type eq "lib") {
	my @args=();
	push(@args,"wlib");
	push(@args,"-b");
	push(@args,"-c");
	push(@args,"-n");
	push(@args,"-q");
	push(@args,"-p512");
	push(@args,"$Output");
	for (my $i=0; $i<@Objs; $i++) {
		push(@args,"+$Objs[$i]");
	}
	print("@args\n");
	if (system(@args)!=0) { exit(1); }
}
else {
	die("Illegal type of output: '$Type', stopped");
}
