#! /usr/bin/perl -w

# GDC -- D front-end for GCC
# Copyright (C) 2004 David Friedman
#
# 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

# This is a wrapper script for gdc that emulates the dmd command.
# Unknown options are passed on to gdc.  The two extra options are:
#
# -vdmd                         Print commands executed by this wrapper script
# -q<arg1>[,<arg2>,<arg3>,...]  Pass the comma-separated arguments to gdc


use strict;
use File::Basename;
use File::Spec;

my $output_directory;
my $output_parents;
my $output_file;
my $link = 1;
my $show_commands = 0;
my $seen_all_sources_flag = 0;
my $first_input_file;

my @sources;
my @objects;

my @out;

sub osHasEXE() {
    return $^O =~ m/MS(DOS|Win32)|os2/i; # taken from File::Basename
}

sub pathSep() {
    return ";" if $^O =~ m/MS(DOS|Win32)/i;
    return "," if $^O =~ m/MacOS/i;
    return ":";
}

sub expandHome($) {
    my ($path) = (@_);
    if ( $^O !~ m/MS(DOS|Win32)|MacOS/i ) {
	$path =~ s/^~/$ENV{HOME}/;
    }
    return $path;
}

sub errorExit(@) {
    print STDERR "dmd: ", @_, "\n" if @_;
    exit 1;
}
use subs qw(errorExit);

my $gcc_version = `gdc -dumpversion`;
chomp $gcc_version;
$gcc_version =~ m/^(\d+)\.(\d+)/;
my ($gcc_maj, $gcc_min) = ( $1, $2 );

my $target_machine = `gdc -dumpmachine`;
chomp $target_machine;

foreach my $arg (@ARGV) {
    if ($arg =~ m/^-c$/ ) {
	$link = 0;
    } elsif ( $arg =~ m/^-d$/ ) {
	push @out, '-fdeprecated';
    } elsif ( $arg =~ m/^-debug(?:=(.*))?$/ ) {
	push @out, (defined($1) ? "-fdebug=$1" : '-fdebug');
    } elsif ( $arg =~ m/^-debug.*$/ ) {
	# Passing this to gdc only gives warnings; exit with an error here
	errorExit "unrecognized switch '$arg'";
    } elsif ( $arg =~ m/^-gt$/ ) {
	# there is more to profiling than this ... -finstrument-functions?
	push @out, '-pg';
    } elsif ( $arg =~ m/^-inline$/ ) {
	push @out, '-finline-functions';
    } elsif ( $arg =~ m/^-I(.*)$/ ) {
	foreach my $i (split pathSep, $1) {
	    push @out, '-I', expandHome $i;
	}
    } elsif ( $arg =~ m/^-L(.*)$/ ) {
	push @out, '-L', $1; # TODO: expand '~'
    } elsif ( $arg =~ m/^-O$/ ) {
	push @out, '-O2', '-frename-registers', '-fomit-frame-pointer';
	if ( $gcc_maj > 3 || ( $gcc_maj == 3 && $gcc_min >= 4 ) ) {
	    push @out, '-fweb';
	}
    } elsif ( $arg =~ m/^-od(.*)$/ ) {
	$output_directory = $1;
    } elsif ( $arg =~ m/^-of(.*)$/ ) {
	$output_file = $1;
    } elsif ( $arg =~ m/^-op$/ ) {
	$output_parents = 1;
    } elsif ( $arg =~ m/^-release$/ ) {
	push @out, '-frelease';
    } elsif ( $arg =~ m/^-unittest$/ ) {
	push @out, '-funittest';
    } elsif ( $arg =~ m/^-v$/ ) {
	push @out, '-v'; # not really equivalent
    } elsif ( $arg =~ m/^-version=(.*)$/ ) {
	push @out, "-fversion=$1";
    } elsif ( $arg =~ m/^-version.*$/ ) {
	errorExit "unrecognized switch '$arg'";
    } elsif ( $arg =~ m/^-vdmd$/ ) {
	$show_commands = 1;
    } elsif ( $arg =~ m/^-q(.*)$/ ) {
	push @out, split(qr/,/, $1);
    } elsif ( $arg eq '-fall-sources' ) {
	$seen_all_sources_flag = 1;
	# push @out, $arg;
    } elsif ( $arg =~ m/^-.+$/ ) {
	push @out, $arg;
    } elsif ( $arg =~ m/^.+\.d$/i ||
	      $arg =~ m/^.+\.html$/i) {
	$first_input_file = $arg if ! $first_input_file;
	push @sources, $arg;
    } elsif ( $arg !~ m/\./ ) {
	$arg = $arg . ".d";
	$first_input_file = $arg if ! $first_input_file;
	push @sources, $arg;
    } elsif ( $arg =~ m/^(.+)(\.exe)$/i ) {
	$first_input_file = $arg if ! $first_input_file;
	$output_file = $1;
	if ( osHasEXE() ) {
	    $output_file .= $2;
	}
    } else {
	push @objects, $arg
    }

}

# Slightly different from dmd... allows -of to specify
# the name of the executable.
if ( ! $link && scalar(@sources) > 1 && $output_file ) {
    errorExit "object file name specified with multiple source files";
}

if ( $link && ! $output_file && $first_input_file ) {
    $output_file = fileparse( $first_input_file, qr/\..*$/ );
    if ( osHasEXE() ) {
	$output_file .= '.exe';
    }
}

if (! scalar(@sources) && ! ($link && scalar(@objects))) {
    errorExit "no input files";
}

my $ok = 1;

foreach my $srcf_i (@sources) {
    # Step 1: Determine the object file path
    my $outf;
    my $srcf = $srcf_i; # To avoid modifying elements of @sources
    my @outbits;

    if ( ! $link && $output_file ) {
	$outf = $output_file;
    } else {
	if ( $output_directory ) {
	    push @outbits, $output_directory;
	    #$outf = $output_directory;
	    #$outf .= '/';
	}
	if ( $output_parents ) {
	    #my $dir = dirname( $srcf ); # should be '.' for no directory spec, but...
	    #$outf .= (dirname( $srcf ) . '/') if $dir;
	    push @outbits, dirname( $srcf );
	}
	push @outbits, basename( $srcf, '.d' ) . '.o';
	# $outf .= basename( $srcf, '.d' ) . '.o';
	$outf = File::Spec->catfile( @outbits );
    }
    push @objects, $outf;

    my @all_sources_hack;
    if ( $seen_all_sources_flag ) {
	@all_sources_hack = (@sources);
	$srcf = "-fonly=$srcf";
    }

    # Step 2: Run the program
    my @cmd = ('gdc', @out, '-c', @all_sources_hack, $srcf, '-o', $outf );
    if ( $show_commands ) {
	print join(' ', @cmd), "\n";
    }
    my $result = system(@cmd);
    errorExit if $result & 0xff; # Give up if can't exec or gdc exited with a signal
    $ok = $ok && $result == 0;
}

if ($ok && $link) {
    my @cmd = ('gdc', @out, @objects);
    if ( $output_file ) {
	push @cmd, '-o', $output_file;
    }
    if ( $show_commands ) {
	print join(' ', @cmd), "\n";
    }
    $ok = $ok && system(@cmd) == 0;
}

exit ($ok ? 0 : 1);


