#!/local/bin/perl

# This perl script chooses which .o files should be grouped into
# shared libraries.  It tries to group all files pertaining to IntImages
# and IntSets into one library, FloatImages and FloatSets in another,
# etc.

# The heuristic is very fragile.  If the name mangling scheme changes
# or if something else changes, this will probably break.


sub whichlib {
    local($_) = @_;
    local ($blah) = "(17IA_Point__pt__2_i(|T1PC)|Set__pt__\\d+_|IA_SetStructurePPC)";
    if (/${blah}6IA_Bit/o) {
	return 1;
    } elsif (/${blah}Uc/o) {
	return 2;
    } elsif (/${blah}i/o) {
	return 3;
    } elsif (/${blah}6IA_RGB/o) {
	return 4;
    } elsif (/${blah}f/o) {
	return 5;
    } elsif (/${blah}7complex/o) {
	return 6;
    } elsif (/IA_Point__pt__2_df/o) {
	return 7;
    } else {
	return 0;
    }
}

sub demangle {
    local($_)=@_;

    pipe(TOFILTR, TOFILTW);
    pipe(FROMFILTR, FROMFILTW);

    $childpid=fork;
    if ($childpid<0) {
	die "$0: unable to fork";
    } elsif ($childpid) {
	# parent
	close(TOFILTR);
	close(FROMFILTW);
	print TOFILTW $_, "\n";
	close (TOFILTW);
	$_ = <FROMFILTR>;
	chop;
	close(FROMFILTR);
	waitpid($childpid, 0);
    } else {
	close(TOFILTW);
	close(FROMFILTR);
	open(STDIN, ">&TOFILTR") || die "can't redirect stdin";
	open(STDOUT, ">&FROMFILTW") || die "can't redirect stdout";
	close(TOFILTR);
	close(FROMFILTW);
	exec("c++filt");
	die "couldn't exec c++filt";
    }
    return $_;
}

sub remangle {
    local ($_) = @_;
    return $_ unless defined($remangling);

    return $_ unless /^\d+$/;

    $_ = $REMANGLING[$_];
    chop;
    s/\.o//;

    return $_;
}

if (!@ARGV) {
    print <<EOF
Usage:
  $0 library.a [ ar-remangling ]
EOF
    ;
    exit 1;
}

$libfile = shift;
if (@ARGV) {
    $remangling = shift;
    open(FILE, "<$remangling") || die "unable to open $remangling for read";
    @REMANGLING=<FILE>;
    close(FILE);
}

open(PIPE, "ar t $libfile|") || die;
#open(PIPE, "<crap") || die;

while ($_=<PIPE>) {
    chop;
    next unless s/\.o//;
    $which = &whichlib(&remangle($_));
#    print $which, " : ", $_, "\n";
    if ("" ne $DEST[$which]) {
	$DEST[$which] .= "\0";
    }
    $DEST[$which] .= $_.".o";
}
close(PIPE);

$i=0;
foreach (@DEST) {
    local (@_) = split("\0", $_);
    local ($_);
    print("Archive $i: ", int(@_) , " objects\n");
    foreach (@_) {
	print $_, "\n";
    }
    {
	local($so) = "libiac++".$i.".so.1.1";
	$|=1;
	print "building $so ...";
	local ($childpid)=fork;
	if (!$childpid) {
	    exec ("ld", "-o", $so,
		  "-assert", "pure-text", @_);
	    die "unable to exec ld";
	} else {
	    waitpid($childpid, 0);
	}
	print " built\n";
	$|=0;
    }
    print "\n\n";

    $i++;
}
