—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—

              
package Math::PariBuild;
$VERSION = '2.01080604';
require Exporter;
@ISA = 'Exporter';
@EXPORT = qw(get_pari_version
             pari_formatted_version
             find_pari_dir
             download_pari
             patch_pari
             download_and_patch_pari
             make_pod
             build_tests
             find_paricfg
             find_or_Configure_paricfg
             write_paricfg
             build_paricfg
             find_machine_architecture
             known_asmarch
             inline_headers
             inline_headers2
             not_gnu_as
             choose_and_report_assembler
             kernel_files
             kernel_fill_data
             assembler_flags
             assembler_flags_via
             extra_includes
             ep_codes_from_file
             ep_hash_report
             ep_in_version
             code_C_translator
             build_funclists
            );
use strict;
use Config;
use File::Copy 'copy';
use File::Basename 'basename';
HideShow 20 lines of Pod
=head1 NAME
Math::PariBuild - utility functions used during configuration of C<Math::Pari>.
=head1 SYNOPSIS
  use Math::PariBuild;
=head1 DESCRIPTION
=over
=item C<get_pari_version($dir)>
extracts the version of GP/PARI given the build directory $dir;
version is read from $F<$dir/config/version> and has the form as in
C<"2.3.1">.  Returns undef on failure.
=cut
sub get_pari_version {
  my $dir = shift;
  my $v = "";
  open(IN, "$dir/config/version") or return;
  /(?:version|VersionMajor|VersionMinor|patch)='?(\d+(\.\d+)?)'?/
    and $v .= "$1." while <IN>;
  close(IN) or die "error closing '$dir/config/version'";
  $v =~ s/\.$// or return;
  return $v;
}
HideShow 8 lines of Pod
=item C<pari_formatted_version($dir)>
extracts the version of GP/PARI given the build directory $dir;
version has the form as in C<"2003001"> for version 2.3.1.  Returns
the directory name on failure.
=cut
sub pari_formatted_version {
  my $dir = shift;
  my $v;
  $v = get_pari_version $dir;
  if (defined $v) {
    $dir = $v;
  } else {
    warn(<<EOW);
Could not extract version from '$dir/config/version';
   Do you remember that paridir should be location of PARI/GP source tree,
   not the location of compiled+installed files?
Trying extract from the directory name...
EOW
  }
  return sprintf '%d%03d%03d',$1, $2, $3
    if $dir =~ /(\d+)\.(\d+).(\d+)(\.(alpha|beta))?$/;
  warn(<<EOW);
Directory `$dir' has unknown syntax...
EOW
  return $dir;
}
HideShow 8 lines of Pod
=item find_pari_dir()
Returns the GP/PARI build directory, looking for it as a kid, sibling,
or parent of the current directory.  [Currently skips versions 2.3.* if
possible.]
=cut
my $latmus = 'src/test/in/nfields';
sub filter_versions_too_new {
  my $force = shift;
  my @dirs = grep !m((?:^|[\\/])pari-(?:$common::skip_versions)), @_;
  print "Filtered out versions too new...\n" if @dirs != @_;
  return @dirs if $force or @dirs;
  return @_;                    # Not found, not forced
}
sub find_pari_dir {
  my ($dir, @dirs, @gooddirs);
  # Try to find alongside
  for $dir ('.', '..', '../..', '../../..') {
    @dirs = filter_versions_too_new 0, <$dir/pari-[234].*>;
    @dirs = "$dir/pari" if not @dirs and -d "$dir/pari";
    @dirs = grep -e "$_/$latmus", @dirs;
    last if @dirs;
  }
  @gooddirs = grep !/alpha|beta/, @dirs;
  @gooddirs = grep !/alpha/, @dirs unless @gooddirs;
  @gooddirs = @dirs unless @gooddirs;
  @gooddirs = sort {pari_formatted_version($a) cmp pari_formatted_version($b)}
    @gooddirs;
  return $gooddirs[-1];
}
HideShow 11 lines of Pod
=item download_pari()
Using FTP connection, downloads the latest version of GP/PARI, and
extracts it.  Returns the GP/PARI build directory and the version in
the format C<"2.3.1">.  [Currently skips versions 2.3.*]
Optional arguments: name of the tar file with GP/PARI source (undef
OK), force download.
=cut
sub manual_download_instructions {
  <<EOP;
One can rerun Makefile.PL after fetching GP/PARI archive (e.g., pari-2.1.7.tgz,
or pari-2.3.4.tar.gz) manually to the current directory, or a (grand)parent
directory of the current directory.
  [Keep in mind that the numbers "inside version" of Math::Pari module
   correspond to the last versions of GP/PARI it was tested with (additionally,
   2.0108* works best with the last 2.1.* version, 2.1.7).
   As an alternative to having archive in CWD or its (grand)parent, specify
       pari_tgz=PATH_TO_TAR_GZ
   option to Makefile.PL.
   There is no need to extract the archive, or build GP/PARI; but if you
   have it extracted [and patched, if needed], you may specify
       paridir=PATH_TO_DIST_DIR
   option to Makefile.PL instead of `pari_tgz'.  However, in this case
   the files WON'T be auto-patched.
   As a last-resort solution, there is also a possibility to use an already
   compiled PARI library.  See the documentation in README and INSTALL files.]
EOP
}
sub debug_no_response ($) {
  return '' unless $ENV{AUTOMATED_TESTING};
  my $r = shift;
  my $c = $r->content;
  my $t = $r->content_type;
  $c = '<<undef>>' unless defined $c;
  $c =~ s/\s+\Z/\n/;
  my $b = '=====================';
  return "\n$b Response content (type=$t)\n$c\n$b\n\n";
}
sub ll_ftp () { # All Perl download failures I saw are on Linux and BSD.
  # this (not very portable) solution should work there?
  open OF, '> ftp-cmd' or die "Can't open `ftp-cmd' for write: $!";
  print OF <<'EOF';               # XXXX Hardwired version!
user anonymous auto-download-Math-Pari@cpan.org
cd /pub/pari/unix/
dir
cd OLD
dir
binary
get pari-2.1.7.tgz
quit
EOF
  close OF or die "Can't close `ftp-cmd' for write: $!";
  print <<EOP;
==============================================
ftp -pinegv megrez.math.u-bordeaux.fr < ftp-cmd
EOP
  my $rc = system "ftp -pinegv megrez.math.u-bordeaux.fr < ftp-cmd";
  print <<EOP;
==============================================
EOP
  return if $rc;
  # XXXX Temporarily disable continuing build (to see smoke testing reports)
  warn <<EOW;
==========================================================================
===
===   If the output from FTP session above successfully lists
===   directories, your installs of Net::FTP and, possibly, LWP
===   is completely broken.  How comes???
===
==========================================================================
EOW
  warn(<<'EOW'), return unless $ENV{MATHPARI_USEFTP};
FTP session is for debugging only; I'm ignoring the downloaded file.
  (Set $ENV{MATHPARI_USEFTP} to TRUE to actually use the downloaded file.)
EOW
  return 'pari-2.1.7.tgz';
}
sub download_pari {
  my ($srcfile, $force) = (shift, shift);
  my $host = 'megrez.math.u-bordeaux.fr';
  my $dir  = '/pub/pari/unix/';
  my($ftp, $ua, $base_url);
  print "Did not find GP/PARI build directory around.\n" unless defined $srcfile;
  my @match = ( '((?:.*\/)?pari\W*', '(\d+\.\d+\.\d+).*\.t(?:ar\.)?gz)$' );
  my $match1 = "$match[0]$match[1]";
  my $match  = "$match[0](?!$common::skip_versions)$match[1]";
  my %archive;
  my $match_pari_archive = sub {
    my ($file, $ok23) = (shift, shift);
    return unless $ok23 ? $file =~ /$match1/o : $file =~ /$match/o;
    $file = $1;
    my $version = $2;
    if ($file =~ /alpha/) {
      $archive{alpha}{$version} = $file;
    } elsif ($file =~ /beta/) {
      $archive{beta}{$version} = $file;
    } else {
      $archive{golden}{$version} = $file;
    }
  };
  if ($srcfile and -s $srcfile) {
    die "The FILE supplied via the pari_tgz=$srcfile option did not match /$match/"
      unless $match_pari_archive->($srcfile, 'ok2.3');
  } else {
    if ($force) {
      print "Forced autofetching...\n\n"
    } elsif (not $ENV{AUTOMATED_TESTING} and not $ENV{PERL_MM_USE_DEFAULT}
             and -t STDIN and (-t STDOUT or -p STDOUT)) { # Interactive
      $| = 1;   # Usually, we run under MakeMaker, so test PERL_MM_USE_DEFAULT
      my $mess = <<EOP;
Do you want to me to fetch GP/PARI automatically?
  (If you do not, you will need to fetch it manually, and/or direct me to
   the directory with GP/PARI source via the command-line option paridir=/dir)
Make sure you have a large scrollback buffer to see the messages, or `tee'
the STDOUT/STDERR to a file.
Fetch? (y/n, press Enter)
EOP
      chomp $mess;
      print "$mess ";
      my $ans = <STDIN>;
      if ($ans !~ /y/i) {
        my ($eA, $eM, $tI, $tO, $tE, $pO, $pE)
          = (@ENV{ qw(AUTOMATED_TESTING PERL_MM_USE_DEFAULT) },
             -t STDIN, -t STDOUT, -t STDERR, -p STDERR, -p STDOUT);
        defined() ? $_ = "'$_'" : $_ = '<undef>' for $eA, $eM;
        print <<EOP;      # Is AUTOMATED_TESTING ALWAYS defined on smoke???
Well, as you wish...
  [ to debug Smoke Tests: AUTOMATED_TESTING=$eA PERL_MM_USE_DEFAULT=$eM
        -t STDIN/STDOUT/ERR = $tI/$tO/$tE               -p STDOUT/ERR = $pO/$pE ]
EOP
        print manual_download_instructions();
        return;
      }
    } else {
      print "Non-interactive session, autofetching...\n\n"
    }
    $base_url = "ftp://$host$dir";
    my @extra_chdir = qw(OLD);
    print "Getting GP/PARI from $base_url\n";
    eval {
      require Net::FTP;
      $ftp = Net::FTP->new($host) or die "Cannot create FTP object: $!";
      $ftp->login("anonymous","Math::Pari@")
        or die "Cannot login anonymously (",$ftp->message(),"): $!";
      my $c = 0;
      my @Extra = @extra_chdir;
      while (not $c) {
        $ftp->cwd($dir) or die "Cannot cwd (",$ftp->message(),"): $!";
        $ftp->binary() or die "Cannot switch to binary (",$ftp->message(),"): $!";
        my @lst = $ftp->ls();
        @lst or ($ftp->pasv() and @lst = $ftp->ls()) or die "Cannot list (",$ftp->message(),"): $!";
        #print "list = `@lst'\n";
        %archive = ();
        for my $file (@lst) {
          $c++ if $match_pari_archive->($file);
        }
        unless ($c) {
          die "Did not find any file matching /$match/ via FTP\n\n"
            . manual_download_instructions() unless @Extra;
          $dir = shift @Extra;
          print "Not in this directory, now chdir('$dir')...\n";
        }
      }
    };
    if ($@) {
      undef $ftp;
      warn "$@\nCan't fetch file with Net::FTP, now trying with LWP::UserAgent...\n";
      # second try with LWP::UserAgent
      eval { require LWP::UserAgent; require HTML::LinkExtor }
        or die "You do not have LWP::UserAgent and/or HTML::LinkExtor installed, cannot download, exiting...\n\n" . manual_download_instructions();
      my $c = 0;
      my @Extra = @extra_chdir;
      while (not $c) {
        $ua = LWP::UserAgent->new;
        $ua->env_proxy;
        my $req = HTTP::Request->new(GET => $base_url);
        my $resp = $ua->request($req);
        $resp->is_success
          or die "Can't fetch directory listing from $base_url: " . $resp->as_string;
        %archive = ();
        if ($resp->content_type eq 'text/html') {
          my $p = HTML::LinkExtor->new;
          $p->parse($resp->content);
          for my $link ($p->links) {
            my($tag, %attr) = @$link;
            next if $tag ne 'a';
            $c++ if $match_pari_archive->($attr{href});
          }
        } else {
          foreach my $file (split /\n/, $resp->content) {
            $c++ if $match_pari_archive->($file);
          }
        }
        unless ($c) {
          unless (@Extra) {
            warn debug_no_response($resp)
              . "Did not find any file matching /$match/ via FTP.\n\n";
            my $f = ll_ftp or die manual_download_instructions();
            return download_pari($f);
          }
          my $dir = shift @Extra;
          $base_url .= "$dir/";
          print "Not in this directory, trying `$base_url'...\n";
        }
      }
    }
  }
  sub fmt_version {sprintf "%03d%03d%03d", split /\./, shift}
  my ($type, %have, %types, $best, %latest_version, %latest_file);
  for $type (qw(alpha beta golden)) {
    if ($archive{$type}) {
      $have{$type}++;
      $best = $type;
      my @files = keys %{$archive{$type}};
      print "Available $type versions: `@files'\n";
      $latest_version{$type} = (sort {fmt_version($a) cmp fmt_version($b)}
                                keys %{$archive{$type}})[-1];
      $latest_file{$type} = $archive{$type}{$latest_version{$type}};
      print qq(Latest supported $type is `$latest_file{$type}'\n);
    }
  }
  # Special-case v2.0.14
  if (!$archive{golden} and $latest_version{beta} eq '2.0.11'
      and $latest_version{alpha} eq '2.0.14') {
    $best = 'alpha';            # It is tested!
  }
  undef $dir;
  my $version;
  if ($best) {
    my $file = $latest_file{$best};
    $version = $latest_version{$best};
    print qq(Picking $best version $version, file $file\n);
    if (-f $file) {
      print qq(Well, I already have it, using the disk copy...\n);
    } else {
      print qq(Downloading `$base_url$file'...\n);
      if ($ftp) {
        $ftp->get($file) or die "Cannot get via FTP (",$ftp->message(),"): $!";
        $ftp->quit or warn "Warning: cannot quit FTP: ", $ftp->message();
      } else {
        my $req = HTTP::Request->new(GET => "$base_url$file");
        my $resp = $ua->request($req);
        $resp->is_success
          or die "Can't fetch $base_url/$file: " . $resp->as_string;
        my $base = basename($file);
        open(F, ">$base") or die "Can't write to $base: $!";
        binmode F or die "Can't binmode(): $!";
        print F $resp->content;
        close F;
      }
      print qq(Downloaded...\n);
    }
    print qq(Extracting...\n);
    my $zcat = "gzip -dc";      # zcat may be the old .Z-extractor
    print  "$zcat $file | tar -xvf -\n";
    system "$zcat $file | tar -xvf -"
      and do {
          print "Can't un-targz PARI: \$!=$!, exitcode=$?.\n";
          my @cmd = ($^X, qw(-MArchive::Tar -wle),
                     'Archive::Tar->new(shift)->extract()', $file);
          print '  Now retry with "', join('" "', @cmd), "\"\n";
          system @cmd and die "Can't un-targz PARI: \$!=$!, exitcode=$?.\n"
        };
    ($dir = $file) =~ s,(?:.*[\\/])?(.*)\.t(ar\.)?gz$,$1,
      or die "malformed name `$file'";
    -d $dir or die "Did not find directory $dir!";
  }
  return ($dir, $version);
}
HideShow 6 lines of Pod
=item C<patches_for($version)>
Returns patches appropriate for GP/PARI version $version (formatted as in C<2.2.2>).
=cut
sub patches_for ($) {
  my ($v) = (shift);
  my %patches = ('2.0.11'
                 => [qw(
                        patch11/diff_pari_gnuplot_aa
                        patch11/patch_pari_round0
                        patch11/patches_round1_short
                        patch11/diff_pari_fixed_interfaces_011
                        patch11/diff_pari_highlevel_hash_011a
                        patch11/diff_pari_ret_proto_2011)],
                 '2.0.12' => ['patch12/diff_for_perl_2012'],
                 '2.0.13' => ['patch13/diff_for_perl_2013',
                              'patch13/diff_for_gnuplot_2013'],
                 '2.0.14' => ['patch14/diff_for_perl_2014',
                              'patch14/diff_extra_2014',
                              'patch14/diff_last_2014',
                              'patch14/diff_plot_2014'],
                 '2.0.15' => ['patch15/diff_cast_2015',
                              'patch15/diff_errout_2015',
                              'patch15/diff_gnuplot_2015',
                              'patch15/diff_proto_2015',
                              'patch15/diff_errpari_2015',
                              'patch15/diff_pari_gnuplot_2015'],
                 '2.0.16' => ['patch16/diff_gnuplot_2016'],
                 '2.1.2' =>  ['patches/diff_2.1.2_gccism'],
                 '2.1.3' =>  ['patches/diff_2.1.3_interface'],
                 '2.1.4' =>  ['patches/diff_2.1.4_interface'],
                 '2.1.5' =>  ['patches/diff_2.1.4_interface'],
                 '2.2.2' =>  ['patches/diff_2.2.2_interface'],
                 '2.1.6' =>  ['patches/diff_2.1.6_ploth64',
                              'patches/diff_2.1.6_align_power_of_2',
                              'patches/diff_2.1.6_no-common'],
                 '2.1.7' =>  [
                        ($^O =~ /darwin/i ? 'patches/diff_2.1.6_no-common' : ()),
                        ($^O eq 'MSWin32' ? 'patches/diff_2.1.7_mingw-w64' : ()),
                              'patches/patch-pari-unnormalized-float',
                              'patches/diff_2.1.7_-O',
                              'patches/diff_2.1.7_div',
                              'patches/diff_2.1.6_align_power_of_2',
                              'patches/diff_2.1.7_restart'],
                 '2.3.5' =>  [
                        ($^O eq 'MSWin32' ? 'patches/diff_2.3.5_mingw-w64' : ())], 
                );
  print "Looking for patches for $v...\n";
  my @p = $patches{$v} ? @{$patches{$v}} : ();
  push @p, 'patches/diff_pari-2.1.3-ix86-divl'
    if $v le '2.1.3' or $v ge '2.2' and $v le '2.2.2';
  @p;
}
HideShow 9 lines of Pod
=item C<patch_pari($dir [, $version])>
Applies known necessary fixes to GP/PARI build directory $dir if needed.
Returns empty if no patching is needed, otherwise the string encoding
return values of patch commands.
=cut
sub patch_args ($) {
  return '/' unless $^O =~ /win32/i;
  my($patch, $p) = (shift, 'utils/inc_h.diff');
  $p =~ s,/,\\,g;
  system "$patch -p1 --binary < $p"
    or warn("... Apparently, your patch takes flag --binary...\n"),
       return ('\\', '--binary');
  return '\\';
}
sub patch_pari {
  my ($dir, $version) = (shift, shift);
  $version = get_pari_version($dir) unless defined $version;
  my @patches = patches_for($version) or return;
  print "Patching...\n";
  my $patch = $Config{gnupatch} || 'patch';
  my ($dir_sep, @args) = patch_args $patch;
  my ($rc, $p) = join '; ', $dir_sep, @args, '';
  foreach $p (@patches) {
    (my $pp = "../$p") =~ s,/,$dir_sep,g;
    my $cmd = "cd $dir && $patch -p1 @args < $pp";
    print "$cmd\n";
    system "$cmd"
      and warn "...Could not patch: \$?=$?, $!; continuing anyway...\n";
    $rc .= "'$pp' => $?, "
  }
  print "Finished patching...\n";
  $rc =~ s/,?\s+$//;
  $rc
}
HideShow 11 lines of Pod
=item download_and_patch_pari()
Using FTP connection, downloads the latest version of GP/PARI,
extracts it, and applies known necessary fixes if needed.  Returns the
GP/PARI build directory (in scalar context), otherwise the directory
and the result of patching.
Same optional arguments as for download_pari().
=cut
sub download_and_patch_pari {
  my ($file, $force, @rc) = (shift, shift);
  my ($dir, $version) = download_pari($file, $force);
  @rc = patch_pari($dir, $version) if defined $dir;
  return $dir unless wantarray;
  ($dir, @rc);
}
HideShow 8 lines of Pod
=item C<make_pod($podfile, $gphelp_opt, $dir)>
Makes POD documentation for functions in the PARI library.  Converts
the TeX file found in GP/PARI build directory $dir to POD using the
given options for F<gphelp>.
=cut
# We can't do what the commented chunk does: $paridir/doc/gphelp is
# auto-generated, so its date is not relevant to anything.
# $targ = 'libPARI/gphelp';
# if (not -e $targ
#     or -M $targ > -M "$paridir/doc/gphelp") {
#   if (-f $targ) {
#     chmod 0666, $targ;
#     unlink $targ;
#   }
#   copy "$paridir/doc/gphelp", $targ;
# }
sub make_pod {
  my ($targ, $how, $paridir) = @_;
  if (not -e $targ
      or -M $targ > -M "$paridir/doc/usersch3.tex"
      or -M $targ > -M "libPARI/gphelp") {
    if (-f $targ) {
      chmod 0666, $targ;
      unlink $targ;
    }
    (system "$^X libPARI/gphelp $how $paridir/doc/usersch3.tex > tmp_pod "
      and (warn("Errors when converting documentation: $?"), 0))
      or rename 'tmp_pod', $targ;
  }
}
sub scan_headers {
  my $opts = shift;
  warn "Scanning header files...\n";
  my $cmd = "$Config{cpprun} $Config{cppflags} utils/inc.h 2>&1";
  open INC, "$cmd |" or warn("Error $! from: $cmd\n"), return;
  $opts->{clk_tck_def} = 1;
  while (<INC>) {
    $opts->{have_ulong} = 1, warn "...ulong\n" if /\btypedef\b.*\bulong\s*;/;
    $opts->{clk_tck_def} = 0, warn "...CLK_TCK not defined\n"
      if /y\s*=\s*CLK_TCK\b/;
    $opts->{have_getrusage} = 1, warn "...getrusage\n" if /\bgetrusage\s*\(/;
    $opts->{have_ladd} = 1, warn "...ladd\n" if /\bladd\b/;
  }
  close INC or warn "Note (probably harmless): Errors reading from pipe: '$!', exit=$?: $cmd\n"
}
HideShow 6 lines of Pod
=item C<build_tests($dir)>
Converts GP/PARI test files in GP/PARI build directory $dir to Perl test suite.
=cut
sub build_tests {
  my $dir = shift;
  my $paritests = "$dir/src/test/in";
  opendir TESTS, $paritests
    or die "Cannot find tests in $paritests: $!";
  my @tests = readdir TESTS;
  closedir TESTS or die "Cannot find tests (close): $!";
  my $sou = 'test_eng/ex.t';
  my $targ = "$sou-";
  unless (-e $targ and -M $targ <= -M $sou) {
    $dir =~ s/\\/\\\\\\\\/g;
    my $quote = ($^O =~ /win32/i) ? '"' : "'";
    system "$^X -pe $quote s,CHANGE_ME,$dir, $quote $sou > $targ"
      and die "Could not run test converter: $! $?";
  }
  $sou = $targ;
  my $test;
  for $test (@tests) {
    next if $test =~ /^\.\.?$/;
    next if $test =~ /compat/;
    next if -d "$paritests/$test" and $test eq 'CVS';
    next if $test =~ /(~|\.(bak|orig|rej))$/;
    $targ = "t/55_$test.t";
    if (-f $targ) {
      chmod 0666, $targ;
      unlink $targ;
    }
    copy $sou, $targ or die "Cannot create test $test.t: $1";
  }
}
HideShow 6 lines of Pod
=item C<find_paricfg($dir)>
Finds suitable (?) files F<paricfg.h> in GP/PARI build directory $dir.
=cut
sub find_paricfg {
  my $paridir = shift;
  my @paricfg = <$paridir/o.*/paricfg.h>;
  push @paricfg, <$paridir/O*/paricfg.h>;
  # Reported to work with Win32 too
  @paricfg = grep !/Odos/, @paricfg unless $^O =~ /dos|djgcc|MSWin32/i;
  # Probably not present in newer versions anymore...
  unshift @paricfg, "$paridir/win32/paricfg.h"
    if $^O eq 'MSWin32' and -f "$paridir/win32/paricfg.h";
  @paricfg;
}
HideShow 8 lines of Pod
=item C<find_paricfg($dir, $do_configure)>
Finds suitable (?) files F<paricfg.h> in GP/PARI build directory $dir.
If $do_configure is true, runs GP/PARI's Configure script to build
one.  Returns FALSE if F<paricfg.h> needs to be build by Perl.
=cut
sub find_or_Configure_paricfg {
  my ($paridir, $do_configure) = (shift, shift);
  my @paricfg = find_paricfg $paridir;
  return 0 unless $do_configure;
  if (@paricfg == 0) {
    print "No existing paricfg.h found, running Configure...\n";
    print  "cd $paridir ; sh ./Configure\n";
    system "cd $paridir ; sh ./Configure"
      and die "Cannot configure: $!, exitcode=$?.\n";
    print "Configuration of GP/PARI successful.\n";
    @paricfg = find_paricfg $paridir;
  }
  if (@paricfg == 0) {
    warn <<EOW;
Did not find paricfg.h.  You may need to manually copy it to libPARI
    directory from the GP/PARI build directory.
    ...Now switching to creation of paricfg.h by Perl code.
EOW
    return 0;
  }
  my $found = $paricfg[0];
  if (@paricfg > 1) {
    warn "Found multiple paricfg.h: @paricfg.\n";
    @paricfg = sort { -M $a <=> -M $b} @paricfg;
    $found = $paricfg[0];
    warn "Choosing newest paricfg.h: $found.\n";
  }
  if (-e 'libPARI/paricfg.h' and -M $found >= -M 'libPARI/paricfg.h') {
    print <<EOP;          # Duplication with build_paricfg()...
Existing libPARI/paricfg.h not older than $found.
...Will not overwrite libPARI/paricfg.h...  (remove it manually if needed);
   You may also want to remove libPARI/paricfg.h if you configuration changed
   from the time of the first build in this directory...
EOP
  } else {
    print "Found $found, copying it to libPARI...\n";
    copy $found, 'libPARI/paricfg.h'
      or die "Could not copy $found to paricfg.h: $!"
        if not -e 'libPARI/paricfg.h' or -M $found < -M 'libPARI/paricfg.h';
  }
  return 1;
}
HideShow 7 lines of Pod
=item write_paricfg($formatted_version)
Writes PARI configuration file F<libPARI/paricfg.h>.  Returns hash
with options found during the scan of the header files.
=cut
sub write_paricfg {
  my $version = shift;
  my %opts;
  scan_headers(\%opts) or $opts{clk_tck_def} = 0;
  warn "Creating libPARI/paricfg.h...\n";
  open F, '> libPARI/paricfg.h' or die "open 'libPARI/paricfg.h' for write: $!";
  print F <<EOP unless $^O =~ /win32/i; # Should not we check for CygWin?
#define UNIX
EOP
  my $shellq = ($^O eq 'os2' or $^O =~ /win32/i or $^O eq 'dos') ? q(") : q(');
  my $datadir = '/usr/local/lib/pari/';
  { local %ENV;
    delete $ENV{GP_DATA_DIR};
    (my $o = `$^X -wle "print shift" "print(default(datadir))" | gp -q` || '')
       =~ s,/?\n*$,,;
    $datadir = "$o/" if length $o and -d $o;
  }
  # with 2.1.7, it is either in one of $miscdir/galdata $share_prefix/pari/galdata
  my $miscdir = $datadir;       # Not needed with 2.3.4
  $datadir .= "galdata/" if $version < 2003000;
  print F <<EOP;
#define SHELL_Q         '\\$shellq'
EOP
  print F <<EOP;
#define GPDATADIR "$datadir"
#define GPMISCDIR "$miscdir"
#define PARI_BYTE_ORDER    $Config{byteorder}
#define NOEXP2  /* Otherwise elliptic.t:11 rounds differetly, and fails */
EOP
  if ($opts{have_getrusage}) {
    print F <<EOP if $Config{d_times};
#define USE_GETRUSAGE 1
EOP
  } else {
    print F <<EOP if $Config{d_times} and $^O !~ /win32/i; # times() missing there...
#define USE_TIMES 1
EOP
    print F <<EOP if $Config{d_times} and $Config{i_time} and !$opts{clk_tck_def};
/* Reported to be needed on some Linuxes: */
#include <time.h>
EOP
    print F <<EOP if not $Config{d_times} and $Config{d_ftime};
#define USE_FTIME 1
EOP
  }
  print F <<EOP if $Config{dlsrc} eq 'dl_dlopen.xs';
#define HAS_DLOPEN
EOP
  print F <<EOP unless $opts{have_ulong};
#define ULONG_NOT_DEFINED
EOP
  my $arch = find_machine_architecture();
  my $bits64 = ($arch =~ /alpha|64/ # ppc is 32bit
                or defined($Config{longsize}) and $Config{longsize} == 8);
  print F <<EOP if $bits64;
#define LONG_IS_64BIT   1
EOP
  if (!$bits64) {
     # Order of words in a double
     my @w = unpack 'LL', pack 'd', 2;
     my $f = $w[1] ? 1 : 0;
     die "Unknown double format" unless $w[$f] == (1<<30) and $w[1-$f] == 0;
     print F <<EOP;
#define PARI_DOUBLE_FORMAT $f
EOP
  }
  print F <<EOP;
#define DL_DFLT_NAME    NULL
EOP
  print F <<EOP if $arch eq 'port';
#define __HAS_NO_ASM__
EOP
  my @v = ($version =~ /^(\d+)(\d{3})(\d{3})$/)
    or die "write_paricfg() needs a formatted version argument, got `$version'";
  my $vvv = ((($v[0]) << 16) + (($v[1]) << 8) + ($v[2]));
  print F <<EOP;   # <=2.3.0 it was used only in gp.c, which we don't compile
#define PARI_VERSION_CODE       $vvv
#define PARI_VERSION(a,b,c)     (((a) << 16) + ((b) << 8) + (c))
#define PARI_VERSION_SHIFT      8
EOP
  close F or die "close 'libPARI/paricfg.h' for write: $!";
  %opts;
}
HideShow 9 lines of Pod
=item C<build_paricfg($dir, $do_configure)>
Builds F<libPARI/paricfg.h> either ourselves, or by looking for it in
GP/PARI build directory $dir - and running GP/PARI's Configure script
if needed.  Returns hash with options found during the scan of the
header files.
=cut
sub build_paricfg {     # $version as in 2003005 for 2.3.5
  my ($paridir, $do_configure, $version) = (shift, shift, shift);
  my %opts;
  unless (find_or_Configure_paricfg($paridir, $do_configure)) {
    # Not generated by Configure
    if (-r 'libPARI/paricfg.h') {
      print <<EOP unless $do_configure;   # Duplication with find_or_Configure_paricfg()
...Will not overwrite libPARI/paricfg.h...  (remove it manually if needed)
   You may also want to remove libPARI/paricfg.h if your configuration changed
   from the time of the first build in this directory...
EOP
    } else {
      print "...Generating libPARI/paricfg.h ...\n";
      %opts = write_paricfg($version);
    }
  }
  %opts;
}
# The following two functions are based on the logic in the PARI
# Configure script (updated to 2.3.0's config/arch-osname):
sub process_sparc {
  my $info = shift;
  #         *SuperSparc*)   arch=sparcv8_super;;
  #         *TMS390Z5[05]*) arch=sparcv8_super;; # SuperSparc I or II
  #         *MB86934*)      arch=sparcv8_super;; # SparcLite
  #         *RT625*)        arch=sparcv8_super;; # HyperSparc
  #         *CY605*)        arch=sparcv8_super;;
  return 'sparcv8_super' if $info =~ /SuperSparc|TMS390Z5[05]|CY605|MB86934|RT625/;
  #         *TMS390S1[05]*) arch=sparcv8_micro;; # MicroSparc I
  #         *MB86904*)      arch=sparcv8_micro;; # MicroSparc II
  #         *MB86907*)      arch=sparcv8_micro;; # TurboSparc
  return 'sparcv8_micro' if $info =~ /TMS390S1[05]|MB8690[47]/;
  return shift;
}
HideShow 6 lines of Pod
=item find_machine_architecture()
Returns the type of the processor of the current machine.
=cut
sub find_machine_architecture () {
  my $os = (split ' ', $Config{myuname})[0];
  my $machine = $os;            # Handles fx2800
  if ($os =~ /^irix/) {
    $machine = 'irix';
  } elsif ($os =~ /^hp/) {
    $machine = `uname -m` || 'hppa';
    if ($machine =~ m(^9000/[34])) {
      $machine = 'm68k';
    } elsif ($machine ne 'ia64') {
      $machine = 'hppa';
    }
  } elsif ($os eq 'os2' or $os eq 'netbsd'
           or $os eq 'freebsd' or $os =~ /^cygwin/) {
    chomp($machine = `uname -m`);
    $machine ||= 'ix86';
  } elsif (($Config{archname} eq 'MSWin32-x86-multi-thread') && ($Config{cc} =~ /gcc/)) {
    $machine = 'ix86';
  } elsif (0 and $os =~ /win32/i and not $Config{gccversion}) {
    # Not needed with rename of kernel1.s to kernel1.c?
    $machine = 'port'; # Win32 compilers would not understand the assmebler anyway
  } elsif ($os eq 'ultrix') {
    $machine = 'mips';
  } elsif ($os eq 'nextstep' or -d '/NextApps') {
    chomp($machine = `file /bin/sh | sed 's/.*(for architecture \(.*\))/\1/'`);
  } elsif ($os eq 'darwin') {
    chomp($machine = `uname -p`);
    $machine = 'ppc' if $machine eq 'powerpc';
  } elsif ($os eq 'osf1') {
    $machine = 'alpha' if (split ' ', $Config{myuname})[4] eq 'alpha';
  } elsif ($os =~ /^cygwin/) {
    $machine = $ENV{HOSTTYPE};
  } elsif ($os eq 'linux') {
    chomp($machine = `uname -m`);
    $machine = 'sparcv9' if $machine eq 'sparc64';
    $machine = 'hppa' if $machine =~ /^parisc/;
    if ($machine eq 'sparc' and -e '/proc/cpuinfo' && -R '/proc/cpuinfo') {
      open IN, '/proc/cpuinfo' or die "open /proc/cpuinfo: $!";
      local $/ = undef;         # Needed?
      my $info = <IN>;
      close IN or die "close /proc/cpuinfo: $!";
      $machine = process_sparc $info, $machine;
    }
  } elsif ($os eq 'sunos') {
    my $type = (split ' ', $Config{myuname})[4];
    # format: SunOS name 5.9 Generic_118558-26 sun4u sparc SUNW,Ultra-5_10
    # But Generic* part can be skipped???
    $type = (split ' ', $Config{myuname})[3] if $type eq 'sparc';
    my $redo;
  find_machine:  {
      if ($type =~ /^sun3/) {
        $machine = 'm68k';
      } elsif ($type =~ /^sun4[dm]/) {
        local $ENV{PATH} = "$ENV{PATH}:/dev/sbin";
        my $info = `(prtconf||devinfo)2>&-`;
        $info = join ' ', grep /(TI|FMI|Cypress|Ross),/, split "\n", $info;
        $machine = process_sparc $info, 'sparcv8';
      } elsif ($type eq 'sun4u') {
        $machine = 'sparcv9';
      } elsif ($type =~ /^sun4[ce]?$/) {
        # $machine = 'sparcv7';
        $machine = 'none';      # sparcv7 not available with 2.3.0
      } elsif ($type =~ /^i.*pc$/) {
        $machine = 'ix86';
      } elsif ((split ' ', $Config{myuname})[3] eq 'sun') {
        $machine = 'm86k';
      } elsif ($redo++ == 0) {
        $type = `uname -m`;
        redo find_machine;
      }
    }
  } elsif ($os eq 'gnu') {# Cover GNU/Hurd, GNU/kFreeBSD and other GNU userland
    chomp($machine = `uname -m`);
    $machine = 'ix86' if $machine =~ /^i\d86-/;
  }
  $machine = 'port'             # No assembler for 64bit - unless alpha/ia64
    if $machine !~ m(alpha|64) and ($Config{longsize} || 0) == 8;
  print("I detect multi-arch build; assembler not supported on such builds.\n\n"),
    $machine = 'port'   # No assembler for repeated -arch (multi-arch build)
      if $Config{ccflags} =~ /(^|\s)-arch\s.*\S\s+-arch\s/;
  # For older PARI:
  ###  $machine = 'sparcv8super'
  ###    if $machine eq 'sparcv9' or $machine eq 'sparcv8_hyper'
  ###       or $machine eq 'sparcv8_super';
  ###  $machine = 'sparcv8micro' if $machine eq 'sparcv8_micro';
  # This part is probably not needed and never entered
  if (not defined $machine
      and $Config{myuname}
      =~ /\b(sun3|sparcv7|sparcv8_micro|sparcv8_super|alpha|hppa|[ix]\d86)\b/) {
    $machine = $1;
  } elsif (not defined $machine) {
    chomp($machine = `uname -m`);
  }
  $machine =~ s/[ix]\d86(-\w+)?/ix86/ if defined $machine;      # i686-pc
  print "...Processor of family `$machine' detected\n";
  return $machine;
}
sub not_gnu_as {
  local $/;
  my $ass = $ENV{AS} || 'as';
  my $devnul = -e '/dev/null' ? '< /dev/null' : '';
  open ASS, "$ass --version 2>&1 $devnul |";
  my $assout;
  eval {
    local $SIG{ALRM} = sub {die};
    eval {alarm 10};                    # Be extra safe...
    $assout = <ASS>;
    close ASS;
    unless ($assout) {
      eval {alarm 10};                  # Be extra safe...
      open ASS, "$ass -v 2>&1 $devnul |";
      $assout = <ASS>;
      close ASS;
    }
    eval {alarm 0};
  };
  ($assout and $assout =~ /GNU/) and return;    # GNU
  $assout or 1;
}
# Which files to catenate to produce pariinl.h.  Apparently, the only
# need to go to asm0.h in pre-2.3 is to undo the effect of ASMINLINE in
# paricfg.h. Note that we do ASMINLINE from the command line.
# 2.3.0 does something like this:
# ../config/genkernel ../src/kernel/ix86/asm0.h > parilvl0.h
# cat ../src/kernel/none/tune.h ../src/kernel/none/int.h ../src/kernel/none/level1.h > parilvl1.h
# cat parilvl0.h parilvl1.h > pariinl.h
# This logic works with up to 2.2.13
sub sparcv8_inl {
  my ($asmarch, $pari_version) = (shift, shift);
  return ['none/asm0.h','none/level1.h']
    if $Config{osname} =~ /^(linux|nextstep)$/;
  return ['sparcv8/level0.h','none/level1.h'] if $pari_version < 2002006;
  return ['sparcv8_micro/level0_common.h','sparcv8_micro/level0.h',
          'none/level1.h'] if $asmarch eq 'sparcv8_micro';
  return ['sparcv8_micro/level0_common.h','none/divll.h',
          'none/level1.h'] if $asmarch eq 'sparcv8_super';
  # No for sparcv8...
}
sub inline_headers_arr {     # These files are cat()ed to pariinl.h
  my ($asmarch, $pari_version) = (shift, shift);
  return sparcv8_inl($asmarch, $pari_version) if $asmarch =~ /^sparcv8/;
  my %h = (
               alpha          => ['none/asm0.h','none/level1.h'],
               hppa           => ['none/asm0.h','none/level1.h'],
               ix86           => ['ix86/level0.h','none/level1.h'],
               m86k           => ['none/level0.h','none/level1.h'],
               none           => ['none/level0.h','none/level1.h'],
               # ppc is not done yet (2.0.15)
        ($pari_version > 2002007
                ? (ppc               => ['ppc/asm0.h', 'none/divll.h'],
                   x86_64            => ['x86_64/asm0.h','none/level1.h'],
                   ia64              => ['ia64/asm0.h','ia64/asm1.h'])
                : ()),
               sparcv7        => ['none/asm0.h','none/level1.h'],
#              sparcv8        => $sparcv8_inl,
#              sparcv8_micro  => $sparcv8_inl,
#              sparcv8_super  => $sparcv8_inl,
               # sparcv9 is not done yet (2.0.15)
  );
  $h{$asmarch};
}
sub inline_headers {
  my ($asmarch, $pari_version) = (shift, shift);
  my $inlines = inline_headers_arr($asmarch, $pari_version)
        or die "Unknown inlines for '$asmarch'";
  my @inlines = @$inlines;
  if ($pari_version < 2003000) { # Old, explicit logic
    unshift @inlines, 'none/int.h' if $pari_version >= 2002005;
    unshift @inlines, 'none/tune.h' if $pari_version >= 2002008;
  }
  map "\$(PARI_DIR)/src/kernel/$_", @inlines;
}
sub generic_build_method {
  my ($asmarch, $pari_version, $paridir) = (shift, shift, shift);
  $pari_version >= 2003000
    and (not -f "$paridir/src/kernel/$asmarch/MakeLVL1.SH"
         or $asmarch eq 'none');
}
sub inline_headers_by_file {    # logic of 2.3.0
  my($dir,$f) = (shift, shift);
  die "I expect to have $f present" unless -f $f;
  #local $/ = "\n";
  open F, "< $f" or die "Error opening `$f' for read: $!";
  my @I = ([], [$f]);           # INL, NOINL
  while (<F>) {
    next unless /^(NO)?ASM\s+(\S.*?)\s*$/;
    # print "Found <$_>\n";
    my $arr = $I[ $1 ? 1 : 0 ];
    push @$arr, map "$dir/none/$_.h", split ' ', $2;
  }
  close F or die "Error closing `$f' for read: $!";
  return @I;
}
sub inline_headers_by_dir {     # logic of 2.3.0
  my ($asmarch, $pari_version, $paridir) = (shift, shift, shift);
  my $dir = "$paridir/src/kernel";
  #$asmarch ='none' if $asmarch eq 'port';
  unless (generic_build_method($asmarch, $pari_version, $paridir)) {
#    die "Do not know how to process MakeLVL1.SH";
  }
  my @I = ([],[]);
  @I = inline_headers_by_file $dir, "$dir/sparcv8_micro/asm0-common.h"
    if $asmarch =~ /^sparcv8_/;
  my @I1 = inline_headers_by_file $dir, "$dir/$asmarch/asm0.h";
  for (0,1) {
    push @{$I[$_]}, @{$I1[$_]};
  }
  push @{$I[1]}, map "$dir/none/$_.h", qw(tune int level1);
  return @I;
}
sub inline_headers_pre {
  my ($asmarch, $pari_version, $paridir) = (shift, shift, shift);
  return if $pari_version < 2003000;
  my $script = "$paridir/src/kernel/$asmarch/";
  return;
}
sub inline_headers2 {
  my ($asmarch, $pari_version, $paridir) = (@_);
  return ([inline_headers_pre(@_)], [inline_headers(@_)])
    if $pari_version < 2003000;
  return inline_headers_by_dir(@_);
}
sub known_asmarch {
  defined inline_headers_arr(@_);
}
sub choose_and_report_assembler {
  my($machine, $pari_version) = (shift, shift);
  my %asmarch = (
              sun3         => 'm86k',
              sparc        => 'sparcv8_micro',
              sparcv9      => 'sparcv8_micro',
              port         => 'none',
              mips         => 'none',
              fx2800       => 'none',
              ia64         => (($Config{longsize}||4) == 8 ? 'ia64' : 'none'),
              hppa         => ($Config{osvers} =~ /^.\.10\./
                               ? 'hppa' : 'none'),
             );
  my $asmarch = $asmarch{$machine} || $machine; # Temporary only
  my %skip64 = (alpha => 1, none => 1);
  if (not ( $skip64{$asmarch} or $asmarch =~ /\D64$/ )
      and ($Config{longsize} || 0) == 8) {
    $asmarch .= '_64';
    $asmarch = 'hppa64' if $asmarch eq 'hppa_64';
    $asmarch = 'x86_64' if $asmarch eq 'ix86_64';
  }
  unless (known_asmarch $asmarch, $pari_version) {
    warn <<EOW;
####    Do not know how to build for assembler `$asmarch'.      ####
####    Reversing to assembler-less type `port'.                ####
####                                                            ####
####    If you think your processor's assembler is supported    ####
####    by PARI, edit libPARI/Makefile.PL and report.           ####
####                                                            ####
####    Alternatively, specify machine=YOURTYPE or machine=none ####
####    on the                                                  ####
####      perl Makefile.PL                                      ####
####    command line.                                           ####
####    Recognized types:                                       ####
####      alpha hppa m86k none sparcv7 sparcv8 sparcv8_micro    ####
####      sparcv8_super ix86 (ppc ia64 after 2.2.7)             ####
EOW
    $machine = 'port';
    $asmarch = 'none';
  }
  if ($asmarch eq 'none') {
    print "...I will  use portable assembler-less build\n";
  } else {
    print "...I will use assembler build of type '$asmarch'.\n";
  }
  print <<EOP if $asmarch =~ /^hppa/;
###
###  Some time ago HPPA assembler files were not relocatable,
###    if this is still true, they are probably unsuitable for dynamic linking.
###  It is advisable to restart Makefile.PL with an extra argument
###     machine=port
###  if you are planning for dynamic linking of Math::Pari.
###
###  NOTE:  machine=port results in a significant drop in performance.
###  For a static build (which makes a new perl executable with the library
###       compiled in [and arranges for it to be compiled in when
###       other extensions are statically built later]):
###    perl Makefile.PL LINKTYPE=static
###    make static
###    make perl
###    make test
###    make install
###
EOP
  return $asmarch;
}
# Output (last two optional):
#   [Which file to compile, whether you need to preprocess it to ./kernel1.s,
#    Additional file to compile, need? to preprocess it to ./kernel2.s,]
sub sparcv8_kernel_files_old {
  my ($asmarch, $pari_version, $Using_gnu_as) = (shift, shift, shift);
  my $_ext = (($pari_version < 2000015) ? 's' : 'S');
  my $cvt = $Using_gnu_as || $Config{osname} =~ /^(linux|nextstep)$/;
  my $sparcv8_kernel = ($cvt
                        ? ["sparcv8/level0.$_ext", 1,
                           "sparcv8/level0_$asmarch.$_ext", 1]
                        : ["sparcv8/level0.$_ext", 0,
                           "sparcv8/level0_$asmarch.$_ext", 0]);
  # kernel2.o is not needed if the compiler can inline assembler:
  my $sparcv8_need_kernel2 =
    !$Config{gccversion} || $Config{osname} =~ /^(linux|nextstep)$/;
  $sparcv8_kernel = [$sparcv8_kernel->[2], $sparcv8_kernel->[3]]
    unless $sparcv8_need_kernel2;
  return   $sparcv8_kernel;
}
sub sparcv7_kernel_files {
  my ($asmarch, $pari_version, $Using_gnu_as) = (shift, shift, shift);
  my $_ext = (($pari_version < 2000015) ? 's' : 'S');
  my $cvt = $Using_gnu_as || $Config{osname} =~ /^(linux|nextstep|netbsd)$/;
  return ["sparcv7/level0.$_ext", $cvt];
}
sub kernel_files {
  my ($asmarch, $pari_version, $Using_gnu_as, $paridir) = (@_);
  return [] if $pari_version >= 2003000;
  return sparcv8_kernel_files_old($asmarch, $pari_version, $Using_gnu_as)
    if $asmarch =~ /^sparcv8/ and $pari_version < 2002006;
  return sparcv7_kernel_files($asmarch, $pari_version, $Using_gnu_as)
    if $asmarch eq 'sparcv7';
  my $sparcv8_kernel = ["sparcv8_micro/level0_common.S", 1,
                        "$asmarch/level0.S", 1];        # 2.2.* only
  # Default ["$asmarch/level0.s", 0]
  my %level0 = (
                alpha                => '',
                hppa                 => '', # was ['none/level0.c', 0] before 2.0015
        ($pari_version > 2002007
                ? (ppc               => ["none/level0.c", 0],
                   ia64              => ["ia64/level0.s", 0])
                : ()),
                ix86                 => ['ix86/l0asm.c',  1],
                m86k                 => ["none/level0.c", 0],
                none                 => ["none/level0.c", 0],
                # ppc is not done yet (2.0.15)
                sun3                 => '',
#               sparcv7              => '',
#               sparcv8              => $sparcv8_kernel,
                sparcv8_micro        => $sparcv8_kernel,
                sparcv8_super        => $sparcv8_kernel,
                # sparcv9 is not done yet (2.0.15)
               );
  return $level0{$asmarch} || ["$asmarch/level0.s", 0];
}
sub kernel_fill_data {
  my ($kernels, $hash) = (shift, shift);
  # The original file
  return unless @$kernels;
  $hash->{file1}     = "\$(PARI_DIR)/src/kernel/$kernels->[0]";
  $hash->{convert1}  = $kernels->[1];
  # The (possibly) preprocessed file
  $hash->{converted1}        = $hash->{convert1} ? 'kernel1.s' : $hash->{file1};
  # Extra bookkeeping
  ($hash->{header1}  = $hash->{file1}) =~ s/\.c$/.h/;
  $hash->{header1}   = '' unless -r $hash->{header1}; # Put as a dependence
  ($hash->{dir1}     = $hash->{file1}) =~ s/[^\/]*\.[csS]$//; # Include with -I
  # Additional file to compile (original and converted)
  $hash->{file2}     = $hash->{converted2} = "\$(PARI_DIR)/src/kernel/$kernels->[2]" if $kernels->[2];
  $hash->{file2}     = $hash->{converted2} = '' unless $kernels->[2];
  $hash->{converted2}        = 'kernel2.s' if $kernels->[3];
  $hash->{convert}   =  ($hash->{converted2} eq 'kernel2.s'
                            or $hash->{converted1} eq 'kernel1.s');
  if ( $^O =~ /win32/i
       and $Config{cc} =~ /\bcl/ # M$ VC doesn't understand .s
       and $hash->{converted1} eq 'kernel1.s' ) {
    $hash->{converted1} = 'kernel1.c';
  }
}
sub assembler_flags_via {
  my ($machine, $not_gnu_as) = (shift, shift);
  my %assf  = (
               # alpha  => "-O1",            # Not supported any more
               sparc  => ($Config{osname} eq 'solaris'
                          ? "-P -T -I."
                          : "-P -I."),
               hppa   => "+DA1.1",
              );
  my $assflags  = $assf{$machine =~ /sun3|sparc/ ? 'sparc' : $machine} || '';
  $assflags .= ' -D__GNUC__'    # hiremainder problem with gcc on Solaris
    if $not_gnu_as and $Config{gccversion};
  # Tested with Sun WorkShop 6 update 2 Compiler Common 6.2 Solaris_9_CBE 2001/04/02:
  $assflags .= ' -K PIC'        # check assembler message for hints
                # disable: leads to segfaults on Solaris
    if 0 and $not_gnu_as and $Config{cccdlflags} =~ /(^|\s)-K\s*(pic|PIC)\b/
      and $not_gnu_as =~ /(^|\W)-K\s+\{?(\w+,)PIC\b/;   # in GNU as, default???
  return $assflags;
}
sub assembler_flags {           # Backward compatibility
  my ($machine, $is_gnu_as) = (shift, shift);
  assembler_flags_via($machine, not $is_gnu_as);
}
sub extra_includes {
  my $pari_dir = shift;
  # Some #include directives assume us inside $pari_dir/OARCH; replace by src
  return join ' -I ', '', grep -d, "$pari_dir/src/systems/$^O", "$pari_dir/src";
}
sub build_funclists_ourselves ($) {
  my $pari_dir = shift;
  chdir "$pari_dir/src/desc"
    or die "Can't chdir to `$pari_dir/src/desc'";
  unless (-f 'pari.desc') {
    my $t = 'tmp-pari.desc';
    #warn "Running `$^X merge_822 ../functions/*/* > $t'...\n";
    system "$^X merge_822 ../functions/*/* > $t"
      and die "Can't run `$^X merge_822 ../functions/*/* > $t'";
    rename $t, 'pari.desc' or die "rename failed: $t => 'pari.desc'";
  }
  my %recipies;
  if (-f 'gen_help') {          # pre-2.2.13
    %recipies = (  'language/members.h'   => [[qw(gen_member)]],
                   'language/init.h'      => [[qw(gen_proto basic)],
                                              [qw(gen_help basic)]],
                   'gp/highlvl.h'         => [[qw(gen_proto highlevel)],
                                              [qw(gen_help highlevel)]],
                   'gp/gp_init.h'         => [[qw(gen_proto gp)],
                                              [qw(gen_help gp)]],
                 );
  } else {
    %recipies = (  'language/members.h'   => [[qw(gen_member)]],
                   'language/init.h'      => [[qw(gen_proto basic)]],
                   'gp/highlvl.h'         => [[qw(gen_proto highlevel)]],
                   'gp/gp_init.h'         => [[qw(gen_proto gp)]],
                 );
  }
  for my $outfile (keys %recipies) {
    next if -r "../$outfile";
    my $append = '>';
    for my $step (@{$recipies{$outfile}}) {
      #warn "Running `$^X @$step pari.desc $append ../$outfile-tmp'...\n";
      system "$^X @$step pari.desc $append ../$outfile-tmp"
        and die "Can't run `$^X @$step pari.desc $append ../$outfile-tmp'";
      $append = '>>';
    }
    rename "../$outfile-tmp", "../$outfile"
      or die "rename failed: ../$outfile-tmp => ../$outfile";
  }
  1;
}
sub build_funclists {
  my $pari_dir = shift;
  return unless -d "$pari_dir/src/desc"; # Old version, no autogeneration
  return if -f "$pari_dir/src/language/init.h"
        and -f "$pari_dir/src/desc/pari.desc";
  if (-f "$pari_dir/src/desc/Makefile") { # Old development version
    # Keeps checksum to update when needed; fake it
    open FL, "> $pari_dir/src/funclist" and close FL # Ignore errors
      unless -f "$pari_dir/src/funclist";
    (system("cd $pari_dir/src/desc && make")
     and system("cd $pari_dir/src/desc && make SHELL=cmd")
     or not -s "$pari_dir/src/desc/pari.desc") and
       (unlink("$pari_dir/src/desc/pari.desc"),
        die <<EOW);
###
###  Apparently, we failed to build function descriptions of GP/PARI.
###  Try editing $pari_dir/src/desc/Makefile - a typical reason
###  is a wrong value of SHELL for your system.  You can run make in
###  $pari_dir/src/desc manually too...
EOW
     } else {
       require Cwd;
       my $cwd = Cwd::cwd();
       my $res = eval { build_funclists_ourselves $pari_dir };
       chdir $cwd;
       die <<EOD unless $res;
$@
###
###  We do not know how to build function descriptions of GP/PARI.
###  Please build them manually (e.g., by building GP/PARI).
###
EOD
     }
}
HideShow 11 lines of Pod
=item ep_codes_from_file($filename,%hash,%names)
Adds to the %hash the string interface descriptions corresponding to
the numeric codes use in the file's entree array.  %hash is indexed by
by the numeric codes; the value are references to arrays with the corresponding
string interface descriptions.
Adds to %names the list of name => code values.
=cut
sub ep_codes_from_file ($\%\%) {
  my ($file, $descrh, $names) = (shift, shift, shift);
  local $_;
  open IN, "< $file" or warn "Cannot open `$file': $!" and return;
  while (<IN>) {
    next unless /^\s*{\s*\"/;
    chomp;
    warn("Unrecognized line: `$_'\n"), next
      unless /^\s*\{\s*"(\w+)"\s*,\s*(\d+)\s*,[^,]*,\s*\d+\s*,(?:\s*\d+\s*,)?\s*("((?:\\.|[^"])*)"|NULL)\s*(,|\})/;
    next unless defined $4;
    #print;
    my ($name, $code, $descr) = ($1, $2, $4);
    $descrh->{$code} = [] unless exists $descrh->{$code};
    push @{$descrh->{$code}}, $descr
      unless grep $descr eq $_, @{$descrh->{$code}};
    warn "! Duplicate code $code for function '$name' (was $names->{$name})\n"
      if defined $names->{$name};
    $names->{$name} = [$code, $descr];
  }
  close IN or warn "Cannot close `$file': $!";
}
HideShow 8 lines of Pod
=item ep_hash_report(%hash, %names, $fh)
Writes to $fh the diagnostic about problemes with the string interface
descriptions corresponding to the numeric codes.  If $fh is false,
returns TRUE if no problem were found.
=cut
my $expected_codes_as_in = '2.1.3';
# Not in 2.1.3
my ($dummy1, %old_expected_codes) = split /\s+/, qq(
                        13      GD0,L,D0,G,
                        34      vLLL
        );
my ($dummy2, %expected_codes) = split /\s+/, qq(
                        1       Gp
                        2       GG
                        3       GGG
                        4       GGGG
                        10      lG
                        11      L
                        12      GnP
                        14      GDn
                        16      ls
                        18      G
                        19      vLL
                        20      lGG
                        21      GL
                        22      GVI
                        23      GL
                        24      LG
                        25      GGD0,L,
                        26      GnG
                        27      V=GIp
                        28      GDVDI
                        29      GGp
                        30      lGGG
                        31      GDGDGD&
                        32      GGL
                        33      GGGD0,L,p
                        35      vLGG
                        37      V=GGIp
                        45      LGD0,L,
                        47      V=GGIDG
                        48      V=GGIDG
                        49      GGDVDVDI
                        57      vLs
                        59      vLGGGG
                        62      GD0,G,D0,G,D0,L,p
                        73      LV=GGIpD0,L,D0,L,
                        83      vV=GGI
                        84      vGVI
                        85      vS
                        86      vV=GGGI
                        87      vV=GID0,L,
                        91      GD0,L,DGp
                        96      GD0,L,DGp
                       );
# Some historic changes in interfaces we do not care about (E vs I)
my $t;
my %variations = map {($t = $expected_codes{$_}) =~ s/I/E/ ? ($_, $t) : ()}
  keys %expected_codes;
my %known_unimplemented = (57 => 1, 62 => 1);
sub ep_hash_report (\%;\%$) {
  my ($h, $names, $fh) = (shift, shift, shift);
  my ($c, @list);
  $names = {} unless defined $names;
  my @keys = grep {$_ ne 0 and $_ ne 99} keys %$h;
  if (@list = grep {not exists $h->{$_}} keys %expected_codes) {
    return unless $fh;
    print $fh <<EOP;
  Cosmetic only: the following numeric interfaces are not used any more:
EOP
    for $c (sort @list) {
      print $fh <<EOP;
    $c (was meaning "$expected_codes{$c}" in $expected_codes_as_in)
EOP
    }
  }
  if (@list = grep {not exists $expected_codes{$_}} @keys) {
    return unless $fh;
    print $fh <<EOP;
  Harmless: the following numeric interfaces are new:
EOP
    for $c (sort @list) {
      print $fh <<EOP;
    $c meaning "@{$h->{$c}}"
EOP
      my $list = join ", ", grep $names->{$_}[0] == $c, sort keys %$names;
      print $fh <<EOP;
      (appears for $list)
EOP
    }
  }
  if (@list = grep @{$h->{$_}} != 1, @keys) {
    return unless $fh;
    print $fh <<EOP;
  May be harmless: non-unique string interfaces for numeric interfaces:
EOP
    for $c (sort @list) {
      print $fh <<EOP;
    $c meaning "@{$h->{$c}}"
EOP
      my $list = join ", ", grep $names->{$_}[0] == $c, sort keys %$names;
      print $fh <<EOP;
      (appears for $list)
EOP
    }
  }
  if (@list = grep {exists $expected_codes{$_}
                      and "@{$h->{$_}}" ne $expected_codes{$_}
                        and "@{$h->{$_}}" ne $variations{$_}
                          and not $known_unimplemented{$_}} @keys) {
    return unless $fh;
    print $fh <<EOP;
  Possible problems with Math::Pari interface to GP/PARI:
        unexpected value of string interfaces for numeric interfaces:
EOP
    for $c (sort @list) {
      print $fh <<EOP;
    $c meaning "@{$h->{$c}}" (was meaning "$expected_codes{$c}" in $expected_codes_as_in)
EOP
      my $list = join ", ",
        grep {$names->{$_}[0] == $c and $names->{$_}[1] ne $expected_codes{$c}}
          sort keys %$names;
      print $fh <<EOP;
      (may affect functions $list)
EOP
    }
  }
  return 1;
}
HideShow 7 lines of Pod
=item ep_in_version($version)
Updates the list of codes for the given version of GP/PARI (formatted as in
2002002).
=cut
sub ep_in_version ($) {
  my $v = shift;
  if ($v >= 2002002) {
    my $c;
    for $c (qw(26 62)) {
      delete $expected_codes{$c};
    }
  }
}
HideShow 9 lines of Pod
=item code_C_translator()
Returns string for C code to translate code string to the interface number.
Due to a bug in C_constant(), need to translate C<''> to 9900 by hand outside
of this subroutine.
=cut
sub code_C_translator {
  # Some historic changes in interfaces we do not care about (E vs I)
  my %c = (%old_expected_codes, %expected_codes);
  my %codes;
  @codes{values %c} = keys %c;
  my $k;
  for $k (keys %codes) {
    (my $kk = $k) =~ s/I/E/g;
    $codes{$kk} = $codes{$k} unless exists $codes{$kk};
    ($kk = $k) =~ s/D0,G,/DG/g;                 # New alternative syntax
    $codes{$kk} = $codes{$k} unless exists $codes{$kk};
  }
  #$codes{''} = 9900;           # bug in C_constant - can't handle
  $codes{'p'} = 0;
  require ExtUtils::Constant;
  my @t = ExtUtils::Constant::constant_types(); # macro defs
  my @tt =
    ExtUtils::Constant::C_constant(
          'Math::Pari::func_type',
          'func_ord_by_type', undef, undef, undef, undef,
          map {{name => $_, value => $codes{$_}, macro => 1}} keys %codes);
  # 23 == 21  47==48  91 == 96 (this one unsupported)
  join '', @t, @tt;
}
HideShow 4 lines of Pod
=back
=cut
1;