@@ -1,5 +1,10 @@
# include <pari.h>
# include <language/anal.h>
+
+#ifdef HAVE_PARIPRIV
+# include <headers/paripriv.h>
+#endif
+
# include <gp/gp.h> /* init_opts */
/* On some systems /usr/include/sys/dl.h attempts to declare
@@ -193,6 +198,11 @@ long offStack;
#define pari_version_exp() PARI_VERSION_EXP
+#if PARI_VERSION_EXP >= 2002013
+# define prec precreal
+#endif
+
+
#if PARI_VERSION_EXP >= 2000018
GEN
@@ -268,6 +278,10 @@ wrongT(SV *sv, char *file, int line)
HV *pariStash; /* For quick id. */
HV *pariEpStash;
+#if PARI_VERSION_EXP >= 2002013 /* Probably earlier too */
+# define HAVE_FETCH_NAMED_VAR
+#else
+
/* Copied from anal.c. */
static entree *
installep(void *f, char *name, int len, int valence, int add, entree **table)
@@ -284,6 +298,7 @@ installep(void *f, char *name, int len, int valence, int add, entree **table)
ep->menu = 0;
return *table = ep;
}
+#endif /* PARI_VERSION_EXP >= 2002013 */
#if PARI_VERSION_EXP <= 2002000 /* Global after 2.2.0 */
static void
@@ -327,8 +342,12 @@ PARIvar(char *s)
#endif
long hash;
SV *sv;
- entree *ep = is_entry_intern(s, functions_hash, &hash);
+ entree *ep;
+#ifdef HAVE_FETCH_NAMED_VAR
+ ep = fetch_named_var(s);
+#else
+ ep = is_entry_intern(s, functions_hash, &hash);
if (ep) {
if (EpVALENCE(ep) != EpVAR)
croak("Got a function name instead of a variable");
@@ -336,7 +355,7 @@ PARIvar(char *s)
ep = installep(NULL, s, strlen(s), EpVAR, 7*sizeof(long),
functions_hash + hash);
manage_var(0,ep);
-#if 0
+# if 0
ep = (entree *)gpmalloc(sizeof(entree) + 7*BYTES_IN_LONG
+ s - olds + 1);
ep->name = (char *)ep + sizeof(entree) + 7*BYTES_IN_LONG;
@@ -359,9 +378,10 @@ PARIvar(char *s)
polun[nvar] = p1;
varentries[nvar++] = ep;
setlg(polvar, nvar+1);
-#endif
+# endif
}
-
+#endif /* !( defined HAVE_FETCH_NAMED_VAR ) */
+
#if 0
found:
#endif
@@ -443,7 +463,10 @@ findVariable(SV *sv, int generate)
s = name;
goto repeat;
}
-
+
+#ifdef HAVE_FETCH_NAMED_VAR
+ ep = fetch_named_var(s);
+#else
ep = is_entry_intern(s, functions_hash, &hash);
if (ep) {
@@ -454,6 +477,7 @@ findVariable(SV *sv, int generate)
functions_hash + hash);
manage_var(0,ep);
}
+#endif /* !( defined HAVE_FETCH_NAMED_VAR ) */
#if 0
olds = s;
@@ -847,6 +871,7 @@ setprecision(long digits)
return m;
}
+#if PARI_VERSION_EXP < 2002013
long
setseriesprecision(long digits)
{
@@ -855,6 +880,7 @@ setseriesprecision(long digits)
if(digits>0) {precdl = digits;}
return m;
}
+#endif /* PARI_VERSION_EXP < 2002013 */
static IV primelimit;
static UV parisize;
@@ -917,6 +943,72 @@ pari2mortalsv(GEN in, long oldavma)
return sv;
}
+typedef struct {
+ long items, bytes;
+ SV *acc;
+ int context;
+} heap_dumper_t;
+
+static void
+heap_dump_one(heap_dumper_t *d, GEN x)
+{
+ SV* tmp;
+
+ d->items++; d->bytes += 4*sizeof(long);
+ if(!x[0]) { /* user function */
+ d->bytes += strlen((char *)(x+2))/sizeof(long);
+ tmp = newSVpv((char*)(x+2),0);
+ } else if (x==bernzone) {
+ d->bytes += x[0];
+ tmp = newSVpv("bernzone",8);
+ } else { /* GEN */
+ d->bytes += taille(x);
+ tmp = pari_print(x);
+ }
+ /* add to output */
+ switch(d->context) {
+ case G_VOID:
+ case G_SCALAR: sv_catpvf(d->acc, " %2d: %s\n",
+ d->items - 1, SvPV_nolen(tmp));
+ SvREFCNT_dec(tmp); break;
+ case G_ARRAY: av_push((AV*)d->acc,tmp); break;
+ }
+}
+
+#if PARI_VERSION_EXP >= 2002013
+
+static void
+heap_dump_one_v(GEN x, void *v)
+{
+ heap_dumper_t *d = (heap_dumper_t *)v;
+
+ heap_dump_one(d, x);
+}
+
+static void
+heap_dumper(heap_dumper_t *d)
+{
+ traverseheap(&heap_dump_one_v, (void*)d);
+}
+
+#else /* !( PARI_VERSION_EXP >= 2002013 ) */
+
+static void
+heap_dumper(heap_dumper_t *d)
+{
+ /* create a new block on the heap so we can examine the linked list */
+ GEN tmp1 = newbloc(1); /* at least 1 to avoid warning */
+ GEN x = (GEN)bl_prev(tmp1);
+
+ killbloc(tmp1);
+
+ /* code adapted from getheap() in PARI src/language/init.c */
+ for(; x; x = (GEN)bl_prev(x))
+ heap_dump_one(d, x);
+}
+
+#endif /* !( PARI_VERSION_EXP >= 2002013 ) */
+
void
resetSVpari(SV* sv, GEN g, long oldavma)
{
@@ -1491,7 +1583,8 @@ extern void set_term_funcp3(FUNC_PTR change_p, void *term_p, TSET_FP tchange);
extern void v_set_term_ftable(void *a);
-#define s_type_name(x) type_name(typ(x));
+/* Cast off `const' */
+#define s_type_name(x) (char *)type_name(typ(x));
static int reset_on_reload = 0;
@@ -3441,6 +3534,7 @@ BOOT:
if (!pri || !SvOK(pri)) {
croak("$Math::Pari::initprimes not defined!");
}
+#if PARI_VERSION_EXP < 2002013 /* XXXX HOW to do otherwise */
if (reboot) {
detach_stack();
if (reset_on_reload)
@@ -3448,23 +3542,39 @@ BOOT:
else
allocatemoremem(1008);
}
+#endif
+#if PARI_VERSION_EXP >= 2002013
+ pari_init_defaults();
+#else
INIT_JMP_off;
INIT_SIG_off;
/* These guys are new in 2.0. */
init_defaults(1);
+#endif
if (!(reboot++)) {
#ifndef NO_HIGHLEVEL_PARI
+#if PARI_VERSION_EXP >= 2002013
+ pari_add_module(functions_highlevel);
+#else /* !( PARI_VERSION_EXP >= 2002013 ) */
pari_addfunctions(&pari_modules,
functions_highlevel, helpmessages_highlevel);
+#endif /* !( PARI_VERSION_EXP >= 2002013 ) */
init_graph();
#endif
}
primelimit = SvIV(pri);
parisize = SvIV(mem);
+#if PARI_VERSION_EXP >= 2002013
+ pari_init_opts(parisize, primelimit, INIT_DFTm);
+ /* Default: take four million bytes of
+ * memory for the stack, calculate
+ * primes up to 500000. */
+#else
init(parisize, primelimit); /* Default: take four million bytes of
* memory for the stack, calculate
* primes up to 500000. */
+#endif
PariStack = (SV *) GENfirstOnStack;
workErrsv = newSVpv("",0);
pariErr = &perlErr;
@@ -3525,47 +3635,28 @@ PPCODE:
void
dumpHeap()
PPCODE:
- /* create a new block on the heap so we can examine the linked list */
- GEN tmp = newbloc(1); /* at least 1 to avoid warning */
- GEN x = (GEN)bl_prev(tmp);
- long m = 0, l = 0;
- SV* ret = Nullsv; /* Avoid unit warning */
+ heap_dumper_t hd;
+ int context = GIMME_V, m;
- killbloc(tmp);
+ SV* ret = Nullsv; /* Avoid unit warning */
- switch(GIMME_V) {
+ switch(context) {
case G_VOID:
case G_SCALAR: ret = newSVpvn("",0); break;
case G_ARRAY: ret = (SV*)newAV(); break;
}
- /* code adapted from getheap() in PARI src/language/init.c */
- for(; x; x = (GEN)bl_prev(x)) {
- SV* tmp;
- m++; l += 4*sizeof(long);
- if(!x[0]) { /* user function */
- l += strlen((char *)(x+2))/sizeof(long);
- tmp = newSVpv((char*)(x+2),0);
- } else if (x==bernzone) {
- l += x[0];
- tmp = newSVpv("bernzone",8);
- } else { /* GEN */
- l += taille(x);
- tmp = pari_print(x);
- }
- /* add to output */
- switch(GIMME_V) {
- case G_VOID:
- case G_SCALAR: sv_catpvf(ret," %2d: %s\n",m-1,SvPV_nolen(tmp));
- SvREFCNT_dec(tmp); break;
- case G_ARRAY: av_push((AV*)ret,tmp); break;
- }
- }
+ hd.bytes = hd.items = 0;
+ hd.acc = ret;
+ hd.context = context;
+
+ heap_dumper(&hd);
- switch(GIMME_V) {
+ switch(context) {
case G_VOID:
case G_SCALAR: {
- SV* tmp = newSVpvf("heap had %d bytes (%d items)\n",l,m);
+ SV* tmp = newSVpvf("heap had %ld bytes (%ld items)\n",
+ hd.bytes, hd.items);
sv_catsv(tmp,ret);
SvREFCNT_dec(ret);
if(GIMME_V == G_VOID) {
@@ -1016,24 +1016,84 @@ sub extra_includes {
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";
- open FL, "> $pari_dir/src/funclist" and close FL # Ignore errors
- unless -f "$pari_dir/src/funclist";
- (system("cd $pari_dir/src/desc && make")
+ 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);
+ 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
+ }
}
=item ep_codes_from_file($filename,%hash,%names)