File: [local] / OpenXM_contrib / pari-2.2 / src / language / Attic / init.c (download)
Revision 1.2, Wed Sep 11 07:27:04 2002 UTC (21 years, 9 months ago) by noro
Branch: MAIN
CVS Tags: RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2
Changes since 1.1: +564 -468
lines
Upgraded pari-2.2 to pari-2.2.4.
|
/* $Id: init.c,v 1.164 2002/09/11 02:28:27 karim Exp $
Copyright (C) 2000 The PARI group.
This file is part of the PARI/GP package.
PARI/GP 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. It is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY WHATSOEVER.
Check the License for details. You should have received a copy of it, along
with the package; see the file 'COPYING'. If not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
/*******************************************************************/
/* */
/* INITIALIZING THE SYSTEM, ERRORS */
/* */
/*******************************************************************/
#include <string.h>
#include "pari.h"
#include "anal.h"
#ifdef _WIN32
# ifndef WINCE
# include <process.h>
# endif
#endif
/* Variables statiques communes : */
FILE *pari_outfile, *errfile, *logfile, *infile;
GEN *polun, *polx;
GEN gnil, gzero, gun, gdeux, ghalf, polvar, gi;
GEN gpi=NULL, geuler=NULL, bernzone=NULL;
GEN primetab; /* private primetable */
byteptr diffptr;
char *current_logfile, *current_psfile;
int gp_colors[c_LAST];
int disable_color = 1, added_newline = 1;
int functions_tblsz = 135; /* size of functions_hash */
entree **varentries;
void *global_err_data;
jmp_buf environnement;
long *ordvar;
ulong DEBUGFILES, DEBUGLEVEL, DEBUGMEM, compatible;
ulong prec, precdl;
ulong init_opts = INIT_JMPm | INIT_SIGm;
gpmem_t bot = 0, top = 0, avma;
size_t memused;
gp_data *GP_DATA = NULL;
void *foreignHandler; /* Handler for foreign commands. */
char foreignExprSwitch = 3; /* Just some unprobable char. */
GEN (*foreignExprHandler)(char*); /* Handler for foreign expressions.*/
entree * (*foreignAutoload)(char*, long); /* Autoloader */
void (*foreignFuncFree)(entree *); /* How to free external entree. */
int (*default_exception_handler)(long);
int (*whatnow_fun)(char *, int);
pariout_t DFLT_OUTPUT = { 'g', 0, -1, 1, 0, f_RAW };
extern void delete_dirs(gp_path *p);
extern void initout(int initerr);
extern int term_width(void);
#ifdef BOTH_GNUPLOT_AND_X11
/* Satisfy DLL dependencies: dummy only */
#define EXTERM_DLL_DPES *PL_markstack_ptr, PL_stack_max, *PL_Sv, *PL_stack_sp, \
*PL_tmps_floor, *PL_tmps_ix, *PL_markstack_max, *PL_stack_base, *PL_na, \
*PL_sv_yes, *PL_sv_no, *PL_curpad, *PL_op
extern int EXTERM_DLL_DPES;
int EXTERM_DLL_DPES;
#endif /* defined BOTH_GNUPLOT_AND_X11 */
typedef struct cell {
void *env;
void *data;
long flag;
} cell;
static stack *err_catch_stack = NULL;
static long *err_catch_array;
void
push_stack(stack **pts, void *a)
{
stack *v = (stack*) gpmalloc(sizeof(stack));
v->value = a;
v->prev = *pts; *pts = v;
}
void *
pop_stack(stack **pts)
{
stack *s = *pts, *v;
void *a;
if (!s) return NULL; /* initial value */
v = s->prev; *pts = v;
a = s->value; free((void*)s);
return a;
}
#ifdef STACK_CHECK
/*********************************************************************/
/* */
/* C STACK SIZE CONTROL */
/* (to avoid core dump on deep recursion) */
/* */
/*********************************************************************/
/* adapted from Perl code written by Dominic Dunlop */
#include <sys/resource.h>
void *PARI_stack_limit = NULL;
/* Set PARI_stack_limit to (a little above) the lowest safe address that can
* be used on the stack. Leave PARI_stack_limit at its initial value (NULL)
* to show no check should be made [init failed]. Assume stack grows downward.
*/
static void
pari_init_stackcheck(void *stack_base)
{
struct rlimit rip;
if (getrlimit(RLIMIT_STACK, &rip) || rip.rlim_cur == RLIM_INFINITY) return;
/* DEC cc doesn't like this line:
* PARI_stack_limit = stack_base - ((rip.rlim_cur/16)*15); */
PARI_stack_limit = (void*)((long)stack_base - (rip.rlim_cur/16)*15);
}
#endif /* STACK_CHECK */
/*********************************************************************/
/* */
/* SYSTEM INITIALIZATION */
/* */
/*********************************************************************/
static int var_not_changed; /* altered in reorder() */
static int try_to_recover = 0;
static long next_bloc;
static GEN cur_bloc=NULL; /* current bloc in bloc list */
static GEN universal_constants;
#if __MWERKS__
static void *
macalloc(size_t size)
{
OSErr resultCode;
Handle newH = TempNewHandle((size),&resultCode);
if (!newH) return NULL;
HLock(newH); return (void*) *newH;
}
# define __gpmalloc(size) ((size) > 1000000)? macalloc(size): malloc((size))
#else
# define __gpmalloc(size) (malloc(size))
#endif
char*
gpmalloc(size_t size)
{
if (size)
{
char *tmp = (char*)__gpmalloc(size);
if (!tmp) err(memer);
return tmp;
}
if (DEBUGMEM) err(warner,"mallocing NULL object");
return NULL;
}
char*
gprealloc(void *pointer, size_t size)
{
char *tmp;
if (!pointer) tmp = (char *) malloc(size);
else tmp = (char *) realloc(pointer,size);
if (!tmp) err(memer);
return tmp;
}
static void
pari_handle_SIGINT(void)
{
#ifdef _WIN32
if (++win32ctrlc >= 5) _exit(3);
#else
err(talker, "user interrupt");
#endif
}
static void
pari_sighandler(int sig)
{
char *msg;
(void)os_signal(sig,pari_sighandler);
switch(sig)
{
#ifdef SIGBREAK
case SIGBREAK: pari_handle_SIGINT(); return;
#endif
#ifdef SIGINT
case SIGINT: pari_handle_SIGINT(); return;
#endif
#ifdef SIGSEGV
case SIGSEGV:
msg="segmentation fault: bug in PARI or calling program";
break;
#endif
#ifdef SIGBUS
case SIGBUS:
msg="bus error: bug in PARI or calling program";
break;
#endif
#ifdef SIGFPE
case SIGFPE:
msg="floating point exception: bug in PARI or calling program";
break;
#endif
#ifdef SIGPIPE
case SIGPIPE:
msg="broken pipe";
break;
#endif
default:
msg="unknown signal";
}
err(talker,msg);
}
#ifdef _WIN32
int win32ctrlc = 0;
void
dowin32ctrlc()
{
win32ctrlc = 0;
err(talker,"user interrupt");
}
#endif
/* Initialize hashtable */
static void
init_hashtable(entree **table, int tblsz)
{
entree *ep, *ep1, *last;
long i, v;
for (i = 0; i < tblsz; i++)
{
last = NULL; ep = table[i]; table[i] = NULL;
for ( ; ep; ep = ep1)
{
ep1 = ep->next; v = EpVALENCE(ep);
if (v == EpVAR || v == EpINSTALL) /* keep this one */
{
if (last)
last->next = ep;
else
table[i] = ep;
last = ep; last->next = NULL;
}
else freeep(ep);
}
}
}
static void
fill_hashtable(entree **table, entree *ep, char **helpmessage)
{
long n;
for ( ; ep->name; ep++)
{
EpSETSTATIC(ep);
ep->help = helpmessage? *helpmessage++: NULL;
n = hashvalue(ep->name);
ep->next = table[n]; table[n] = ep;
ep->args = NULL;
}
}
void
init_defaults(int force)
{
static int done=0;
if (done && !force) return;
done = 1;
#ifdef LONG_IS_64BIT
prec=4;
#else
prec=5;
#endif
precdl = 16;
compatible = NONE;
DEBUGFILES = DEBUGLEVEL = DEBUGMEM = 0;
current_psfile = pari_strdup("pari.ps");
current_logfile= pari_strdup("pari.log");
logfile = NULL;
initout(1); next_bloc=0;
}
/* does elt belong to list, after position start (excluded) ? */
static int
list_isin(void **list, void *elt, int start)
{
long indelt=0;
if (list)
{
while (*list)
{
if (indelt>start && *list==elt) return indelt;
list++; indelt++;
}
}
return -1;
}
static void
list_prepend(void ***listptr, void *elt)
{
void **list=*listptr;
long nbelt=0;
if (list)
while (list[nbelt]) nbelt++;
list = (void **) gpmalloc(sizeof(void *)*(nbelt+2));
list[0]=elt;
if (nbelt)
{
memcpy(list+1,*listptr,nbelt*sizeof(void *));
free(*listptr);
}
list[nbelt+1]=NULL; *listptr=list;
}
/* Load modlist in hashtable hash. If force == 0, do not load twice the
* same list in the same hashtable, which would only destroy user variables.
* As it stands keep a complete history (instead of most recent changes).
*/
int
gp_init_entrees(module *modlist, entree **hash, int force)
{
static void **oldmodlist=NULL, **oldhash=NULL;
if (!force)
{
const long indhash = list_isin(oldhash,(void *)hash,-1);
if (indhash != -1 && oldmodlist[indhash]==modlist) return 0;
}
/* record the new pair (hash,modlist) */
list_prepend(&oldmodlist,(void *)modlist);
list_prepend(&oldhash,(void *)hash);
init_hashtable(hash,functions_tblsz);
while (modlist && modlist->func)
{
fill_hashtable(hash, modlist->func, modlist->help);
modlist++;
}
return (hash == functions_hash);
}
module *pari_modules = NULL;
module *pari_oldmodules = NULL;
module *pari_membermodules = NULL;
entree **functions_hash = NULL;
entree **funct_old_hash = NULL;
entree **members_hash = NULL;
/* add to modlist the functions in func, with helpmsg help */
void
pari_addfunctions(module **modlist_p, entree *func, char **help)
{
module *modlist = *modlist_p;
int nbmodules = 0;
while (modlist && modlist->func) { nbmodules++; modlist++; }
modlist = *modlist_p;
*modlist_p = (module*) gpmalloc(sizeof(module)*(nbmodules+2));
if (nbmodules)
{
memcpy(1+ *modlist_p, modlist, sizeof(module)*nbmodules);
free(modlist);
}
modlist = *modlist_p;
modlist->func = func;
modlist->help = help;
modlist += nbmodules+1;
modlist->func = NULL;
modlist->help = NULL;
}
void
pari_sig_init(void (*f)(int))
{
#ifdef SIGBUS
(void)os_signal(SIGBUS,f);
#endif
#ifdef SIGFPE
(void)os_signal(SIGFPE,f);
#endif
#ifdef SIGINT
(void)os_signal(SIGINT,f);
#endif
#ifdef SIGBREAK
(void)os_signal(SIGBREAK,f);
#endif
#ifdef SIGPIPE
(void)os_signal(SIGPIPE,f);
#endif
#ifdef SIGSEGV
(void)os_signal(SIGSEGV,f);
#endif
}
static void
reset_traps(int warn)
{
long i;
if (warn) err(warner,"missing cell in err_catch_stack. Resetting all traps");
for (i=0; i <= noer; i++) err_catch_array[i] = 0;
}
static void
init_universal_constants(void)
{
/* 2 (gnil) + 2 (gzero) + 3 (gun) + 3 (gdeux) + 3 (half) + 3 (gi) */
GEN p = universal_constants = (long*) gpmalloc(16*sizeof(long));
gzero = p; p+=2; gnil = p; p+=2;
gzero[0] = gnil[0] = evaltyp(t_INT) | evallg(2);
gzero[1] = gnil[1] = evallgefint(2);
gun = p; p+=3; gdeux = p; p+=3;
gun[0] = gdeux[0] = evaltyp(t_INT) | evallg(3);
gun[1] = gdeux[1] = evalsigne(1) | evallgefint(3);
gun[2] = 1; gdeux[2]= 2;
ghalf = p; p+=3; gi = p; p+=3;
ghalf[0] = evaltyp(t_FRAC) | evallg(3);
ghalf[1] = un;
ghalf[2] = deux;
gi[0] = evaltyp(t_COMPLEX) | evallg(3);
gi[1] = zero;
gi[2] = un;
}
static long
fix_size(size_t a)
{
/* BYTES_IN_LONG*ceil(a/BYTES_IN_LONG) */
size_t b = a+BYTES_IN_LONG - (((a-1) & (BYTES_IN_LONG-1)) + 1);
if (b > VERYBIGINT) err(talker,"stack too large");
if (b < 1024) b = 1024;
return b;
}
static long
init_stack(size_t size)
{
size_t s = fix_size(size), old = 0;
if (bot)
{
old = top - bot;
free((void*)bot);
}
/* NOT gpmalloc, memer would be deadly */
bot = (gpmem_t)__gpmalloc(s);
if (!bot)
for (s = old;; s>>=1)
{
if (!s) err(memer); /* no way out. Die */
err(warner,"not enough memory, new stack %lu",s);
bot = (gpmem_t)__gpmalloc(s);
if (bot) break;
}
avma = top = bot+s;
memused = 0; return s;
}
/* initialise les donnees de la bibliotheque PARI. Peut être précédée d'un
* appel à pari_addfunctions si on ajoute d'autres fonctions au pool de base.
*/
void
pari_init(size_t parisize, ulong maxprime)
{
long i;
#ifdef STACK_CHECK
pari_init_stackcheck(&i);
#endif
init_defaults(0);
if (INIT_JMP && setjmp(environnement))
{
fprintferr(" *** Error in the PARI system. End of program.\n");
exit(1);
}
if (INIT_SIG) pari_sig_init(pari_sighandler);
(void)init_stack(parisize);
diffptr = initprimes(maxprime);
init_universal_constants();
varentries = (entree**) gpmalloc((MAXVARN+1)*sizeof(entree*));
polvar = (GEN) gpmalloc((MAXVARN+1)*sizeof(long));
ordvar = (GEN) gpmalloc((MAXVARN+1)*sizeof(long));
polx = (GEN*) gpmalloc((MAXVARN+1)*sizeof(GEN));
polun = (GEN*) gpmalloc((MAXVARN+1)*sizeof(GEN));
polvar[0] = evaltyp(t_VEC) | evallg(1);
for (i=0; i <= MAXVARN; i++) { ordvar[i] = i; varentries[i] = NULL; }
(void)fetch_var(); /* create polx/polun[MAXVARN] */
primetab = (GEN) gpmalloc(1 * sizeof(long));
primetab[0] = evaltyp(t_VEC) | evallg(1);
pari_addfunctions(&pari_modules, functions_basic,helpmessages_basic);
functions_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
for (i = 0; i < functions_tblsz; i++) functions_hash[i] = NULL;
pari_addfunctions(&pari_oldmodules, oldfonctions,oldhelpmessage);
funct_old_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
for (i = 0; i < functions_tblsz; i++) funct_old_hash[i] = NULL;
gp_init_entrees(pari_oldmodules, funct_old_hash, 1);
if (new_fun_set)
gp_init_entrees(pari_modules, functions_hash, 1);
else
gp_init_entrees(pari_oldmodules, functions_hash, 1);
pari_addfunctions(&pari_membermodules, gp_member_list, NULL);
members_hash = (entree **) gpmalloc(sizeof(entree*)*functions_tblsz);
for (i = 0; i < functions_tblsz; i++) members_hash[i] = NULL;
gp_init_entrees(pari_membermodules, members_hash, 1);
whatnow_fun = NULL;
err_catch_array = (long *) gpmalloc((noer + 1) *sizeof(long));
reset_traps(0);
default_exception_handler = NULL;
(void)manage_var(2,NULL); /* init nvar */
var_not_changed = 1; (void)fetch_named_var("x", 0);
try_to_recover=1;
}
static void
delete_hist(gp_hist *h)
{
if (h->res) free((void*)h->res);
}
static void
delete_pp(gp_pp *p)
{
if (p->cmd) free((void*)p->cmd);
}
static void
delete_path(gp_path *p)
{
delete_dirs(p);
free((void*)p->PATH);
}
static void
free_gp_data(gp_data *D)
{
if (!D) return;
delete_hist(D->hist);
delete_path(D->path);
delete_pp(D->pp);
if (D->help) free((void*)D->help);
}
void
freeall(void)
{
long i;
entree *ep,*ep1;
while (delete_var()) /* empty */;
for (i = 0; i < functions_tblsz; i++)
{
for (ep = functions_hash[i]; ep; ep = ep1) { ep1 = ep->next; freeep(ep); }
for (ep = members_hash[i]; ep; ep = ep1) { ep1 = ep->next; freeep(ep); }
}
free((void*)varentries);
free((void*)ordvar);
free((void*)polvar);
free((void*)polx[MAXVARN]);
free((void*)polx);
free((void*)polun);
free((void*)primetab);
free((void*)universal_constants);
/* set first cell to 0 to inhibit recursion in all cases */
while (cur_bloc) { *cur_bloc=0; killbloc(cur_bloc); }
killallfiles(1);
free((void *)functions_hash);
free((void *)bot);
free((void *)diffptr);
free(current_logfile);
free(current_psfile);
free_gp_data(GP_DATA);
}
GEN
getheap(void)
{
long m=0,l=0;
GEN x;
for (x = cur_bloc; x; x = (GEN)bl_prev(x))
{
m++; l+=4;
if (! x[0]) /* user function */
l += (strlen((char *)(x+2))) / sizeof(long);
else if (x==bernzone)
l += x[0];
else /* GEN */
l += taille(x);
}
x=cgetg(3,t_VEC); x[1]=lstoi(m); x[2]=lstoi(l);
return x;
}
/* Return x, where:
* x[-3]: adress of next bloc
* x[-2]: adress of preceding bloc.
* x[-1]: number of allocated blocs.
* x[0..n-1]: malloc-ed memory.
*/
GEN
newbloc(long n)
{
long *x = (long *) gpmalloc((n + BL_HEAD)*sizeof(long)) + BL_HEAD;
bl_next(x) = 0; /* the NULL address */
bl_prev(x) = (long)cur_bloc;
bl_num(x) = next_bloc++;
if (n) *x = 0; /* initialize first cell to 0. See killbloc */
if (cur_bloc) bl_next(cur_bloc) = (long)x;
if (DEBUGMEM)
{
if (!n) err(warner,"mallocing NULL object in newbloc");
if (DEBUGMEM > 2)
fprintferr("new bloc, size %6lu (no %ld): %08lx\n", n, next_bloc-1, x);
}
return cur_bloc = x;
}
/* recursively look for clones in the container and kill them */
static void
inspect(GEN x)
{
long i, lx;
switch(typ(x)) /* HACK: if x is not a GEN, we have typ(x)=0 */
{
case t_VEC: case t_COL: case t_MAT:
lx = lg(x);
for (i=1;i<lx;i++) inspect((GEN)x[i]);
break;
case t_LIST:
lx = lgef(x);
for (i=2;i<lx;i++) inspect((GEN)x[i]);
break;
}
if (isclone(x)) gunclone(x); /* Don't inspect here! components are dead */
}
/* If insp is set, recursively inspect x, killing all clones found. The GP
* expression x[i] = y is implemented as x[i] := gclone(y) and we need to
* reclaim the memory. Useless to inspect when x does not correspond to a GP
* variable [not dangerous, though] */
void
killbloc0(GEN x, int insp)
{
if (!x || isonstack(x)) return;
if (bl_next(x)) bl_prev(bl_next(x)) = bl_prev(x);
else
{
cur_bloc = (GEN)bl_prev(x);
next_bloc = bl_num(x);
}
if (bl_prev(x)) bl_next(bl_prev(x)) = bl_next(x);
if (DEBUGMEM > 2)
fprintferr("killing bloc (no %ld): %08lx\n", bl_num(x), x);
if (insp)
{ /* FIXME: SIGINT should be blocked until inspect() returns */
unsetisclone(x); /* important: oo recursion otherwise */
inspect(x);
}
free((void *)bl_base(x));
}
void
killbloc(GEN x) { killbloc0(x,1); }
void
gunclone(GEN x) { killbloc0(x,0); }
/********************************************************************/
/** **/
/** VARIABLE ORDERING **/
/** **/
/********************************************************************/
/* Substitution globale des composantes du vecteur y aux variables de x */
GEN
changevar(GEN x, GEN y)
{
long tx, ty, lx, vx, vy, i;
gpmem_t av, tetpil;
GEN p1,p2,z;
if (var_not_changed && y==polvar) return x;
tx=typ(x); if (!is_recursive_t(tx)) return gcopy(x);
ty=typ(y); if (! is_vec_t(ty)) err(changer1);
if (is_scalar_t(tx))
{
if (tx!=t_POLMOD) return gcopy(x);
av=avma;
p1=changevar((GEN)x[1],y);
p2=changevar((GEN)x[2],y); tetpil=avma;
return gerepile(av,tetpil, gmodulcp(p2,p1));
}
if (is_rfrac_t(tx))
{
av=avma;
p1=changevar((GEN)x[1],y);
p2=changevar((GEN)x[2],y); tetpil=avma;
return gerepile(av,tetpil, gdiv(p1,p2));
}
lx = (tx==t_POL)? lgef(x): lg(x);
if (tx == t_POL || tx == t_SER)
{
vx=varn(x)+1; if (vx>=lg(y)) return gcopy(x);
p1=(GEN)y[vx];
if (!signe(x))
{
vy=gvar(p1); if (vy>MAXVARN) err(changer1);
z=gcopy(x); setvarn(z,vy); return z;
}
av=avma; p2=changevar((GEN)x[lx-1],y);
for (i=lx-2; i>=2; i--)
{
p2 = gmul(p2,p1);
p2 = gadd(p2, changevar((GEN)x[i],y));
}
if (tx==t_SER)
{
p2 = gadd(p2, ggrando(p1,lx-2));
if (valp(x))
p2 = gmul(gpuigs(p1,valp(x)), p2);
}
return gerepileupto(av,p2);
}
z=cgetg(lx,tx);
for (i=1; i<lx; i++) z[i]=lchangevar((GEN)x[i],y);
return z;
}
GEN
reorder(GEN x)
{
long tx,lx,i,n, nvar = manage_var(3,NULL);
int *var,*varsort,*t1;
if (!x) return polvar;
tx=typ(x); lx=lg(x)-1;
if (! is_vec_t(tx)) err(typeer,"reorder");
if (! lx) return polvar;
varsort = (int *) gpmalloc(lx*sizeof(int));
var = (int *) gpmalloc(lx*sizeof(int));
t1 = (int *) gpmalloc(nvar*sizeof(int));
for (n=0; n<nvar; n++) t1[n] = 0;
for (n=0; n<lx; n++)
{
var[n] = i = gvar((GEN)x[n+1]);
varsort[n] = ordvar[var[n]]; /* position in polvar */
if (i >= nvar) err(talker,"variable out of range in reorder");
/* check if x is a permutation */
if (t1[i]) err(talker,"duplicated indeterminates in reorder");
t1[i] = 1;
}
qsort(varsort,lx,sizeof(int),(QSCOMP)pari_compare_int);
for (n=0; n<lx; n++)
{
/* variables are numbered 0,1 etc... while polvar starts at 1. */
polvar[varsort[n]+1] = lpolx[var[n]];
ordvar[var[n]] = varsort[n];
}
var_not_changed=1;
for (i=0; i<nvar; i++)
if (ordvar[i]!=i) { var_not_changed=0; break; }
free(t1); free(var); free(varsort);
return polvar;
}
/*******************************************************************/
/* */
/* ERROR RECOVERY */
/* */
/*******************************************************************/
extern int pop_val_if_newer(entree *ep, long loc);
extern void kill_from_hashlist(entree *ep);
/* if flag = 0: record address of next bloc allocated.
* if flag = 1: (after an error) recover all memory allocated since last call
*/
void
recover(int flag)
{
static long listloc;
long n;
entree *ep, *epnext;
void (*sigfun)(int);
if (!flag) { listloc = next_bloc; return; }
/* disable recover() and SIGINT. Better: sigint_[block|release] as in
* readline/rltty.c ? */
try_to_recover=0;
sigfun = os_signal(SIGINT, SIG_IGN);
for (n = 0; n < functions_tblsz; n++)
for (ep = functions_hash[n]; ep; ep = epnext)
{
epnext = ep->next;
switch(EpVALENCE(ep))
{
case EpVAR:
while (pop_val_if_newer(ep,listloc)) /* empty */;
break;
case EpNEW:
kill_from_hashlist(ep);
break;
case EpUSER:
case EpALIAS:
case EpMEMBER:
if (bl_num(ep->value) >= listloc)
{
gunclone((GEN)ep->value);
ep->value = (void*)initial_value(ep);
kill_from_hashlist(ep);
}
}
}
#if 0
/* This causes SEGV on lists and GP-2.0 vectors: internal component is
* destroyed while global object is not updated. Two solutions:
* - comment it out: should not be a big memory problem except for huge
* vec. components. Has the added advantadge that the results computed so
* far are not lost.
*
* - tag every variable whose component has been modified in the last
* cycle. Untag it at the begining of each cycle. Maybe this should be
* done. But do we really want to destroy a huge global vector if one of
* its components was modified before the error ? (we don't copy the whole
* thing anymore). K.B.
*/
{
GEN y;
for (x = cur_bloc; x && bl_num(x) >= listloc; x = y)
{
y = (GEN)bl_prev(x);
if (x != gpi && x != geuler && x != bernzone) killbloc(x);
}
}
#endif
try_to_recover=1;
(void)os_signal(SIGINT, sigfun);
}
void
disable_dbg(long val)
{
static long oldval = -1;
if (val < 0)
{
if (oldval >= 0) { DEBUGLEVEL = oldval; oldval = -1; }
}
else if (DEBUGLEVEL)
{ oldval = DEBUGLEVEL; DEBUGLEVEL = val; }
}
#define MAX_PAST 25
#define STR_LEN 20
/* Outputs a beautiful error message (not \n terminated)
* msg is errmessage to print.
* s points to the offending chars.
* entry tells how much we can go back from s[0].
*/
void
errcontext(char *msg, char *s, char *entry)
{
int past = (s-entry);
char str[STR_LEN + 2];
char *buf, *t, *pre;
if (!s || !entry) { print_prefixed_text(msg," *** ",NULL); return; }
t = buf = gpmalloc(strlen(msg) + MAX_PAST + 5 + 2 * 16);
sprintf(t,"%s: ", msg);
if (past <= 0) past = 0;
else
{
t += strlen(t);
if (past > MAX_PAST) { past=MAX_PAST; strcpy(t, "..."); t += 3; }
strcpy(t, term_get_color(c_OUTPUT));
t += strlen(t);
strncpy(t, s - past, past); t[past] = 0;
}
t = str; if (!past) *t++ = ' ';
strncpy(t, s, STR_LEN); t[STR_LEN] = 0;
pre = gpmalloc(2 * 16 + 1);
strcpy(pre, term_get_color(c_ERR));
strcat(pre, " *** ");
print_prefixed_text(buf, pre, str);
free(buf); free(pre);
}
void *
err_catch(long errnum, jmp_buf env, void *data)
{
cell *v;
/* for fear of infinite recursion don't trap memory errors */
if (errnum == memer) err(talker, "can't trap memory errors");
if (errnum < 0) errnum = noer;
if (errnum > noer) err(talker, "no such error number: %ld", errnum);
v = (cell*)gpmalloc(sizeof(cell));
v->data = data;
v->env = env;
v->flag = errnum;
err_catch_array[errnum]++;
push_stack(&err_catch_stack, (void*)v);
return (void*)v;
}
static void
pop_catch_cell(stack **s)
{
cell *c = (cell*)pop_stack(s);
if (c)
{
err_catch_array[c->flag]--;
free(c);
}
}
/* kill last handler for error n */
static void
err_leave_default(long n)
{
stack *s = err_catch_stack, *lasts;
if (n < 0) n = noer;
if (!s || !err_catch_array[n]) return;
for (lasts = NULL; s; lasts = s, s = s->prev)
if (((cell*)s->value)->flag == n) break;
pop_catch_cell(&s);
if (!lasts) err_catch_stack = s; else lasts->prev = s;
}
/* reset traps younger than V (included) */
void
err_leave(void **V)
{
cell *v = (cell*)*V;
while (err_catch_stack)
{
cell *t = (cell*)err_catch_stack->value;
pop_catch_cell(&err_catch_stack);
if (t == v) return;
}
reset_traps(1);
}
/* We know somebody is trapping n (from err_catch_array).
* Get last (most recent) handler for error n (or generic noer) killing all
* more recent non-applicable handlers (now obsolete) */
static cell *
err_seek(long n)
{
while (err_catch_stack)
{
cell *t = err_catch_stack->value;
if (t->flag == n || t->flag == noer) return t;
pop_catch_cell(&err_catch_stack);
}
reset_traps(1); return NULL;
}
/* untrapped error: find oldest trap depending from a longjmp, and kill
* everything more recent */
void
err_clean(void)
{
stack *s = err_catch_stack, *lasts = NULL;
for ( ; s; s = s->prev)
{
cell *c = (cell*)s->value;
if (c->env) lasts = s;
}
if (lasts)
{
void *c = (void*)s->value;
err_leave(&c);
}
}
static int
is_warn(long num)
{
return num == warner || num == warnmem || num == warnfile || num == warnprec;
}
void
err_recover(long numerr)
{
initout(0);
disable_dbg(-1);
killallfiles(0);
if (pariErr->die) pariErr->die(); /* Caller wants to catch exceptions? */
global_err_data = NULL;
err_clean();
fprintferr("\n"); flusherr();
if (!environnement) exit(1);
/* reclaim memory stored in "blocs" */
if (try_to_recover) recover(1);
longjmp(environnement, numerr);
}
void
err(long numerr, ...)
{
char s[128], *ch1;
int ret = 0;
PariOUT *out = pariOut;
va_list ap;
cell *trapped = NULL;
va_start(ap,numerr);
global_err_data = NULL;
if (err_catch_stack && !is_warn(numerr))
{
if (!err_catch_array[numerr] && !err_catch_array[noer]) err_clean();
else if ( (trapped = err_seek(numerr)) )
{
void *e = trapped->env;
if (e)
{
if (numerr == invmoder)
{
(void)va_arg(ap, char*); /* junk 1st arg */
global_err_data = (void*)va_arg(ap, GEN);
}
longjmp(e, numerr);
}
global_err_data = trapped->data;
}
}
if (!added_newline) { pariputc('\n'); added_newline=1; }
pariflush(); pariOut = pariErr;
pariflush(); term_color(c_ERR);
if (numerr < talker)
{
strcpy(s, errmessage[numerr]);
switch (numerr)
{
case obsoler:
ch1 = va_arg(ap,char *);
errcontext(s,ch1,va_arg(ap,char *));
if (whatnow_fun)
{
term_color(c_NONE);
print_text("\nFor full compatibility with GP 1.39, type \"default(compatible,3)\" (you can also set \"compatible = 3\" in your GPRC file)");
pariputc('\n');
ch1 = va_arg(ap,char *);
(void)whatnow_fun(ch1, - va_arg(ap,int));
}
break;
case openfiler:
sprintf(s+strlen(s), "%s file", va_arg(ap,char*));
ch1 = va_arg(ap,char *);
errcontext(s,ch1,ch1); break;
case talker2:
case member:
strcat(s,va_arg(ap, char*)); /* fall through */
default:
ch1 = va_arg(ap,char *);
errcontext(s,ch1,va_arg(ap,char *));
}
}
else if (numerr == user)
{
GEN *g = va_arg(ap, GEN*);
pariputsf(" ### user error: ");
print0(g, f_RAW);
}
else
{
pariputsf(" *** %s", errmessage[numerr]);
switch (numerr)
{
case talker: case siginter: case invmoder:
ch1=va_arg(ap, char*);
vpariputs(ch1,ap); pariputc('.'); break;
case impl:
ch1=va_arg(ap, char*);
pariputsf(" %s is not yet implemented.",ch1); break;
case breaker: case typeer: case mattype1: case overwriter:
case accurer: case infprecer: case negexper: case polrationer:
case funder2: case constpoler: case notpoler: case redpoler:
case zeropoler: case consister: case flagerr: case precer:
pariputsf(" in %s.",va_arg(ap, char*)); break;
case bugparier:
pariputsf(" %s, please report",va_arg(ap, char*)); break;
case operi: case operf:
{
char *f, *op = va_arg(ap, char*);
GEN x = va_arg(ap, GEN);
GEN y = va_arg(ap, GEN);
if (*op == '+') f = "addition";
else if (*op == '*') f = "multiplication";
else if (*op == '/' || *op == '%' || *op == '\\') f = "division";
else if (*op == 'g') { op = ","; f = "gcd"; }
else { op = "-->"; f = "assignment"; }
pariputsf(" %s %s %s %s.",f,type_name(typ(x)),op,type_name(typ(y)));
break;
}
/* the following 4 are only warnings (they return) */
case warnmem: case warner:
pariputc(' '); ch1=va_arg(ap, char*);
vpariputs(ch1,ap); pariputs(".\n");
ret = 1; break;
case warnprec:
vpariputs(" in %s; new prec = %ld\n",ap);
ret = 1; break;
case warnfile:
ch1=va_arg(ap, char*);
pariputsf(" %s: %s", ch1, va_arg(ap, char*));
ret = 1; break;
}
}
term_color(c_NONE); va_end(ap);
if (numerr==errpile)
{
fprintferr("\n current stack size: %lu (%.3f Mbytes)\n",
top-bot, (top-bot)/1048576.);
fprintferr(" [hint] you can increase GP stack with allocatemem()\n");
}
pariOut = out;
if (ret || (trapped && default_exception_handler &&
default_exception_handler(numerr))) { flusherr(); return; }
err_recover(numerr);
}
/* Try f (trapping error e), recover using r (break_loop, if NULL) */
GEN
trap0(char *e, char *r, char *f)
{
long numerr = -1;
GEN x = gnil;
char *F;
if (!strcmp(e,"errpile")) numerr = errpile;
else if (!strcmp(e,"typeer")) numerr = typeer;
else if (!strcmp(e,"gdiver2")) numerr = gdiver2;
else if (!strcmp(e,"invmoder")) numerr = invmoder;
else if (!strcmp(e,"accurer")) numerr = accurer;
else if (!strcmp(e,"archer")) numerr = archer;
else if (*e) err(impl,"this trap keyword");
/* TO BE CONTINUED */
if (f && r)
{ /* explicit recovery text */
char *a = get_analyseur();
gpmem_t av = avma;
CATCH(numerr) { x = NULL; }
TRY { x = lisseq(f); } ENDCATCH;
if (!x) { avma = av; x = lisseq(r); }
set_analyseur(a); return x;
}
F = f? f: r; /* define a default handler */
/* default will execute F (or start a break loop), then jump to
* environnement */
if (F)
{
if (!*F || (*F == '"' && F[1] == '"')) /* unset previous handler */
{/* TODO: find a better interface
* TODO: no leaked handler from the library should have survived
*/
err_leave_default(numerr);
return x;
}
F = pari_strdup(F);
}
(void)err_catch(numerr, NULL, F);
return x;
}
/*******************************************************************/
/* */
/* CLONING & COPY */
/* Replicate an existing GEN */
/* */
/*******************************************************************/
/* lontyp = 0 means non recursive type
* otherwise:
* lontyp = number of codewords
* if not in stack, we don't copy the words in [lontyp,lontyp2[
*/
const long lontyp[] = { 0,0,0,1,1,1,1,2,1,1, 2,2,0,1,1,1,1,1,1,1, 2,0,0 };
static long lontyp2[] = { 0,0,0,2,1,1,1,3,2,2, 2,2,0,1,1,1,1,1,1,1, 2,0,0 };
/* can't do a memcpy there: avma and x may overlap. memmove is slower */
GEN
gcopy(GEN x)
{
long tx=typ(x),lx,i;
GEN y;
if (tx == t_SMALL) return x;
if (! is_recursive_t(tx))
{
if (tx == t_INT && !signe(x)) return gzero; /* very common case */
lx = lg(x); y = new_chunk(lx);
for (i=lx-1; i>=0; i--) y[i]=x[i];
}
else
{
lx = lg(x); y = new_chunk(lx);
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
for ( ; i<lontyp2[tx]; i++) copyifstack(x[i],y[i]);
for ( ; i<lx; i++) y[i]=lcopy((GEN)x[i]);
}
unsetisclone(y); return y;
}
GEN
gcopy_i(GEN x, long lx)
{
long tx=typ(x),i;
GEN y;
if (tx == t_SMALL) return x;
y=cgetg(lx,tx);
if (! is_recursive_t(tx))
for (i=lx-1; i>0; i--) y[i]=x[i];
else
{
for (i=1; i<lontyp[tx]; i++) y[i]=x[i];
for ( ; i<lontyp2[tx]; i++) copyifstack(x[i],y[i]);
for ( ; i<lx; i++) y[i]=lcopy((GEN)x[i]);
}
unsetisclone(y); return y;
}
GEN
forcecopy(GEN x)
{
long tx=typ(x),lx,i;
GEN y;
if (tx == t_SMALL) return x;
if (! is_recursive_t(tx))
{
if (tx == t_INT && !signe(x)) return gzero; /* very common case */
lx = lg(x); y = new_chunk(lx);
for (i=lx-1; i>=0; i--) y[i]=x[i];
}
else
{
lx = lg(x); y = new_chunk(lx);
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i]=x[i];
for ( ; i<lx; i++) y[i]=(long)forcecopy((GEN)x[i]);
}
unsetisclone(y); return y;
}
GEN
dummycopy(GEN x)
{
long tx=typ(x), lx=lg(x),i;
GEN y=new_chunk(lx);
switch(tx)
{
case t_POLMOD:
y[1]=x[1]; y[2]=(long)dummycopy((GEN)x[2]);
break;
case t_MAT:
for (i=lx-1;i;i--) y[i]=(long)dummycopy((GEN)x[i]);
break;
default:
for (i=lx-1;i;i--) y[i]=x[i];
}
y[0]=x[0]; return y;
}
/* copy x as if avma = *AVMA, update *AVMA */
GEN
gcopy_av(GEN x, GEN *AVMA)
{
long i,lx,tx=typ(x);
GEN y;
if (tx == t_SMALL) return x;
lx = lg(x); *AVMA = y = *AVMA - lx;
if (! is_recursive_t(tx))
{
for (i=0; i<lx; i++) y[i] = x[i];
}
else
{
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], AVMA);
}
unsetisclone(y); return y;
}
/* same but use NULL to code an exact 0 */
static GEN
gcopy_av0(GEN x, GEN *AVMA)
{
long i,lx,tx=typ(x);
GEN y;
if (! is_recursive_t(tx))
{
if (tx == t_INT && !signe(x)) return NULL; /* special marker */
if (tx == t_SMALL) return x;
lx = lg(x); *AVMA = y = *AVMA - lx;
for (i=0; i<lx; i++) y[i] = x[i];
}
else
{
lx = lg(x); *AVMA = y = *AVMA - lx;
if (tx==t_POL || tx==t_LIST) lx = lgef(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
for ( ; i<lx; i++) y[i] = (long)gcopy_av0((GEN)x[i], AVMA);
}
unsetisclone(y); return y;
}
/* size of a gcopy_av0 */
static long
taille0(GEN x)
{
long i,n,lx, tx = typ(x);
if (!is_recursive_t(tx))
{
if (tx == t_INT && !signe(x)) return 0;
n = lg(x);
}
else
{
n = lg(x);
lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
for (i=lontyp[tx]; i<lx; i++) n += taille0((GEN)x[i]);
}
return n;
}
long
taille(GEN x)
{
long i,n,lx, tx = typ(x);
n = lg(x);
if (is_recursive_t(tx))
{
lx = (tx==t_POL || tx==t_LIST)? lgef(x): n;
for (i=lontyp[tx]; i<lx; i++) n += taille((GEN)x[i]);
}
return n;
}
long
taille2(GEN x) { return taille(x)<<TWOPOTBYTES_IN_LONG; }
GEN
gclone(GEN x)
{
long i,lx,tx = typ(x), t = taille(x);
GEN y = newbloc(t);
if (!is_recursive_t(tx))
{
lx = (tx==t_INT)? lgefint(x): lg(x);
for (i=0; i<lx; i++) y[i] = x[i];
}
else
{
GEN AVMA = y+t;
lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
for (i=0; i<lontyp[tx]; i++) y[i] = x[i];
for ( ; i<lx; i++) y[i] = (long)gcopy_av((GEN)x[i], &AVMA);
}
setisclone(y); return y;
}
void
shiftaddress(GEN x, long dec)
{
long i,lx,tx;
tx = typ(x);
if (is_recursive_t(tx))
{
lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
for (i=lontyp[tx]; i<lx; i++) {
if (!x[i]) x[i] = zero;
else
{
x[i] += dec;
shiftaddress((GEN)x[i], dec);
}
}
}
}
/* return a clone of x structured as a gcopy */
GENbin*
copy_bin(GEN x)
{
long t = taille0(x);
GENbin *p = (GENbin*)gpmalloc(sizeof(GENbin) + t*sizeof(long));
GEN AVMA = GENbase(p) + t;
p->len = t;
p->x = gcopy_av0(x, &AVMA);
p->base= AVMA; return p;
}
/* p from copy_bin. Copy p->x back to stack, then destroy p */
GEN
bin_copy(GENbin *p)
{
GEN x,y,base;
long dx,len;
x = p->x; if (!x) { free(p); return gzero; }
len = p->len;
base= p->base; dx = x - base;
y = (GEN)memcpy((void*)new_chunk(len), (void*)GENbase(p), len*sizeof(long));
y += dx; shiftaddress(y, (y-x)*sizeof(long));
free(p); return y;
}
/*******************************************************************/
/* */
/* STACK MANAGEMENT */
/* */
/*******************************************************************/
/* Inhibit some area gerepile-wise: declare it to be a non recursive
* type, of length l. Thus gerepile won't inspect the zone, just copy it.
* For the following situation:
* z = cgetg(t,a); garbage of length l;
* for (i=1; i<HUGE; i++) z[i] = ...
* stackdummy(z,l); z += l; We lose l words but save a costly gerepile.
*/
void
stackdummy(GEN z, long l) { z[0] = evaltyp(t_VECSMALL) | evallg(l); }
/* gerepileupto(av, forcecopy(x)) */
GEN
gerepilecopy(gpmem_t av, GEN x)
{
GENbin *p = copy_bin(x);
avma = av; return bin_copy(p);
}
/* Takes an array of pointers to GENs, of length n. Copies all
* objects to contiguous locations and cleans up the stack between
* av and avma. */
void
gerepilemany(gpmem_t av, GEN* gptr[], int n)
{
GENbin **l = (GENbin**)gpmalloc(n*sizeof(GENbin*));
int i;
for (i=0; i<n; i++) l[i] = copy_bin(*(gptr[i]));
avma = av;
for (i=0; i<n; i++) *(gptr[i]) = bin_copy(l[i]);
free(l);
}
void
gerepileall(gpmem_t av, int n, ...)
{
GENbin **l = (GENbin**)gpmalloc(n*sizeof(GENbin*));
GEN **gptr = (GEN**) gpmalloc(n*sizeof(GEN*));
int i;
va_list a; va_start(a, n);
for (i=0; i<n; i++) { gptr[i] = va_arg(a,GEN*); l[i] = copy_bin(*(gptr[i])); }
avma = av;
for (--i; i>=0; i--) *(gptr[i]) = bin_copy(l[i]);
free(l); free(gptr);
}
void
gerepilemanycoeffs(gpmem_t av, GEN x, int n)
{
int i;
for (i=0; i<n; i++) x[i] = (long)copy_bin((GEN)x[i]);
avma = av;
for (i=0; i<n; i++) x[i] = (long)bin_copy((GENbin*)x[i]);
}
void
gerepilemanycoeffs2(gpmem_t av, GEN x, int n, GEN y, int o)
{
int i;
for (i=0; i<n; i++) x[i] = (long)copy_bin((GEN)x[i]);
for (i=0; i<o; i++) y[i] = (long)copy_bin((GEN)y[i]);
avma = av;
for (i=0; i<n; i++) x[i] = (long)bin_copy((GENbin*)x[i]);
for (i=0; i<o; i++) y[i] = (long)bin_copy((GENbin*)y[i]);
}
/* Takes an array of pointers to GENs, of length n.
* Cleans up the stack between av and tetpil, updating those GENs. */
void
gerepilemanysp(gpmem_t av, gpmem_t tetpil, GEN* gptr[], int n)
{
const gpmem_t av2 = avma;
const size_t dec = av-tetpil;
int i;
(void)gerepile(av,tetpil,NULL);
for (i=0; i<n; i++)
{
gpmem_t *g1 = (gpmem_t*) gptr[i];
if (*g1 < tetpil)
{
if (*g1 >= av2) *g1 += dec; /* Update address if in stack */
else if (*g1 >= av) err(gerper);
}
}
}
/* Takes an array of GENs (cast to longs), of length n.
* Cleans up the stack between av and tetpil, updating those GENs. */
void
gerepilemanyvec(gpmem_t av, gpmem_t tetpil, long *g, int n)
{
const gpmem_t av2 = avma;
const size_t dec = av-tetpil;
int i;
(void)gerepile(av,tetpil,NULL);
for (i=0; i<n; i++,g++)
if ((gpmem_t)*g < tetpil)
{
if ((gpmem_t)*g >= av2) *g += dec;/* Update addresses if in stack */
else if ((gpmem_t)*g >= av) err(gerper);
}
}
GEN
gerepileupto(gpmem_t av, GEN q)
{
if (!isonstack(q)) { avma = av; return q; } /* universal object */
/* empty garbage */
if (av <= (gpmem_t)q) return q;
/* The garbage is only empty when av==q. It's probably a mistake if
* av < q. But "temporary variables" from sumiter are a problem since
* ep->values are returned as-is by identifier() and they can be in the
* stack: if we put a gerepileupto in lisseq(), we get an error. Maybe add,
* if (DEBUGMEM) err(warner,"av>q in gerepileupto") ???
*/
/* Beware: (long)(q+i) --> ((long)q)+i*sizeof(long) */
return gerepile(av, (gpmem_t) (q+lg(q)), q);
}
/* internal */
GEN
gerepileuptoleaf(gpmem_t av, GEN q)
{
long i;
GEN q0;
if (!isonstack(q) || av==(gpmem_t)q) { avma = av; return q; }
i=lg(q); avma = (gpmem_t)(((GEN)av) - i);
q0 = (GEN)avma; while (--i >= 0) q0[i]=q[i];
return q0;
}
/* internal */
GEN
gerepileuptoint(gpmem_t av, GEN q)
{
if (!isonstack(q) || (GEN)av==q) { avma = av; return q; }
avma = (gpmem_t)icopy_av(q, (GEN)av);
return (GEN)avma;
}
static int
_ok_gerepileupto(GEN av, GEN x)
{
long i,lx,tx;
if (!isonstack(x)) return 1;
if (x > av)
{
err(warner,"bad object %Z",x);
return 0;
}
tx = typ(x);
if (! is_recursive_t(tx)) return 1;
lx = (tx==t_POL || tx==t_LIST)? lgef(x): lg(x);
for (i=lontyp[tx]; i<lx; i++)
if (!_ok_gerepileupto(av, (GEN)x[i]))
{
err(warner,"bad component %ld in object %Z",i,x);
return 0;
}
return 1;
}
/* check that x and all its components are out of stack, or have been
* created after av */
int
ok_gerepileupto(GEN x) { return _ok_gerepileupto(x, x); }
GEN
gerepile(gpmem_t av, gpmem_t tetpil, GEN q)
{
gpmem_t avmb;
size_t dec = av - tetpil;
GEN ll,a,b;
if (dec==0) return q;
if ((long)dec<0) err(talker,"lbot>ltop in gerepile");
if ((gpmem_t)q >= avma && (gpmem_t)q < tetpil)
q = (GEN) (((gpmem_t)q) + dec);
for (ll=(GEN)av, a=(GEN)tetpil; a > (GEN)avma; ) *--ll= *--a;
avmb = (gpmem_t)ll;
while (ll < (GEN)av)
{
const long tl=typ(ll);
if (! is_recursive_t(tl)) { ll+=lg(ll); continue; }
a = ll+lontyp[tl];
if (tl==t_POL) { b=ll+lgef(ll); ll+=lg(ll); } else { ll+=lg(ll); b=ll; }
for ( ; a<b; a++)
if ((gpmem_t)*a < av && (gpmem_t)*a >= avma)
{
if ((gpmem_t)*a < tetpil) *a += dec; else err(gerper);
}
}
avma = avmb; return q;
}
long
allocatemoremem(size_t newsize)
{
if (!newsize)
{
newsize = (top - bot) << 1;
err(warner,"doubling stack size; new stack = %lu (%.3f Mbytes)",
newsize, newsize/1048576.);
}
return init_stack(newsize);
}
/* alternate stack management routine */
stackzone *
switch_stack(stackzone *z, long n)
{
if (!z)
{ /* create parallel stack */
size_t size = n*sizeof(long) + sizeof(stackzone);
z = (stackzone*) gpmalloc(size);
z->zonetop = ((gpmem_t)z) + size;
return z;
}
if (n)
{ /* switch to parallel stack */
z->bot = bot;
z->top = top;
z->avma = avma;
z->memused = memused;
bot = (gpmem_t) (z+1);
top = z->zonetop;
avma = top;
memused = (size_t)-1;
}
else
{ /* back to normalcy */
bot = z->bot;
top = z->top;
avma = z->avma;
memused = z->memused;
}
return NULL;
}
#ifdef MEMSTEP
void
checkmemory(GEN z)
{
if (DEBUGMEM && memused != (size_t)-1 &&
((GEN)memused > z + MEMSTEP || z > (GEN)memused + MEMSTEP))
{
memused=(size_t)z;
#if MEMSTEP >= 1048576
fprintferr("...%4.0lf Mbytes used\n",(top-memused)/1048576.);
#else
fprintferr("...%5.1lf Mbytes used\n",(top-memused)/1048576.);
#endif
}
}
#endif
void
fill_stack(void)
{
GEN x = ((GEN)bot);
while (x < (GEN)avma) *x++ = 0xfefefefeUL;
}
/*******************************************************************/
/* */
/* TIMER */
/* */
/*******************************************************************/
long
_get_time(pari_timer *T, long Ticks, long TickPerSecond)
{
long s = Ticks / TickPerSecond;
long us = (long) (Ticks % TickPerSecond) * (1000000. / TickPerSecond);
long delay = 1000 * (s - T->s) + (us - T->us) / 1000;
T->us = us;
T->s = s; return delay;
}
#ifdef WINCE
long
TIMER(pari_timer *T)
{
return _get_time(T, GetTickCount(), 1000);
}
#elif defined(macintosh)
# include <Events.h>
long
TIMER(pari_timer *T)
{
return _get_time(T, TickCount(), 60);
}
#elif USE_TIMES
# include <sys/times.h>
# include <sys/time.h>
# include <time.h>
long
TIMER(pari_timer *T)
{
struct tms t; times(&t);
return _get_time(T, t.tms_utime, CLK_TCK);
}
#elif USE_GETRUSAGE
# include <sys/time.h>
# include <sys/resource.h>
long
TIMER(pari_timer *T)
{
struct rusage r;
struct timeval t;
long delay;
getrusage(0,&r); t = r.ru_utime;
delay = 1000 * (t.tv_sec - T->s) + (t.tv_usec - T->us) / 1000;
T->us = t.tv_usec;
T->s = t.tv_sec; return delay;
}
#elif USE_FTIME
# include <sys/timeb.h>
long
TIMER(pari_timer *T)
{
struct timeb t;
long delay;
ftime(&t);
delay = 1000 * (t.time - T->s) + (t.millitm - T->us / 1000);
T->us = t.millitm * 1000;
T->s = t.time; return delay;
}
#else
# include <time.h>
# ifndef CLOCKS_PER_SEC
# define CLOCKS_PER_SEC 1000000 /* may be false on YOUR system */
# endif
long
TIMER(pari_timer *T)
{
return _get_time(T, clock(), CLOCKS_PER_SEC);
}
#endif
void
TIMERstart(pari_timer *T) { (void)TIMER(T); }
long
timer(void) { static pari_timer T; return TIMER(&T);}
long
timer2(void) { static pari_timer T; return TIMER(&T);}
void
msgTIMER(pari_timer *T, char *format, ...)
{
va_list args;
PariOUT *out = pariOut; pariOut = pariErr;
pariputs("Time "); va_start(args, format);
vpariputs(format,args); va_end(args);
pariputsf(": %ld\n", TIMER(T)); pariflush();
pariOut = out;
}
void
msgtimer(char *format, ...)
{
va_list args;
PariOUT *out = pariOut; pariOut = pariErr;
pariputs("Time "); va_start(args, format);
vpariputs(format,args); va_end(args);
pariputsf(": %ld\n", timer2()); pariflush();
pariOut = out;
}
/*******************************************************************/
/* */
/* FUNCTIONS KNOWN TO THE ANALYZER */
/* */
/*******************************************************************/
extern void alias0(char *s, char *old);
extern GEN break0(long n);
extern GEN next0(long n);
extern GEN return0(GEN x);
GEN
geni(void) { return gi; }
/* List of GP functions:
* ---------------------
* Format (struct entree) :
* char *name : name (under GP).
* ulong valence : used to form arg list, now often handled by code.
* void *value : For PREDEFINED FUNCTIONS: C function to call.
* For USER FUNCTIONS: pointer to defining data (bloc) =
* entree*: NULL, list of entree (arguments), NULL
* char* : function text
* long menu : which help section do we belong to (See below).
* char *code : argument list (See below).
* entree *next : next entree (init to NULL, used in hashing code).
* char *help : short help text (init to NULL).
* void *args : For USER FUNCTIONS: default arguments (NULL terminated).
* For VARIABLES: (esp. loop indexes): push_val history.
* (while processing a loop, ep->value may not be a bloc)
* menu:
* -----
* 1: Standard monadic or dyadic OPERATORS
* 2: CONVERSIONS and similar elementary functions
* 3: TRANSCENDENTAL functions
* 4: NUMBER THEORETICAL functions
* 5: Functions related to ELLIPTIC CURVES
* 6: Functions related to general NUMBER FIELDS
* 7: POLYNOMIALS and power series
* 8: Vectors, matrices, LINEAR ALGEBRA and sets
* 9: SUMS, products, integrals and similar functions
* 10: GRAPHIC functions
* 11: PROGRAMMING under GP
*
* code: describe function prototype. NULL = use valence instead.
* -----
* Arguments:
* I input position (to be processed with lisseq) - a string with a
* sequence of PARI expressions.
* E input position (to be processed with lisexpr) - a string with a
* PARI expression.
* G GEN
* L long
* S symbol (i.e GP function name)
* V variable (same as S, but valence must equal EpVAR/EpGVAR)
* n variable number
* & *GEN
* F Fake *GEN (function requires a *GEN, but we don't use the resulting GEN)
* f Fake *long
* p real precision (prec for the C library)
* P series precision (precdl dor the C library)
* r raw input (treated as a string without quotes).
* Quoted args are copied as strings. Stops at first unquoted ')' or ','.
* Special chars can be quoted using '\'. Ex : aa"b\n)"c => "aab\n)c".
* s expanded string. Example: pi"x"2 yields "3.142x2".
* The unquoted components can be of any pari type (converted according to
* the current output format)
* s* any number of strings (see s)
* M Mnemonic or a flag (converted to a long); description follows
* after \n at the end of the argument description
* D Has a default value. Format is "Dvalue,type," (the ending comma is
* mandatory). Ex: D0,L, (arg is long, 0 by default).
* Special syntax:
* if type = G, &, I or V: D[G&IV] all send NULL.
* if type = n: Dn sends -1.
*
* The user-given args are read first, then completed by the defaults
*
* Return type (first char or immediately after 'x'): GEN by default, otherwise
* l Return long
* v Return void
*
* Syntax requirements:
* = Separator '=' required.
*
* Origin:
* x Installed foreign function. Put the ep of the function as the
* first argument, fill the rest with PARI arguments,
* then call installedHandler with these arguments.
* Should be the first char in the code.
*
****************************************************************************
* If new codes are added, change identifier and skipidentifier.
*
* Currently the following functions have no code word:
* 'O' 50, 'if' 80, 'until' 82, 'while' 81, 'global' 88,
*
* Valence 0 reserved for functions without mandatory args.
* Valence 99 reserved for codes which do not correspond 1-to-1 to valences.
* Any other valence (what to do with 0?) should correspond to exactly
* one code.
*/
entree functions_basic[]={
{"Euler",0,(void*)mpeuler,3,"p"},
{"I",0,(void*)geni,3,""},
{"List",0,(void*)gtolist,2,"DG"},
{"Mat",0,(void*)gtomat,2,"DG"},
{"Mod",25,(void*)Mod0,2,"GGD0,L,"},
{"O",50,NULL,7,NULL},
{"Pi",0,(void*)mppi,3,"p"},
{"Pol",14,(void*)gtopoly,2,"GDn"},
{"Polrev",14,(void*)gtopolyrev,2,"GDn"},
{"Qfb",99,(void*)Qfb0,2,"GGGDGp"},
{"Ser",14,(void*)gtoser,2,"GDn"},
{"Set",0,(void*)gtoset,2,"DG"},
{"Str",0,(void*)strtoGENstr,2,"D\"\",s,D0,L,"},
{"Vec",0,(void*)gtovec,2,"DG"},
{"Vecsmall",0,(void*)gtovecsmall,2,"DG"},
{"abs",1,(void*)gabs,3,"Gp"},
{"acos",1,(void*)gacos,3,"Gp"},
{"acosh",1,(void*)gach,3,"Gp"},
{"addprimes",0,(void*)addprimes,4,"DG"},
{"agm",29,(void*)agm,3,"GGp"},
{"algdep",99,(void*)algdep0,8,"GLD0,L,p"},
{"alias",99,(void*)alias0,11,"vrr"},
{"arg",1,(void*)garg,3,"Gp"},
{"asin",1,(void*)gasin,3,"Gp"},
{"asinh",1,(void*)gash,3,"Gp"},
{"atan",1,(void*)gatan,3,"Gp"},
{"atanh",1,(void*)gath,3,"Gp"},
{"bernfrac",11,(void*)bernfrac,3,"L"},
{"bernreal",99,(void*)bernreal,3,"Lp"},
{"bernvec",11,(void*)bernvec,3,"L"},
{"besselh1",29,(void*)hbessel1,3,"GGp"},
{"besselh2",29,(void*)hbessel2,3,"GGp"},
{"besseli",29,(void*)ibessel,3,"GGp"},
{"besselj",29,(void*)jbessel,3,"GGp"},
{"besseljh",29,(void*)jbesselh,3,"GGp"},
{"besselk",99,(void*)kbessel0,3,"GGD0,L,p"},
{"besseln",29,(void*)nbessel,3,"GGp"},
{"bestappr",99,(void*)bestappr0,4,"GGDG"},
{"bezout",2,(void*)vecbezout,4,"GG"},
{"bezoutres",2,(void*)vecbezoutres,4,"GG"},
{"bigomega",18,(void*)gbigomega,4,"G"},
{"binary",18,(void*)binaire,2,"G"},
{"binomial",21,(void*)binome,4,"GL"},
{"bitand",2,(void*)gbitand,2,"GG"},
{"bitneg",99,(void*)gbitneg,2,"GD-1,L,"},
{"bitnegimply",2,(void*)gbitnegimply,2,"GG"},
{"bitor",2,(void*)gbitor,2,"GG"},
{"bittest",99,(void*)gbittest3,2,"GGD1,L,"},
{"bitxor",2,(void*)gbitxor,2,"GG"},
{"bnfcertify",10,(void*)certifybuchall,6,"lG"},
{"bnfclassunit",99,(void*)bnfclassunit0,6,"GD0,L,DGp"},
{"bnfclgp",99,(void*)classgrouponly,6,"GDGp"},
{"bnfdecodemodule",2,(void*)decodemodule,6,"GG"},
{"bnfinit",91,(void*)bnfinit0,6,"GD0,L,DGp"},
{"bnfisintnorm",99,(void*)bnfisintnorm,6,"GG"},
{"bnfisnorm",99,(void*)bnfisnorm,6,"GGD1,L,p"},
{"bnfisprincipal",99,(void*)isprincipalall,6,"GGD1,L,"},
{"bnfissunit",99,(void*)bnfissunit,6,"GGG"},
{"bnfisunit",2,(void*)isunit,6,"GG"},
{"bnfmake",1,(void*)bnfmake,6,"Gp"},
{"bnfnarrow",18,(void*)buchnarrow,6,"G"},
{"bnfreg",99,(void*)regulator,6,"GDGp"},
{"bnfsignunit",18,(void*)signunits,6,"G"},
{"bnfsunit",99,(void*)bnfsunit,6,"GGp"},
{"bnfunit",18,(void*)buchfu,6,"G"},
{"bnrL1",99,(void*)bnrL1,6,"GDGD0,L,p"},
{"bnrclass",99,(void*)bnrclass0,6,"GGD0,L,"},
{"bnrclassno",2,(void*)rayclassno,6,"GG"},
{"bnrclassnolist",2,(void*)rayclassnolist,6,"GG"},
{"bnrconductor",99,(void*)bnrconductor,6,"GDGDGD0,L,"},
{"bnrconductorofchar",2,(void*)bnrconductorofchar,6,"GG"},
{"bnrdisc",99,(void*)bnrdisc0,6,"GDGDGD0,L,"},
{"bnrdisclist",99,(void*)bnrdisclist0,6,"GGDGD0,L,"},
{"bnrinit",99,(void*)bnrinit0,6,"GGD0,L,"},
{"bnrisconductor",99,(void*)bnrisconductor,6,"lGDGDG"},
{"bnrisprincipal",99,(void*)isprincipalrayall,6,"GGD1,L,"},
{"bnrrootnumber",99,(void*)bnrrootnumber,6,"GGD0,L,p"},
{"bnrstark",99,(void*)bnrstark,6,"GDGD0,L,p"},
{"break",0,(void*)break0,11,"D1,L,"},
{"ceil",18,(void*)gceil,2,"G"},
{"centerlift",99,(void*)centerlift0,2,"GDn"},
{"changevar",2,(void*)changevar,2,"GG"},
{"charpoly",99,(void*)charpoly0,8,"GDnD0,L,"},
{"chinese",99,(void*)chinese,4,"GDG"},
{"component",21,(void*)compo,2,"GL"},
{"concat",99,(void*)concat,8,"GDG"},
{"conj",18,(void*)gconj,2,"G"},
{"conjvec",1,(void*)conjvec,2,"Gp"},
{"content",18,(void*)content,4,"G"},
{"contfrac",99,(void*)contfrac0,4,"GDGD0,L,"},
{"contfracpnqn",18,(void*)pnqn,4,"G"},
{"core",99,(void*)core0,4,"GD0,L,"},
{"coredisc",99,(void*)coredisc0,4,"GD0,L,"},
{"cos",1,(void*)gcos,3,"Gp"},
{"cosh",1,(void*)gch,3,"Gp"},
{"cotan",1,(void*)gcotan,3,"Gp"},
{"denominator",18,(void*)denom,2,"G"},
{"deriv",14,(void*)deriv,7,"GDn"},
{"dilog",1,(void*)dilog,3,"Gp"},
{"dirdiv",2,(void*)dirdiv,4,"GG"},
{"direuler",99,(void*)direulerall,4,"V=GGEDG"},
{"dirmul",2,(void*)dirmul,4,"GG"},
{"dirzetak",2,(void*)dirzetak,6,"GG"},
{"divisors",18,(void*)divisors,4,"G"},
{"divrem",2,(void*)divrem,1,"GGDn"},
{"eint1",99,(void*)veceint1,3,"GDGp"},
{"elladd",3,(void*)addell,5,"GGG"},
{"ellak",2,(void*)akell,5,"GG"},
{"ellan",23,(void*)anell,5,"GL"},
{"ellap",25,(void*)ellap0,5,"GGD0,L,"},
{"ellbil",99,(void*)bilhell,5,"GGGp"},
{"ellchangecurve",2,(void*)coordch,5,"GG"},
{"ellchangepoint",2,(void*)pointch,5,"GG"},
{"elleisnum",99,(void*)elleisnum,5,"GLD0,L,p"},
{"elleta",1,(void*)elleta,5,"Gp"},
{"ellglobalred",18,(void*)globalreduction,5,"G"},
{"ellheight",99,(void*)ellheight0,5,"GGD0,L,p"},
{"ellheightmatrix",29,(void*)mathell,5,"GGp"},
{"ellinit",99,(void*)ellinit0,5,"GD0,L,p"},
{"ellisoncurve",20,(void*)oncurve,5,"lGG"},
{"ellj",1,(void*)jell,5,"Gp"},
{"elllocalred",2,(void*)localreduction,5,"GG"},
{"elllseries",99,(void*)lseriesell,5,"GGDGp"},
{"ellminimalmodel",99,(void*)ellminimalmodel,5,"GD&"},
{"ellorder",2,(void*)orderell,5,"GG"},
{"ellordinate",29,(void*)ordell,5,"GGp"},
{"ellpointtoz",29,(void*)zell,5,"GGp"},
{"ellpow",99,(void*)powell,5,"GGG"},
{"ellrootno",99,(void*)ellrootno,5,"lGDG"},
{"ellsigma",99,(void*)ellsigma,5,"GGD0,L,p"},
{"ellsub",99,(void*)subell,5,"GGG"},
{"elltaniyama",18,(void*)taniyama,5,"G"},
{"elltors",99,(void*)elltors0,5,"GD0,L,"},
{"ellwp",99,(void*)ellwp0,5,"GDGD0,L,pP"},
{"ellzeta",99,(void*)ellzeta,5,"GGp"},
{"ellztopoint",29,(void*)pointell,5,"GGp"},
{"erfc",1,(void*)gerfc,3,"Gp"},
{"eta",99,(void*)eta0,3,"GD0,L,p"},
{"eulerphi",18,(void*)gphi,4,"G"},
{"eval",18,(void*)geval,7,"G"},
{"exp",1,(void*)gexp,3,"Gp"},
{"factor",99,(void*)factor0,4,"GD-1,L,"},
{"factorback",99,(void*)factorback0,4,"GDGDG"},
{"factorcantor",2,(void*)factcantor,4,"GG"},
{"factorff",3,(void*)factmod9,4,"GGG"},
{"factorial",99,(void*)mpfactr,4,"Lp"},
{"factorint",99,(void*)factorint,4,"GD0,L,"},
{"factormod",25,(void*)factormod0,4,"GGD0,L,"},
{"factornf",2,(void*)polfnf,6,"GG"},
{"factorpadic",99,(void*)factorpadic0,7,"GGLD0,L,"},
{"ffinit",99,(void*)ffinit,4,"GLDn"},
{"fibonacci",11,(void*)fibo,4,"L"},
{"floor",18,(void*)gfloor,2,"G"},
{"for",83,(void*)forpari,11,"vV=GGI"},
{"fordiv",84,(void*)fordiv,11,"vGVI"},
{"forprime",83,(void*)forprime,11,"vV=GGI"},
{"forstep",86,(void*)forstep,11,"vV=GGGI"},
{"forsubgroup",99,(void*)forsubgroup,11,"vV=GDGI"},
{"forvec",87,(void*)forvec,11,"vV=GID0,L,"},
{"frac",18,(void*)gfrac,2,"G"},
{"galoisfixedfield",99,(void*)galoisfixedfield,6,"GGD0,L,Dn"},
{"galoisinit",99,(void*)galoisinit,6,"GDGD0,L,"},
{"galoisisabelian",99,(void*)galoisisabelian,6,"GD0,L,"},
{"galoispermtopol",2,(void*)galoispermtopol,6,"GG"},
{"galoissubcyclo",99,(void*)galoissubcyclo,6,"GDGD0,L,Dn"},
{"galoissubfields",99,(void*)galoissubfields,6,"GD0,L,Dn"},
{"galoissubgroups",18,(void*)galoissubgroups,6,"G"},
{"gamma",1,(void*)ggamma,3,"Gp"},
{"gammah",1,(void*)ggamd,3,"Gp"},
{"gcd",99,(void*)gcd0,4,"GDGD0,L,"},
{"getheap",0,(void*)getheap,11,""},
{"getrand",0,(void*)getrand,11,"l"},
{"getstack",0,(void*)getstack,11,"l"},
{"gettime",0,(void*)gettime,11,"l"},
{"hilbert",99,(void*)hil0,4,"lGGDG"},
{"hyperu",99,(void*)hyperu,3,"GGGp"},
{"idealadd",3,(void*)idealadd,6,"GGG"},
{"idealaddtoone",99,(void*)idealaddtoone0,6,"GGDG"},
{"idealappr",25,(void*)idealappr0,6,"GGD0,L,"},
{"idealchinese",3,(void*)idealchinese,6,"GGG"},
{"idealcoprime",3,(void*)idealcoprime,6,"GGG"},
{"idealdiv",99,(void*)idealdiv0,6,"GGGD0,L,"},
{"idealfactor",2,(void*)idealfactor,6,"GG"},
{"idealhnf",99,(void*)idealhnf0,6,"GGDG"},
{"idealintersect",3,(void*)idealintersect,6,"GGG"},
{"idealinv",25,(void*)idealinv,6,"GG"},
{"ideallist",99,(void*)ideallist0,6,"GLD4,L,"},
{"ideallistarch",99,(void*)ideallistarch0,6,"GGDGD0,L,"},
{"ideallog",3,(void*)zideallog,6,"GGG"},
{"idealmin",99,(void*)minideal,6,"GGDGp"},
{"idealmul",99,(void*)idealmul0,6,"GGGD0,L,p"},
{"idealnorm",2,(void*)idealnorm,6,"GG"},
{"idealpow",99,(void*)idealpow0,6,"GGGD0,L,p"},
{"idealprimedec",29,(void*)primedec,6,"GG"},
{"idealprincipal",2,(void*)principalideal,6,"GG"},
{"idealred",99,(void*)ideallllred,6,"GGDGp"},
{"idealstar",99,(void*)idealstar0,6,"GGD1,L,"},
{"idealtwoelt",99,(void*)ideal_two_elt0,6,"GGDG"},
{"idealval",30,(void*)idealval,6,"lGGG"},
{"ideleprincipal",29,(void*)principalidele,6,"GGp"},
{"if",80,NULL,11,NULL},
{"imag",18,(void*)gimag,2,"G"},
{"incgam",99,(void*)incgam0,3,"GGDGp"},
{"incgamc",29,(void*)incgam3,3,"GGp"},
{"intformal",14,(void*)integ,7,"GDn"},
{"intnum",99,(void*)intnum0,9,"V=GGED0,L,p"},
{"isfundamental",18,(void*)gisfundamental,4,"G"},
{"isprime",99,(void*)gisprime,4,"GD0,L,"},
{"ispseudoprime",18,(void*)gispseudoprime,4,"GD0,L,"},
{"issquare",99,(void*)gcarrecomplet,4,"GD&"},
{"issquarefree",18,(void*)gissquarefree,4,"G"},
{"kronecker",2,(void*)gkronecker,4,"GG"},
{"lcm",99,(void*)glcm0,4,"GDG"},
{"length",10,(void*)glength,2,"lG"},
{"lex",20,(void*)lexcmp,1,"lGG"},
{"lift",99,(void*)lift0,2,"GDn"},
{"lindep",99,(void*)lindep0,8,"GD0,L,p"},
{"listcreate",11,(void*)listcreate,8,"L"},
{"listinsert",99,(void*)listinsert,8,"GGL"},
{"listkill",99,(void*)listkill,8,"vG"},
{"listput",25,(void*)listput,8,"GGD0,L,"},
{"listsort",99,(void*)listsort,8,"GD0,L,"},
{"lngamma",1,(void*)glngamma,3,"Gp"},
{"log",99,(void*)log0,99,"GD0,M,p\nAGM==1"},
{"matadjoint",18,(void*)adj,8,"G"},
{"matalgtobasis",2,(void*)matalgtobasis,6,"GG"},
{"matbasistoalg",2,(void*)matbasistoalg,6,"GG"},
{"matcompanion",18,(void*)assmat,8,"G"},
{"matdet",99,(void*)det0,8,"GD0,L,"},
{"matdetint",18,(void*)detint,8,"G"},
{"matdiagonal",18,(void*)diagonal,8,"G"},
{"mateigen",1,(void*)eigen,8,"Gp"},
{"mathess",18,(void*)hess,8,"G"},
{"mathilbert",11,(void*)mathilbert,8,"L"},
{"mathnf",99,(void*)mathnf0,8,"GD0,L,"},
{"mathnfmod",2,(void*)hnfmod,8,"GG"},
{"mathnfmodid",2,(void*)hnfmodid,8,"GG"},
{"matid",11,(void*)idmat,8,"L"},
{"matimage",99,(void*)matimage0,8,"GD0,L,"},
{"matimagecompl",18,(void*)imagecompl,8,"G"},
{"matindexrank",18,(void*)indexrank,8,"G"},
{"matintersect",2,(void*)intersect,8,"GG"},
{"matinverseimage",2,(void*)inverseimage,8,"GG"},
{"matisdiagonal",10,(void*)isdiagonal,8,"lG"},
{"matker",99,(void*)matker0,8,"GD0,L,"},
{"matkerint",99,(void*)matkerint0,8,"GD0,L,"},
{"matmuldiagonal",2,(void*)matmuldiagonal,8,"GG"},
{"matmultodiagonal",2,(void*)matmultodiagonal,8,"GG"},
{"matpascal",99,(void*)matqpascal,8,"LDG"},
{"matrank",10,(void*)rank,8,"lG"},
{"matrix",49,(void*)matrice,8,"GGDVDVDI"},
{"matrixqz",2,(void*)matrixqz0,8,"GG"},
{"matsize",18,(void*)matsize,8,"G"},
{"matsnf",99,(void*)matsnf0,8,"GD0,L,"},
{"matsolve",2,(void*)gauss,8,"GG"},
{"matsolvemod",99,(void*)matsolvemod0,8,"GGGD0,L,"},
{"matsupplement",18,(void*)suppl,8,"G"},
{"mattranspose",18,(void*)gtrans,8,"G"},
{"max",2,(void*)gmax,1,"GG"},
{"min",2,(void*)gmin,1,"GG"},
{"modreverse",18,(void*)polymodrecip,6,"G"},
{"moebius",18,(void*)gmu,4,"G"},
{"newtonpoly",2,(void*)newtonpoly,6,"GG"},
{"next",0,(void*)next0,11,"D1,L,"},
{"nextprime",18,(void*)gnextprime,4,"G"},
{"nfalgtobasis",2,(void*)algtobasis,6,"GG"},
{"nfbasis",99,(void*)nfbasis0,6,"GD0,L,DG"},
{"nfbasistoalg",2,(void*)basistoalg,6,"GG"},
{"nfdetint",2,(void*)nfdetint,6,"GG"},
{"nfdisc",99,(void*)nfdiscf0,6,"GD0,L,DG"},
{"nfeltdiv",3,(void*)element_div,6,"GGG"},
{"nfeltdiveuc",3,(void*)nfdiveuc,6,"GGG"},
{"nfeltdivmodpr",4,(void*)element_divmodpr,6,"GGGG"},
{"nfeltdivrem",3,(void*)nfdivres,6,"GGG"},
{"nfeltmod",3,(void*)nfmod,6,"GGG"},
{"nfeltmul",3,(void*)element_mul,6,"GGG"},
{"nfeltmulmodpr",4,(void*)element_mulmodpr,6,"GGGG"},
{"nfeltpow",3,(void*)element_pow,6,"GGG"},
{"nfeltpowmodpr",4,(void*)element_powmodpr,6,"GGGG"},
{"nfeltreduce",3,(void*)element_reduce,6,"GGG"},
{"nfeltreducemodpr",3,(void*)nfreducemodpr,6,"GGG"},
{"nfeltval",30,(void*)element_val,6,"lGGG"},
{"nffactor",99,(void*)nffactor,6,"GG"},
{"nffactormod",99,(void*)nffactormod,6,"GGG"},
{"nfgaloisapply",3,(void*)galoisapply,6,"GGG"},
{"nfgaloisconj",99,(void*)galoisconj0,6,"GD0,L,DGp"},
{"nfhilbert",99,(void*)nfhilbert0,6,"lGGGDG"},
{"nfhnf",2,(void*)nfhermite,6,"GG"},
{"nfhnfmod",3,(void*)nfhermitemod,6,"GGG"},
{"nfinit",99,(void*)nfinit0,6,"GD0,L,p"},
{"nfisideal",20,(void*)isideal,6,"lGG"},
{"nfisincl",2,(void*)nfisincl,6,"GG"},
{"nfisisom",2,(void*)nfisisom,6,"GG"},
{"nfkermodpr",3,(void*)nfkermodpr,6,"GGG"},
{"nfmodprinit",2,(void*)nfmodprinit,6,"GG"},
{"nfnewprec",1,(void*)nfnewprec,6,"Gp"},
{"nfroots",99,(void*)nfroots,6,"GG"},
{"nfrootsof1",18,(void*)rootsof1,6,"G"},
{"nfsnf",2,(void*)nfsmith,6,"GG"},
{"nfsolvemodpr",4,(void*)nfsolvemodpr,6,"GGGG"},
{"nfsubfields",99,(void*)subfields0,6,"GDG"},
{"norm",18,(void*)gnorm,2,"G"},
{"norml2",18,(void*)gnorml2,2,"G"},
{"numdiv",18,(void*)gnumbdiv,4,"G"},
{"numerator",18,(void*)numer,2,"G"},
{"numtoperm",24,(void*)numtoperm,2,"LG"},
{"omega",18,(void*)gomega,4,"G"},
{"padicappr",2,(void*)apprgen9,7,"GG"},
{"padicprec",20,(void*)padicprec,2,"lGG"},
{"permtonum",18,(void*)permtonum,2,"G"},
{"polcoeff",99,(void*)polcoeff0,7,"GLDn"},
{"polcompositum",25,(void*)polcompositum0,6,"GGD0,L,"},
{"polcyclo",99,(void*)cyclo,7,"LDn"},
{"poldegree",99,(void*)poldegree,7,"lGDn"},
{"poldisc",99,(void*)poldisc0,7,"GDn"},
{"poldiscreduced",18,(void*)reduceddiscsmith,7,"G"},
{"polgalois",99,(void*)galois,6,"Gp"},
{"polhensellift",99,(void*)polhensellift,7,"GGGL"},
{"polinterpolate",31,(void*)polint,7,"GDGDGD&"},
{"polisirreducible",18,(void*)gisirreducible,7,"G"},
{"pollead",99,(void*)pollead,7,"GDn"},
{"pollegendre",99,(void*)legendre,7,"LDn"},
{"polrecip",18,(void*)polrecip,7,"G"},
{"polred",99,(void*)polred0,6,"GD0,L,DG"},
{"polredabs",99,(void*)polredabs0,6,"GD0,L,"},
{"polredord",1,(void*)ordred,6,"G"},
{"polresultant",99,(void*)polresultant0,7,"GGDnD0,L,"},
{"polroots",99,(void*)roots0,7,"GD0,L,p"},
{"polrootsmod",25,(void*)rootmod0,7,"GGD0,L,"},
{"polrootspadic",32,(void*)rootpadic,7,"GGL"},
{"polsturm",99,(void*)sturmpart,7,"lGDGDG"},
{"polsubcyclo",99,(void*)polsubcyclo,7,"LLDn"},
{"polsylvestermatrix",2,(void*)sylvestermatrix,7,"GG"},
{"polsym",21,(void*)polsym,7,"GL"},
{"poltchebi",99,(void*)tchebi,7,"LDn"},
{"poltschirnhaus",18,(void*)tschirnhaus,6,"G"},
{"polylog",99,(void*)polylog0,3,"LGD0,L,p"},
{"polzagier",99,(void*)polzag,7,"LL"},
{"precision",99,(void*)precision0,2,"GD0,L,"},
{"precprime",18,(void*)gprecprime,4,"G"},
{"prime",11,(void*)prime,4,"L"},
{"primes",11,(void*)primes,4,"L"},
{"prod",47,(void*)produit,9,"V=GGEDG"},
{"prodeuler",37,(void*)prodeuler,9,"V=GGEp"},
{"prodinf",99,(void*)prodinf0,9,"V=GED0,L,p"},
{"psi",1,(void*)gpsi,3,"Gp"},
{"qfbclassno",99,(void*)qfbclassno0,4,"GD0,L,"},
{"qfbcompraw",2,(void*)compraw,4,"GG"},
{"qfbhclassno",18,(void*)hclassno,4,"G"},
{"qfbnucomp",3,(void*)nucomp,4,"GGG"},
{"qfbnupow",2,(void*)nupow,4,"GG"},
{"qfbpowraw",23,(void*)powraw,4,"GL"},
{"qfbprimeform",29,(void*)primeform,4,"GGp"},
{"qfbred",99,(void*)qfbred0,4,"GD0,L,DGDGDG"},
{"qfgaussred",18,(void*)sqred,8,"G"},
{"qfjacobi",1,(void*)jacobi,8,"Gp"},
{"qflll",99,(void*)qflll0,8,"GD0,L,p"},
{"qflllgram",99,(void*)qflllgram0,8,"GD0,L,p"},
{"qfminim",33,(void*)qfminim0,8,"GGGD0,L,p"},
{"qfperfection",18,(void*)perf,8,"G"},
{"qfsign",18,(void*)signat,8,"G"},
{"quadclassunit",96,(void*)quadclassunit0,4,"GD0,L,DGp"},
{"quaddisc",18,(void*)quaddisc,4,"G"},
{"quadgen",18,(void*)quadgen,4,"G"},
{"quadhilbert",99,(void*)quadhilbert,4,"GDGp"},
{"quadpoly",99,(void*)quadpoly0,4,"GDn"},
{"quadray",99,(void*)quadray,4,"GGDGp"},
{"quadregulator",1,(void*)gregula,4,"Gp"},
{"quadunit",1,(void*)gfundunit,4,"Gp"},
{"random",0,(void*)genrand,2,"DG"},
{"real",18,(void*)greal,2,"G"},
{"removeprimes",0,(void*)removeprimes,4,"DG"},
{"reorder",0,(void*)reorder,11,"DG"},
{"return",0,(void*)return0,11,"DG"},
{"rnfalgtobasis",2,(void*)rnfalgtobasis,6,"GG"},
{"rnfbasis",2,(void*)rnfbasis,6,"GG"},
{"rnfbasistoalg",2,(void*)rnfbasistoalg,6,"GG"},
{"rnfcharpoly",99,(void*)rnfcharpoly,6,"GGGDn"},
{"rnfconductor",99,(void*)rnfconductor,6,"GGD0,L,"},
{"rnfdedekind",99,(void*)rnfdedekind,6,"GGG"},
{"rnfdet",99,(void*)rnfdet0,6,"GGDG"},
{"rnfdisc",2,(void*)rnfdiscf,6,"GG"},
{"rnfeltabstorel",2,(void*)rnfelementabstorel,6,"GG"},
{"rnfeltdown",2,(void*)rnfelementdown,6,"GG"},
{"rnfeltreltoabs",2,(void*)rnfelementreltoabs,6,"GG"},
{"rnfeltup",2,(void*)rnfelementup,6,"GG"},
{"rnfequation",25,(void*)rnfequation0,6,"GGD0,L,"},
{"rnfhnfbasis",2,(void*)rnfhermitebasis,6,"GG"},
{"rnfidealabstorel",2,(void*)rnfidealabstorel,6,"GG"},
{"rnfidealdown",2,(void*)rnfidealdown,6,"GG"},
{"rnfidealhnf",2,(void*)rnfidealhermite,6,"GG"},
{"rnfidealmul",3,(void*)rnfidealmul,6,"GGG"},
{"rnfidealnormabs",2,(void*)rnfidealnormabs,6,"GG"},
{"rnfidealnormrel",2,(void*)rnfidealnormrel,6,"GG"},
{"rnfidealreltoabs",2,(void*)rnfidealreltoabs,6,"GG"},
{"rnfidealtwoelt",2,(void*)rnfidealtwoelement,6,"GG"},
{"rnfidealup",2,(void*)rnfidealup,6,"GG"},
{"rnfinit",29,(void*)rnfinitalg,6,"GGp"},
{"rnfisfree",20,(void*)rnfisfree,6,"lGG"},
{"rnfisnorm",99,(void*)rnfisnorm,6,"GGD0,L,"},
{"rnfisnorminit",99,(void*)rnfisnorminit,6,"GGD2,L,"},
{"rnfkummer",99,(void*)rnfkummer,6,"GDGD0,L,p"},
{"rnflllgram",99,(void*)rnflllgram,6,"GGGp"},
{"rnfnormgroup",2,(void*)rnfnormgroup,6,"GG"},
{"rnfpolred",29,(void*)rnfpolred,6,"GGp"},
{"rnfpolredabs",99,(void*)rnfpolredabs,6,"GGD0,L,"},
{"rnfpseudobasis",2,(void*)rnfpseudobasis,6,"GG"},
{"rnfsteinitz",2,(void*)rnfsteinitz,6,"GG"},
{"round",99,(void*)round0,2,"GD&"},
{"serconvol",2,(void*)convol,7,"GG"},
{"serlaplace",18,(void*)laplace,7,"G"},
{"serreverse",18,(void*)recip,7,"G"},
{"setintersect",2,(void*)setintersect,8,"GG"},
{"setisset",10,(void*)setisset,8,"lG"},
{"setminus",2,(void*)setminus,8,"GG"},
{"setrand",99,(void*)setrand,11,"lL"},
{"setsearch",99,(void*)setsearch,8,"lGGD0,L,"},
{"setunion",2,(void*)setunion,8,"GG"},
{"shift",99,(void*)gshift3,1,"GLD0,L,"},
{"shiftmul",99,(void*)gmul2n,1,"GL"},
{"sigma",99,(void*)gsumdivk,4,"GD1,L,"},
{"sign",10,(void*)gsigne,1,"lG"},
{"simplify",18,(void*)simplify,2,"G"},
{"sin",1,(void*)gsin,3,"Gp"},
{"sinh",1,(void*)gsh,3,"Gp"},
{"sizebyte",10,(void*)taille2,2,"lG"},
{"sizedigit",10,(void*)sizedigit,2,"lG"},
{"solve",37,(void*)zbrent,9,"V=GGEp"},
{"sqr",18,(void*)gsqr,3,"G"},
{"sqrt",1,(void*)gsqrt,3,"Gp"},
{"sqrtint",18,(void*)racine,4,"G"},
{"sqrtn",99,(void*)gsqrtn,3,"GGD&p"},
{"subgrouplist",99,(void*)subgrouplist0,6,"GDGD0,L,p"},
{"subst",99,(void*)gsubst0,7,"GGG"},
{"sum",48,(void*)somme,9,"V=GGEDG"},
{"sumalt",99,(void*)sumalt0,9,"V=GED0,L,p"},
{"sumdiv",22,(void*)divsum,9,"GVE"},
{"suminf",27,(void*)suminf,9,"V=GEp"},
{"sumpos",99,(void*)sumpos0,9,"V=GED0,L,p"},
{"tan",1,(void*)gtan,3,"Gp"},
{"tanh",1,(void*)gth,3,"Gp"},
{"taylor",12,(void*)tayl,7,"GnP"},
{"teichmuller",18,(void*)teich,3,"G"},
{"theta",29,(void*)theta,3,"GGp"},
{"thetanullk",99,(void*)thetanullk,3,"GLp"},
{"thue",99,(void*)thue,7,"GGDG"},
{"thueinit",99,(void*)thueinit,7,"GD0,L,p"},
{"trace",18,(void*)gtrace,8,"G"},
{"truncate",99,(void*)trunc0,2,"GD&"},
{"until",82,NULL,11,NULL},
{"valuation",20,(void*)ggval,2,"lGG"},
{"variable",18,(void*)gpolvar,2,"G"},
{"vecextract",99,(void*)extract0,8,"GGDG"},
{"vecmax",18,(void*)vecmax,1,"G"},
{"vecmin",18,(void*)vecmin,1,"G"},
{"vecsort",99,(void*)vecsort0,8,"GDGD0,L,"},
{"vector",28,(void*)vecteur,8,"GDVDI"},
{"vectorsmall",28,(void*)vecteursmall,8,"GDVDI"},
{"vectorv",28,(void*)vvecteur,8,"GDVDI"},
{"weber",99,(void*)weber0,3,"GD0,L,p"},
{"while",81,NULL,11,NULL},
{"zeta",1,(void*)gzeta,3,"Gp"},
{"zetak",99,(void*)gzetakall,6,"GGD0,L,p"},
{"zetakinit",1,(void*)initzeta,6,"Gp"},
{"znlog",2,(void*)znlog,4,"GG"},
{"znorder",18,(void*)order,4,"G"},
{"znprimroot",18,(void*)ggener,4,"G"},
{"znstar",18,(void*)znstar,4,"G"},
/* DO NOT REMOVE THIS BLANK LINE: chname & helpsynchro depend on it */
{NULL,0,NULL,0,NULL} /* sentinel */
};
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to init.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / language