#  Copyright (c) 1997-2010
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Darmstadt, Germany)
#  http://www.polymake.de
#
#  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, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  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.
#-------------------------------------------------------------------------------
# $Project: polymake $$Id: CPlusPlus_config.pm 9931 2010-11-19 19:58:46Z gawrilow $

use namespaces;

package Polymake::Core::CPlusPlus;

sub study_name_mangling {
   my $custom_handler=shift;
   local $_;

   $nm_util ||= "nm -g";
   $cppfilt_util ||= $^O =~ /bsd/i ? "/usr/local/bin/c++filt" : "c++filt";
   @to_mangled_defconstr=();  @to_mangled_typeinfo=();

   my $file=new Tempfile;
   open my $cc, ">$file.cc";
   print $cc <<'.';
#include <iostream>
#include <typeinfo>
class PolymakeTestGlob { public: PolymakeTestGlob(); };
PolymakeTestGlob::PolymakeTestGlob() {}
namespace nam {
class PolymakeTestNam { public: PolymakeTestNam(); };
PolymakeTestNam::PolymakeTestNam() {}
}
template <typename T> class PolymakeTestWrap { public: PolymakeTestWrap(); };
template <typename T> PolymakeTestWrap<T>::PolymakeTestWrap() {}
int main()
{
   PolymakeTestGlob t; nam::PolymakeTestNam tn; PolymakeTestWrap<PolymakeTestGlob> tw;
   std::cout << typeid(t).name() << ' ' << typeid(tn).name() << ' ' << typeid(tw).name();
   return 0;
}
.
   close $cc;

   my ($CXX, $CXXFLAGS, $LDFLAGS);
   open my $mf, "$InstallArch/conf.make"
      or die "Configuration file $InstallArch/conf.make not found\n";
   while (<$mf>) {
      if (/^CXX\s*:?=\s*(.*)/) {
         $CXX=$1;
      } elsif (/^CXXflags\s*(\+)?:?=\s*(.*)/) {
         if ($1) {
            $CXXFLAGS.=" $2";
         } else {
            $CXXFLAGS=$2;
         }
      } elsif (/^LDflags\s*(\+)?:?=\s*(.*)/) {
         if ($1) {
            $LDFLAGS.=" $2";
         } else {
            $LDFLAGS=$2;
         }
      }
   }
   close $mf;

   my $rc=system(($DebugLevel ? "echo Compiling test program:; cat $file.cc; " : "") .
		 "$CXX -o $file.exe $CXXFLAGS $file.cc $LDFLAGS 2>$file.err");
   if ($rc) {
      die "test program compilation failed; see the error log below\n\n", `cat $file.err`;
   }
   my @typenames=split /\s+/, `$file.exe`;
   if ($?) {
      die "test program terminated with error $?\n";
   }
   dbg_print( "test program emitted typenames: @typenames\n" ) if $DebugLevel;
   open my $nm, "$nm_util $file.exe |" or die "can't run nm utility: $!\n";
   my (%mangled_defc, %mangled_ti);
   while (<$nm>) {
      if (my ($symbol, $mangled)=/\s([TWV])\s+(\S*PolymakeTest\S*)/) {
         my $case= $mangled =~ /TestWrap/ ? 3 : $mangled =~ /TestNam/ ? 2 : $mangled =~ /TestGlob/ ? 1 : 0;
         next if $symbol eq "V" ? exists $mangled_ti{$case} : exists $mangled_defc{$case};
	 dbg_print( "nm extracted global name $mangled" ) if $DebugLevel;

	 open my $cf, "$cppfilt_util $mangled |" or die "can't run c++filt utility: $!\n";
	 my $demangled=<$cf>; chomp $demangled;
	 close $cf;
	 if ($demangled eq $mangled && substr($mangled,0,1) eq "_") {
	    $mangled=substr($mangled,1);
	    open $cf, "$cppfilt_util $mangled |" or die "can't run c++filt utility: $!\n";
	    $demangled=<$cf>; chomp $demangled;
	    close $cf;
            if ($demangled ne $mangled) {
               $cppfilt_util="$cppfilt_util --strip-underscores";
            }
	 }
	 if ($demangled eq $mangled) {
	    die <<"."
c++filt can't parse the output from nm.
Possible reason is the incompatibility between both utilities and/or $CXX.
Please investigate the problem and set the custom variables
\$Polymake::Core::CPlusPlus::nm_util  and  \$Polymake::Core::CPlusPlus::cppfilt_util
to proper utility paths and optional flags if necessary
.
	 }
         if ($symbol eq "V") {
            if ($demangled =~ ($case<=2 ? $typeinfo_re : $wrapped_typeinfo_re)) {
               $mangled_ti{$case}=$mangled;
            } elsif ($demangled !~ /typeinfo name /) {
               dbg_print( "c++filt returned '$demangled',\n",
                          "which does not match the expected typeinfo description!" ) if $DebugLevel;
            }
         } else {
            if ($demangled =~ ($case<=2 ? $constructor_re : $wrapped_constructor_re)) {
               $mangled_defc{$case}=$mangled;
            } else {
               dbg_print( "c++filt returned '$demangled',\n",
                          "which does not match the expected default constructor declaration!" ) if $DebugLevel;
            }
	 }
      }
   }
   close $nm;

   if (keys(%mangled_ti) == 3) {
      @to_mangled_typeinfo=uniq( map {
                                    my $subst=$typenames[$_==2];
                                    $mangled_ti{$_} =~ s/$subst/\${&}/;
                                    "s{.*}{$mangled_ti{$_}}";
                                 } 1..3 );

   } elsif (keys(%mangled_defc) == 3) {

      $mangled_defc{1} =~ s/$typenames[0]/\${&}/;
      push @to_mangled_defconstr, "s{.*}{$mangled_defc{1}}";

      $_=$mangled_defc{2};
      my $l=length($typenames[1]);
    HARD_TRY:
      for (my $start=0; $start<$l; ++$start) {
         for (my $end=$l; $end>$start; --$end) {
            my $part=substr($typenames[1],$start,$end-$start);
            if (/\Q$part\E/) {
               if ($start>0 || $end<$l) {
                  my ($add_pre, $add_post)=($`, $');
                  my ($rem_pre, $rem_post)=map { /[.{}()\[\]\\?*^\$]/ ? "\\Q$_\\E" : $_ }
                    (substr($typenames[1],0,$start), substr($typenames[1],$end));
                  push @to_mangled_defconstr, "s{^$rem_pre(.*)$rem_post\$}{$add_pre\${1}$add_post}";
               }
               undef $_;  last HARD_TRY;
            }
         }
      }
      if (defined $_) {
         warn_print( <<'.' );
Could not guess the name mangling rule for classes defined in namespaces.
Please invent the suitable regular expression converting the typeinfo name
to the default constructor mangled name and put it in the custom array
  @Polymake::Core::CPlusPlus::to_mangled_defconstr
.
      }

      $mangled_defc{3} =~ s/$typenames[0]/\${&}/;
      push @to_mangled_defconstr, "s{.*}{$mangled_defc{3}}";

   } else {
      die <<"."
nm has not extracted the symbol names from the test program binary.
Possible reason is the incompatibility between nm and $CXX.
Please investigate the problem and set the custom variables
\$Polymake::Core::CPlusPlus::nm_util  and  \$Polymake::Core::CPlusPlus::cppfilt_util
to proper utility paths and optional flags if necessary.
.
   }

   $custom_handler->set($_) for qw($nm_util $cppfilt_util @to_mangled_defconstr @to_mangled_typeinfo);
}

sub configure_make {
   my $custom_handler=shift;

   $MAKE ||= $^O =~ /bsd|solaris/i ? "gmake" : "make";

   my $cnt=0;
   local $_;
   if (-f "/proc/cpuinfo") {
      # Linux
      if (open my $info, "/proc/cpuinfo") {
	 while (<$info>) {
	    ++$cnt if /^processor\s*:/i;
	 }
      }
   } elsif (-x "/usr/sbin/system_profiler") {
      # MacOS
      if (open my $info, "/usr/sbin/system_profiler -detailLevel mini SPHardwareDataType |") {
	 while (<$info>) {
	    if (/number of cpus:\s*(\d+)/i) {
	       $cnt=$1; last;
	    } elsif (/total number of cores:\s*(\d+)/i) {
	       $cnt=$1; last;
	    }
	 }
      }
   } elsif (-x "/sbin/sysctl") {
      # FreeBSD
      if (open my $info, "/sbin/sysctl hw.ncpu |") {
	 while (<$info>) {
	    if (/^hw\.ncpu:\s+(\d+)/) {
	       $cnt=$1; last;
	    }
	 }
      }
   } elsif (-x "/usr/sbin/psrinfo") {
      # Solaris
      if (open my $info, "/usr/sbin/psrinfo |") {
	 while (<$info>) {
	    ++$cnt if /on-line/;
	 }
      }
   }
   if ($cnt==2) {
      $MAKEFLAGS="-j2";
   } elsif ($cnt>2) {
      $MAKEFLAGS="-j".min($cnt-1,4);
   } else {
      $MAKEFLAGS="";
   }

   $custom_handler->set($_) for qw($MAKE $MAKEFLAGS);
}

1

# Local Variables:
# cperl-indent-level:3
# End:
