Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - language - init.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.8.0 lcov report (development 19207-2ed2f69) Lines: 797 1178 67.7 %
Date: 2016-07-25 07:10:32 Functions: 95 133 71.4 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000-2003  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : /*******************************************************************/
      15             : /*                                                                 */
      16             : /*        INITIALIZING THE SYSTEM, ERRORS, STACK MANAGEMENT        */
      17             : /*                                                                 */
      18             : /*******************************************************************/
      19             : /* _GNU_SOURCE is needed before first include to get RUSAGE_THREAD */
      20             : #undef _GNU_SOURCE /* avoid warning */
      21             : #define _GNU_SOURCE
      22             : #include <string.h>
      23             : #if defined(_WIN32) || defined(__CYGWIN32__)
      24             : #  include "../systems/mingw/mingw.h"
      25             : #  include <process.h>
      26             : #endif
      27             : #include "paricfg.h"
      28             : #if defined(STACK_CHECK) && !defined(__EMX__)
      29             : #  include <sys/types.h>
      30             : #  include <sys/time.h>
      31             : #  include <sys/resource.h>
      32             : #endif
      33             : #if defined(HAS_WAITPID) && defined(HAS_SETSID)
      34             : #  include <sys/wait.h>
      35             : #endif
      36             : #ifdef HAS_MMAP
      37             : #  include <sys/mman.h>
      38             : #endif
      39             : #if defined(USE_GETTIMEOFDAY) || defined(USE_GETRUSAGE) || defined(USE_TIMES)
      40             : #  include <sys/time.h>
      41             : #endif
      42             : #if defined(USE_GETRUSAGE)
      43             : #  include <sys/resource.h>
      44             : #endif
      45             : #if defined(USE_FTIME) || defined(USE_FTIMEFORWALLTIME)
      46             : #  include <sys/timeb.h>
      47             : #endif
      48             : #if defined(USE_CLOCK_GETTIME) || defined(USE_TIMES)
      49             : #  include <time.h>
      50             : #endif
      51             : #if defined(USE_TIMES)
      52             : #  include <sys/times.h>
      53             : #endif
      54             : #include "pari.h"
      55             : #include "paripriv.h"
      56             : #include "anal.h"
      57             : 
      58             : const double LOG2    = 0.6931471805599453; /* log(2) */
      59             : const double LOG10_2 = 0.3010299956639812; /* log_10(2) */
      60             : const double LOG2_10 = 3.321928094887362;  /* log_2(10) */
      61             : 
      62             : GEN gnil, gen_0, gen_1, gen_m1, gen_2, gen_m2, ghalf, err_e_STACK;
      63             : 
      64             : static const ulong readonly_constants[] = {
      65             :   evaltyp(t_INT) | _evallg(2),  /* gen_0 */
      66             :   evallgefint(2),
      67             :   evaltyp(t_INT) | _evallg(2),  /* gnil */
      68             :   evallgefint(2),
      69             :   evaltyp(t_INT) | _evallg(3),  /* gen_1 */
      70             :   evalsigne(1) | evallgefint(3),
      71             :   1,
      72             :   evaltyp(t_INT) | _evallg(3),  /* gen_2 */
      73             :   evalsigne(1) | evallgefint(3),
      74             :   2,
      75             :   evaltyp(t_INT) | _evallg(3),  /* gen_m1 */
      76             :   evalsigne(-1) | evallgefint(3),
      77             :   1,
      78             :   evaltyp(t_INT) | _evallg(3),  /* gen_m2 */
      79             :   evalsigne(-1) | evallgefint(3),
      80             :   2,
      81             : };
      82             : static const long readonly_ghalf[] = {
      83             :   evaltyp(t_FRAC) | _evallg(3), /* ghalf */
      84             :   (long)(readonly_constants+4),
      85             :   (long)(readonly_constants+7)
      86             : };
      87             : static const ulong readonly_err_STACK[] = {
      88             :   evaltyp(t_ERROR) | _evallg(2),
      89             :   e_STACK
      90             : };
      91             : THREAD GEN    bernzone;
      92             : GEN     primetab; /* private primetable */
      93             : byteptr diffptr;
      94             : FILE    *pari_outfile, *pari_errfile, *pari_logfile, *pari_infile;
      95             : char    *current_logfile, *current_psfile, *pari_datadir;
      96             : long    gp_colors[c_LAST];
      97             : int     disable_color;
      98             : ulong   DEBUGFILES, DEBUGLEVEL, DEBUGMEM;
      99             : long    DEBUGVAR;
     100             : ulong   pari_mt_nbthreads;
     101             : long    precreal;
     102             : ulong   precdl, logstyle;
     103             : gp_data *GP_DATA;
     104             : 
     105             : GEN colormap, pari_graphcolors;
     106             : 
     107             : entree  **varentries;
     108             : THREAD long *varpriority;
     109             : 
     110             : THREAD pari_sp avma;
     111             : THREAD struct pari_mainstack *pari_mainstack;
     112             : 
     113             : static void ** MODULES;
     114             : static pari_stack s_MODULES;
     115             : const long functions_tblsz = 135; /* size of functions_hash */
     116             : entree **functions_hash, **defaults_hash;
     117             : 
     118             : char *(*cb_pari_fgets_interactive)(char *s, int n, FILE *f);
     119             : int (*cb_pari_get_line_interactive)(const char*, const char*, filtre_t *F);
     120             : void (*cb_pari_quit)(long);
     121             : void (*cb_pari_init_histfile)(void);
     122             : void (*cb_pari_ask_confirm)(const char *);
     123             : int  (*cb_pari_handle_exception)(long);
     124             : int  (*cb_pari_err_handle)(GEN);
     125             : int  (*cb_pari_whatnow)(PariOUT *out, const char *, int);
     126             : void (*cb_pari_sigint)(void);
     127             : void (*cb_pari_pre_recover)(long);
     128             : void (*cb_pari_err_recover)(long);
     129             : int (*cb_pari_break_loop)(int);
     130             : int (*cb_pari_is_interactive)(void);
     131             : void (*cb_pari_start_output)();
     132             : 
     133             : const char * pari_library_path = NULL;
     134             : 
     135             : static THREAD GEN global_err_data;
     136             : THREAD jmp_buf *iferr_env;
     137             : const long CATCH_ALL = -1;
     138             : 
     139             : static void pari_init_timer(void);
     140             : 
     141             : /*********************************************************************/
     142             : /*                                                                   */
     143             : /*                       BLOCKS & CLONES                             */
     144             : /*                                                                   */
     145             : /*********************************************************************/
     146             : /*#define DEBUG*/
     147             : static THREAD long next_block;
     148             : static THREAD GEN cur_block; /* current block in block list */
     149             : #ifdef DEBUG
     150             : static THREAD long NUM;
     151             : #endif
     152             : 
     153             : static void
     154      199512 : pari_init_blocks(void)
     155             : {
     156      199512 :   next_block = 0; cur_block = NULL;
     157             : #ifdef DEBUG
     158             :   NUM = 0;
     159             : #endif
     160      199512 : }
     161             : 
     162             : static void
     163      201484 : pari_close_blocks(void)
     164             : {
     165      201484 :   while (cur_block) killblock(cur_block);
     166      201223 : }
     167             : 
     168             : /* Return x, where:
     169             :  * x[-4]: reference count
     170             :  * x[-3]: adress of next block
     171             :  * x[-2]: adress of preceding block.
     172             :  * x[-1]: number of allocated blocs.
     173             :  * x[0..n-1]: malloc-ed memory. */
     174             : GEN
     175   137800824 : newblock(size_t n)
     176             : {
     177   137800824 :   long *x = (long *) pari_malloc((n + BL_HEAD)*sizeof(long)) + BL_HEAD;
     178             : 
     179   137803183 :   bl_refc(x) = 1;
     180   137803183 :   bl_next(x) = NULL;
     181   137803183 :   bl_prev(x) = cur_block;
     182   137803183 :   bl_num(x)  = next_block++;
     183   137803183 :   if (cur_block) bl_next(cur_block) = x;
     184             : #ifdef DEBUG
     185             :   err_printf("+ %ld\n", ++NUM);
     186             : #endif
     187   137803183 :   if (DEBUGMEM)
     188             :   {
     189           0 :     if (!n) pari_warn(warner,"mallocing NULL object in newblock");
     190           0 :     if (DEBUGMEM > 2)
     191           0 :       err_printf("new block, size %6lu (no %ld): %08lx\n", n, next_block-1, x);
     192             :   }
     193   137802874 :   return cur_block = x;
     194             : }
     195             : 
     196             : GEN
     197         296 : gcloneref(GEN x)
     198             : {
     199         296 :   if (isclone(x)) { ++bl_refc(x); return x; }
     200         296 :   else return gclone(x);
     201             : }
     202             : 
     203             : void
     204           0 : gclone_refc(GEN x) { ++bl_refc(x); }
     205             : 
     206             : void
     207   180007759 : gunclone(GEN x)
     208             : {
     209   360015634 :   if (--bl_refc(x) > 0) return;
     210   137810221 :   BLOCK_SIGINT_START;
     211   137810678 :   if (bl_next(x)) bl_prev(bl_next(x)) = bl_prev(x);
     212             :   else
     213             :   {
     214    24883718 :     cur_block = bl_prev(x);
     215    24883718 :     next_block = bl_num(x);
     216             :   }
     217   137810678 :   if (bl_prev(x)) bl_next(bl_prev(x)) = bl_next(x);
     218   137810678 :   if (DEBUGMEM > 2)
     219           0 :     err_printf("killing block (no %ld): %08lx\n", bl_num(x), x);
     220   137810584 :   free((void*)bl_base(x)); /* pari_free not needed: we already block */
     221   137810584 :   BLOCK_SIGINT_END;
     222             : #ifdef DEBUG
     223             :   err_printf("- %ld\n", NUM--);
     224             : #endif
     225             : }
     226             : 
     227             : /* Recursively look for clones in the container and kill them. Then kill
     228             :  * container if clone. SIGINT could be blocked until it returns */
     229             : void
     230  2533185554 : gunclone_deep(GEN x)
     231             : {
     232             :   long i, lx;
     233             :   GEN v;
     234  5066371104 :   if (isclone(x) && bl_refc(x) > 1) { --bl_refc(x); return; }
     235  2511597435 :   BLOCK_SIGINT_START;
     236  2511597434 :   switch(typ(x))
     237             :   {
     238             :     case t_VEC: case t_COL: case t_MAT:
     239    32552513 :       lx = lg(x);
     240    32552513 :       for (i=1;i<lx;i++) gunclone_deep(gel(x,i));
     241    32552510 :       break;
     242             :     case t_LIST:
     243         263 :       v = list_data(x); lx = v? lg(v): 1;
     244         263 :       for (i=1;i<lx;i++) gunclone_deep(gel(v,i));
     245         263 :       if (v) killblock(v);
     246         263 :       break;
     247             :   }
     248  2511597431 :   if (isclone(x)) gunclone(x);
     249  2511597431 :   BLOCK_SIGINT_END;
     250             : }
     251             : 
     252             : int
     253      125923 : pop_entree_block(entree *ep, long loc)
     254             : {
     255      125923 :   GEN x = (GEN)ep->value;
     256      125923 :   if (bl_num(x) < loc) return 0; /* older */
     257          91 :   if (DEBUGMEM>2)
     258           0 :     err_printf("popping %s (block no %ld)\n", ep->name, bl_num(x));
     259          91 :   gunclone_deep(x); return 1;
     260             : }
     261             : 
     262             : /*********************************************************************/
     263             : /*                                                                   */
     264             : /*                       C STACK SIZE CONTROL                        */
     265             : /*                                                                   */
     266             : /*********************************************************************/
     267             : /* Avoid core dump on deep recursion. Adapted Perl code by Dominic Dunlop */
     268             : THREAD void *PARI_stack_limit = NULL;
     269             : 
     270             : #ifdef STACK_CHECK
     271             : 
     272             : #  ifdef __EMX__                                /* Emulate */
     273             : void
     274             : pari_stackcheck_init(void *pari_stack_base)
     275             : {
     276             :   (void) pari_stack_base;
     277             :   if (!pari_stack_base) { PARI_stack_limit = NULL; return; }
     278             :   PARI_stack_limit = get_stack(1./16, 32*1024);
     279             : }
     280             : #  else /* !__EMX__ */
     281             : /* Set PARI_stack_limit to (a little above) the lowest safe address that can be
     282             :  * used on the stack. Leave PARI_stack_limit at its initial value (NULL) to
     283             :  * show no check should be made [init failed]. Assume stack grows downward. */
     284             : void
     285        1328 : pari_stackcheck_init(void *pari_stack_base)
     286             : {
     287             :   struct rlimit rip;
     288             :   ulong size;
     289        1328 :   if (!pari_stack_base) { PARI_stack_limit = NULL; return; }
     290        1328 :   if (getrlimit(RLIMIT_STACK, &rip)) return;
     291        1328 :   size = rip.rlim_cur;
     292        1328 :   if (size == (ulong)RLIM_INFINITY || size > (ulong)pari_stack_base)
     293           0 :     PARI_stack_limit = (void*)(((ulong)pari_stack_base) / 16);
     294             :   else
     295        1328 :     PARI_stack_limit = (void*)((ulong)pari_stack_base - (size/16)*15);
     296             : }
     297             : #  endif /* !__EMX__ */
     298             : 
     299             : #else
     300             : void
     301             : pari_stackcheck_init(void *pari_stack_base)
     302             : {
     303             :   (void) pari_stack_base; PARI_stack_limit = NULL;
     304             : }
     305             : #endif /* STACK_CHECK */
     306             : 
     307             : /*******************************************************************/
     308             : /*                         HEAP TRAVERSAL                          */
     309             : /*******************************************************************/
     310             : struct getheap_t { long n, l; };
     311             : static void
     312        6615 : f_getheap(GEN x, void *D)
     313             : {
     314        6615 :   struct getheap_t *T = (struct getheap_t*)D;
     315        6615 :   T->n++;
     316        6615 :   T->l += gsizeword(x);
     317        6615 : }
     318             : GEN
     319          84 : getheap(void)
     320             : {
     321          84 :   struct getheap_t T = { 0, 0 };
     322          84 :   traverseheap(&f_getheap, &T);
     323          84 :   return mkvec2s(T.n, T.l + BL_HEAD * T.n);
     324             : }
     325             : 
     326             : void
     327          84 : traverseheap( void(*f)(GEN, void *), void *data )
     328             : {
     329             :   GEN x;
     330          84 :   for (x = cur_block; x; x = bl_prev(x)) f(x, data);
     331          84 : }
     332             : 
     333             : /*********************************************************************/
     334             : /*                          DAEMON / FORK                            */
     335             : /*********************************************************************/
     336             : #if defined(HAS_WAITPID) && defined(HAS_SETSID)
     337             : /* Properly fork a process, detaching from main process group without creating
     338             :  * zombies on exit. Parent returns 1, son returns 0 */
     339             : int
     340         508 : pari_daemon(void)
     341             : {
     342         508 :   pid_t pid = fork();
     343        1016 :   switch(pid) {
     344           0 :       case -1: return 1; /* father, fork failed */
     345             :       case 0:
     346         508 :         (void)setsid(); /* son becomes process group leader */
     347         508 :         if (fork()) exit(0); /* now son exits, also when fork fails */
     348         508 :         break; /* grandson: its father is the son, which exited,
     349             :                 * hence father becomes 'init', that'll take care of it */
     350             :       default: /* father, fork succeeded */
     351         508 :         (void)waitpid(pid,NULL,0); /* wait for son to exit, immediate */
     352         508 :         return 1;
     353             :   }
     354             :   /* grandson */
     355         508 :   return 0;
     356             : }
     357             : #else
     358             : int
     359             : pari_daemon(void)
     360             : {
     361             :   pari_err_IMPL("pari_daemon without waitpid & setsid");
     362             :   return 0;
     363             : }
     364             : #endif
     365             : 
     366             : /*********************************************************************/
     367             : /*                                                                   */
     368             : /*                       SYSTEM INITIALIZATION                       */
     369             : /*                                                                   */
     370             : /*********************************************************************/
     371             : static int try_to_recover = 0;
     372             : THREAD VOLATILE int PARI_SIGINT_block = 0, PARI_SIGINT_pending = 0;
     373             : 
     374             : /*********************************************************************/
     375             : /*                         SIGNAL HANDLERS                           */
     376             : /*********************************************************************/
     377             : static void
     378           0 : dflt_sigint_fun(void) { pari_err(e_MISC, "user interrupt"); }
     379             : 
     380             : #if defined(_WIN32) || defined(__CYGWIN32__)
     381             : int win32ctrlc = 0, win32alrm = 0;
     382             : void
     383             : dowin32ctrlc(void)
     384             : {
     385             :   win32ctrlc = 0;
     386             :   cb_pari_sigint();
     387             : }
     388             : #endif
     389             : 
     390             : static void
     391           0 : pari_handle_SIGINT(void)
     392             : {
     393             : #ifdef _WIN32
     394             :   if (++win32ctrlc >= 5) _exit(3);
     395             : #else
     396           0 :   cb_pari_sigint();
     397             : #endif
     398           0 : }
     399             : 
     400             : void
     401           0 : pari_sighandler(int sig)
     402             : {
     403             :   const char *msg;
     404             : #ifndef HAS_SIGACTION
     405             :   /*SYSV reset the signal handler in the handler*/
     406             :   (void)os_signal(sig,pari_sighandler);
     407             : #endif
     408           0 :   switch(sig)
     409             :   {
     410             : #ifdef SIGBREAK
     411             :     case SIGBREAK:
     412             :       if (PARI_SIGINT_block==1)
     413             :       {
     414             :         PARI_SIGINT_pending=SIGBREAK;
     415             :         mt_sigint();
     416             :       }
     417             :       else pari_handle_SIGINT();
     418             :       return;
     419             : #endif
     420             : 
     421             : #ifdef SIGINT
     422             :     case SIGINT:
     423           0 :       if (PARI_SIGINT_block==1)
     424             :       {
     425           0 :         PARI_SIGINT_pending=SIGINT;
     426           0 :         mt_sigint();
     427             :       }
     428           0 :       else pari_handle_SIGINT();
     429           0 :       return;
     430             : #endif
     431             : 
     432             : #ifdef SIGSEGV
     433             :     case SIGSEGV:
     434           0 :       msg="PARI/GP (Segmentation Fault)"; break;
     435             : #endif
     436             : #ifdef SIGBUS
     437             :     case SIGBUS:
     438           0 :       msg="PARI/GP (Bus Error)"; break;
     439             : #endif
     440             : #ifdef SIGFPE
     441             :     case SIGFPE:
     442           0 :       msg="PARI/GP (Floating Point Exception)"; break;
     443             : #endif
     444             : 
     445             : #ifdef SIGPIPE
     446             :     case SIGPIPE:
     447             :     {
     448           0 :       pariFILE *f = GP_DATA->pp->file;
     449           0 :       if (f && pari_outfile == f->file)
     450             :       {
     451           0 :         GP_DATA->pp->file = NULL; /* to avoid oo recursion on error */
     452           0 :         pari_outfile = stdout; pari_fclose(f);
     453           0 :         pari_err(e_MISC, "Broken Pipe, resetting file stack...");
     454             :       }
     455           0 :       return; /* not reached */
     456             :     }
     457             : #endif
     458             : 
     459           0 :     default: msg="signal handling"; break;
     460             :   }
     461           0 :   pari_err_BUG(msg);
     462             : }
     463             : 
     464             : void
     465        3164 : pari_sig_init(void (*f)(int))
     466             : {
     467             : #ifdef SIGBUS
     468        3164 :   (void)os_signal(SIGBUS,f);
     469             : #endif
     470             : #ifdef SIGFPE
     471        3164 :   (void)os_signal(SIGFPE,f);
     472             : #endif
     473             : #ifdef SIGINT
     474        3164 :   (void)os_signal(SIGINT,f);
     475             : #endif
     476             : #ifdef SIGBREAK
     477             :   (void)os_signal(SIGBREAK,f);
     478             : #endif
     479             : #ifdef SIGPIPE
     480        3164 :   (void)os_signal(SIGPIPE,f);
     481             : #endif
     482             : #ifdef SIGSEGV
     483        3164 :   (void)os_signal(SIGSEGV,f);
     484             : #endif
     485        3164 : }
     486             : 
     487             : /*********************************************************************/
     488             : /*                      STACK AND UNIVERSAL CONSTANTS                */
     489             : /*********************************************************************/
     490             : static void
     491        1328 : init_universal_constants(void)
     492             : {
     493        1328 :   gen_0  = (GEN)readonly_constants;
     494        1328 :   gnil   = (GEN)readonly_constants+2;
     495        1328 :   gen_1  = (GEN)readonly_constants+4;
     496        1328 :   gen_2  = (GEN)readonly_constants+7;
     497        1328 :   gen_m1 = (GEN)readonly_constants+10;
     498        1328 :   gen_m2 = (GEN)readonly_constants+13;
     499        1328 :   ghalf  = (GEN)readonly_ghalf;
     500        1328 :   err_e_STACK = (GEN)readonly_err_STACK;
     501        1328 : }
     502             : 
     503             : static void
     504      199676 : pari_init_errcatch(void)
     505             : {
     506      199676 :   iferr_env = NULL;
     507      199676 :   global_err_data = NULL;
     508      199676 : }
     509             : 
     510             : /*********************************************************************/
     511             : /*                           INIT DEFAULTS                           */
     512             : /*********************************************************************/
     513             : void
     514        1328 : pari_init_defaults(void)
     515             : {
     516             :   long i;
     517        1328 :   initout(1);
     518             : 
     519             : #ifdef LONG_IS_64BIT
     520        1140 :   precreal = 128;
     521             : #else
     522         188 :   precreal = 96;
     523             : #endif
     524             : 
     525        1328 :   precdl = 16;
     526        1328 :   DEBUGFILES = DEBUGLEVEL = DEBUGMEM = 0;
     527        1328 :   disable_color = 1;
     528        1328 :   logstyle = logstyle_none;
     529             : 
     530        1328 :   current_psfile = pari_strdup("pari.ps");
     531        1328 :   current_logfile= pari_strdup("pari.log");
     532        1328 :   pari_logfile = NULL;
     533             : 
     534        1328 :   pari_datadir = os_getenv("GP_DATA_DIR");
     535        1328 :   if (!pari_datadir)
     536             :   {
     537             : #if defined(_WIN32) || defined(__CYGWIN32__)
     538             :     if (paricfg_datadir[0]=='@' && paricfg_datadir[1]==0)
     539             :       pari_datadir = win32_datadir();
     540             :     else
     541             : #endif
     542        1328 :       pari_datadir = pari_strdup(paricfg_datadir);
     543             :   }
     544           0 :   else pari_datadir= pari_strdup(pari_datadir);
     545        1328 :   for (i=0; i<c_LAST; i++) gp_colors[i] = c_NONE;
     546        1328 :   colormap = NULL; pari_graphcolors = NULL;
     547        1328 : }
     548             : 
     549             : /*********************************************************************/
     550             : /*                   FUNCTION HASHTABLES, MODULES                    */
     551             : /*********************************************************************/
     552             : 
     553             : /* Initialize hashtable */
     554             : static void
     555           0 : init_hashtable(entree **table, long tblsz)
     556             : {
     557             :   long i;
     558           0 :   for (i = 0; i < tblsz; i++)
     559             :   {
     560           0 :     entree *last = NULL, *ep = table[i];
     561           0 :     table[i] = NULL;
     562           0 :     while (ep)
     563             :     {
     564           0 :       entree *EP = ep->next;
     565           0 :       switch(EpVALENCE(ep))
     566             :       {
     567             :         case EpVAR: case EpINSTALL:
     568             :         /* keep: attach it to last entree seen */
     569           0 :           if (last)
     570           0 :             last->next = ep;
     571             :           else
     572           0 :             table[i] = ep;
     573           0 :           ep->next = NULL; last = ep;
     574           0 :           break;
     575           0 :         default: freeep(ep);
     576             :       }
     577           0 :       ep = EP;
     578             :     }
     579             :   }
     580           0 : }
     581             : /* Load in hashtable hash the modules contained in A */
     582             : static int
     583           0 : gp_init_entrees(pari_stack *p_A, entree **hash)
     584             : {
     585             :   long i;
     586           0 :   entree **v = (entree **)*pari_stack_base(p_A);
     587           0 :   init_hashtable(hash, functions_tblsz);
     588           0 :   for (i = 0; i < p_A->n; i++) pari_fill_hashtable(hash, v[i]);
     589           0 :   return (hash == functions_hash);
     590             : }
     591             : int
     592           0 : gp_init_functions(void)
     593           0 : { return gp_init_entrees(&s_MODULES, functions_hash); }
     594             : 
     595             : extern entree functions_basic[], functions_default[];
     596             : static void
     597        1328 : pari_init_functions(void)
     598             : {
     599        1328 :   pari_stack_init(&s_MODULES, sizeof(*MODULES),(void**)&MODULES);
     600        1328 :   pari_stack_pushp(&s_MODULES,functions_basic);
     601        1328 :   functions_hash = (entree**) pari_calloc(sizeof(entree*)*functions_tblsz);
     602        1328 :   pari_fill_hashtable(functions_hash, functions_basic);
     603        1328 :   defaults_hash = (entree**) pari_calloc(sizeof(entree*)*functions_tblsz);
     604        1328 :   pari_add_defaults_module(functions_default);
     605        1328 : }
     606             : 
     607             : void
     608        2656 : pari_add_module(entree *ep)
     609             : {
     610        2656 :   pari_fill_hashtable(functions_hash, ep);
     611        2656 :   pari_stack_pushp(&s_MODULES, ep);
     612        2656 : }
     613             : 
     614             : void
     615        1328 : pari_add_defaults_module(entree *ep)
     616        1328 : { pari_fill_hashtable(defaults_hash, ep); }
     617             : 
     618             : /*********************************************************************/
     619             : /*                       PARI MAIN STACK                             */
     620             : /*********************************************************************/
     621             : 
     622             : #ifdef HAS_MMAP
     623             : #define PARI_STACK_ALIGN (sysconf(_SC_PAGE_SIZE))
     624             : #ifndef MAP_ANONYMOUS
     625             : #define MAP_ANONYMOUS MAP_ANON
     626             : #endif
     627             : #ifndef MAP_NORESERVE
     628             : #define MAP_NORESERVE 0
     629             : #endif
     630             : static void *
     631      202427 : pari_mainstack_malloc(size_t size)
     632             : {
     633      202427 :   void *b = mmap(NULL, size, PROT_READ|PROT_WRITE,
     634             :                              MAP_PRIVATE|MAP_ANONYMOUS|MAP_NORESERVE,-1,0);
     635      202427 :   return (b == MAP_FAILED) ? NULL: b;
     636             : }
     637             : 
     638             : static void
     639      202935 : pari_mainstack_mfree(void *s, size_t size)
     640             : {
     641      202935 :   munmap(s, size);
     642      202935 : }
     643             : 
     644             : static void
     645       65796 : pari_mainstack_mreset(void *s, size_t size)
     646             : {
     647       65796 :   madvise(s, size, MADV_DONTNEED);
     648       65796 : }
     649             : 
     650             : #else
     651             : #define PARI_STACK_ALIGN (0x40UL)
     652             : static void *
     653             : pari_mainstack_malloc(size_t s)
     654             : {
     655             :   return malloc(s); /* NOT pari_malloc, e_MEM would be deadly */
     656             : }
     657             : 
     658             : static void
     659             : pari_mainstack_mfree(void *s, size_t size) { (void) size; free(s); }
     660             : 
     661             : static void
     662             : pari_mainstack_mreset(void *s, size_t size) { (void) s; (void) size; }
     663             : 
     664             : #endif
     665             : 
     666             : static const size_t MIN_STACK = 500032UL;
     667             : static size_t
     668      405362 : fix_size(size_t a)
     669             : {
     670      405362 :   size_t ps = PARI_STACK_ALIGN;
     671      405362 :   size_t b = a & ~(ps - 1); /* Align */
     672      405362 :   if (b < a && b < ~(ps - 1)) b += ps;
     673      405362 :   if (b < MIN_STACK) b = MIN_STACK;
     674      405362 :   return b;
     675             : }
     676             : 
     677             : static void
     678      202427 : pari_mainstack_alloc(struct pari_mainstack *st, size_t rsize, size_t vsize)
     679             : {
     680      202427 :   size_t sizemax = vsize ? vsize: rsize, s = fix_size(sizemax);
     681             :   for (;;)
     682             :   {
     683      202427 :     st->vbot = (pari_sp)pari_mainstack_malloc(s);
     684      202427 :     if (st->vbot) break;
     685           0 :     if (s == MIN_STACK) pari_err(e_MEM); /* no way out. Die */
     686           0 :     s = fix_size(s >> 1);
     687           0 :     pari_warn(warnstack, s);
     688           0 :   }
     689      202427 :   st->vsize = vsize ? s: 0;
     690      202427 :   st->rsize = minuu(rsize, s);
     691      202427 :   st->size = st->rsize;
     692      202427 :   st->top = st->vbot+s;
     693      202427 :   st->bot = st->top - st->size;
     694      202427 :   st->memused = 0;
     695      202427 : }
     696             : 
     697             : static void
     698      202935 : pari_mainstack_free(struct pari_mainstack *st)
     699             : {
     700      202935 :   pari_mainstack_mfree((void*)st->vbot, st->vsize ? st->vsize : fix_size(st->rsize));
     701      202935 :   st->top = st->bot = st->vbot = 0;
     702      202935 :   st->size = st->vsize =0;
     703      202935 : }
     704             : 
     705             : static void
     706         155 : pari_mainstack_resize(struct pari_mainstack *st, size_t rsize, size_t vsize)
     707             : {
     708         155 :   BLOCK_SIGINT_START;
     709         155 :   pari_mainstack_free(st);
     710         155 :   pari_mainstack_alloc(st, rsize, vsize);
     711         155 :   BLOCK_SIGINT_END;
     712         155 : }
     713             : 
     714             : static void
     715      199608 : pari_mainstack_use(struct pari_mainstack *st)
     716             : {
     717      199608 :   pari_mainstack = st;
     718      199608 :   avma = st->top;
     719      199608 : }
     720             : 
     721             : static void
     722        1328 : paristack_alloc(size_t rsize, size_t vsize)
     723             : {
     724        1328 :   pari_mainstack_alloc(pari_mainstack, rsize, vsize);
     725        1328 :   pari_mainstack_use(pari_mainstack);
     726        1328 : }
     727             : 
     728             : void
     729           0 : paristack_setsize(size_t rsize, size_t vsize)
     730             : {
     731           0 :   pari_mainstack_resize(pari_mainstack, rsize, vsize);
     732           0 :   pari_mainstack_use(pari_mainstack);
     733           0 : }
     734             : 
     735             : void
     736           0 : parivstack_resize(ulong newsize)
     737             : {
     738             :   size_t s;
     739           0 :   if (newsize && newsize < pari_mainstack->rsize)
     740           0 :     pari_err_DIM("stack sizes [parisizemax < parisize]");
     741           0 :   if (newsize == pari_mainstack->vsize) return;
     742           0 :   evalstate_reset();
     743           0 :   paristack_setsize(pari_mainstack->rsize, newsize);
     744           0 :   s = pari_mainstack->vsize ? pari_mainstack->vsize : pari_mainstack->rsize;
     745           0 :   pari_warn(warner,"new maximum stack size = %lu (%.3f Mbytes)", s, s/1048576.);
     746           0 :   pari_init_errcatch();
     747           0 :   cb_pari_err_recover(-1);
     748             : }
     749             : 
     750             : void
     751         161 : paristack_newrsize(ulong newsize)
     752             : {
     753         161 :   size_t s, vsize = pari_mainstack->vsize;
     754         161 :   if (!newsize) newsize = pari_mainstack->rsize << 1;
     755         161 :   if (newsize != pari_mainstack->rsize)
     756         155 :     pari_mainstack_resize(pari_mainstack, newsize, vsize);
     757         161 :   evalstate_reset();
     758         161 :   s = pari_mainstack->rsize;
     759         161 :   pari_warn(warner,"new stack size = %lu (%.3f Mbytes)", s, s/1048576.);
     760         161 :   pari_init_errcatch();
     761         161 :   cb_pari_err_recover(-1);
     762           0 : }
     763             : 
     764             : void
     765           0 : paristack_resize(ulong newsize)
     766             : {
     767           0 :   size_t vsize = pari_mainstack->vsize;
     768           0 :   if (!newsize)
     769           0 :     newsize = pari_mainstack->size << 1;
     770           0 :   newsize = maxuu(minuu(newsize, vsize), pari_mainstack->size);
     771           0 :   pari_mainstack->size = newsize;
     772           0 :   pari_mainstack->bot = pari_mainstack->top - pari_mainstack->size;
     773           0 :   pari_warn(warner,"increasing stack size to %lu",newsize);
     774           0 : }
     775             : 
     776             : void
     777       65796 : parivstack_reset(void)
     778             : {
     779       65796 :   pari_mainstack->size = pari_mainstack->rsize;
     780       65796 :   pari_mainstack->bot = pari_mainstack->top - pari_mainstack->size;
     781       65796 :   pari_mainstack_mreset((void *)pari_mainstack->vbot,
     782       65796 :                         pari_mainstack->bot-pari_mainstack->vbot);
     783       65796 : }
     784             : 
     785             : void
     786           0 : new_chunk_resize(size_t x)
     787             : {
     788           0 :   if (pari_mainstack->vsize==0
     789           0 :     || x > (avma-pari_mainstack->vbot) / sizeof(long)) pari_err(e_STACK);
     790           0 :   while (x > (avma-pari_mainstack->bot) / sizeof(long))
     791           0 :     paristack_resize(0);
     792           0 : }
     793             : 
     794             : /*********************************************************************/
     795             : /*                       PARI THREAD                                 */
     796             : /*********************************************************************/
     797             : 
     798             : /* Initial PARI thread structure t with a stack of size s and virtual size v
     799             :  * and argument arg */
     800             : 
     801             : void
     802           0 : pari_thread_valloc(struct pari_thread *t, size_t s, size_t v, GEN arg)
     803             : {
     804           0 :   pari_mainstack_alloc(&t->st,s,v);
     805           0 :   t->data = arg;
     806           0 : }
     807             : 
     808             : /* Initial PARI thread structure t with a stack of size s and
     809             :  * argument arg */
     810             : 
     811             : void
     812      200944 : pari_thread_alloc(struct pari_thread *t, size_t s, GEN arg)
     813             : {
     814      200944 :   pari_mainstack_alloc(&t->st,s,0);
     815      200944 :   t->data = arg;
     816      200944 : }
     817             : 
     818             : void
     819      200944 : pari_thread_free(struct pari_thread *t)
     820             : {
     821      200944 :   pari_mainstack_free(&t->st);
     822      200944 : }
     823             : 
     824             : void
     825      199514 : pari_thread_init(void)
     826             : {
     827      199514 :   pari_init_blocks();
     828      200245 :   pari_init_errcatch();
     829      199576 :   pari_init_rand();
     830      201970 :   pari_init_floats();
     831      201902 :   pari_init_parser();
     832      202047 :   pari_init_compiler();
     833      201950 :   pari_init_evaluator();
     834      201523 :   pari_init_files();
     835      201195 :   pari_thread_init_seadata();
     836      200967 : }
     837             : 
     838             : void
     839       12559 : pari_thread_sync(void)
     840             : {
     841       12559 :   pari_pthread_init_varstate();
     842       12559 :   pari_pthread_init_seadata();
     843       12559 : }
     844             : 
     845             : void
     846      202289 : pari_thread_close(void)
     847             : {
     848      202289 :   pari_thread_close_files();
     849      202388 :   pari_close_evaluator();
     850      202185 :   pari_close_compiler();
     851      202098 :   pari_close_parser();
     852      202060 :   pari_close_floats();
     853      201768 :   pari_close_blocks();
     854      200797 : }
     855             : 
     856             : GEN
     857      198282 : pari_thread_start(struct pari_thread *t)
     858             : {
     859      198282 :   pari_mainstack_use(&t->st);
     860      198204 :   pari_thread_init();
     861      199630 :   pari_thread_init_varstate();
     862      200845 :   return t->data;
     863             : }
     864             : 
     865             : /*********************************************************************/
     866             : /*                       LIBPARI INIT / CLOSE                        */
     867             : /*********************************************************************/
     868             : 
     869             : static void
     870           0 : pari_exit(void)
     871             : {
     872           0 :   err_printf("  ***   Error in the PARI system. End of program.\n");
     873           0 :   exit(1);
     874             : }
     875             : 
     876             : static void
     877           0 : dflt_err_recover(long errnum) { (void) errnum; pari_exit(); }
     878             : 
     879             : static void
     880           0 : dflt_pari_quit(long err) { (void)err; /*do nothing*/; }
     881             : 
     882             : static int pari_err_display(GEN err);
     883             : 
     884             : /* initialize PARI data. Initialize [new|old]fun to NULL for default set. */
     885             : void
     886        1328 : pari_init_opts(size_t parisize, ulong maxprime, ulong init_opts)
     887             : {
     888             :   ulong u;
     889             : 
     890        1328 :   pari_mt_nbthreads = 0;
     891        1328 :   cb_pari_quit = dflt_pari_quit;
     892        1328 :   cb_pari_init_histfile = NULL;
     893        1328 :   cb_pari_get_line_interactive = NULL;
     894        1328 :   cb_pari_fgets_interactive = NULL;
     895        1328 :   cb_pari_whatnow = NULL;
     896        1328 :   cb_pari_handle_exception = NULL;
     897        1328 :   cb_pari_err_handle = pari_err_display;
     898        1328 :   cb_pari_pre_recover = NULL;
     899        1328 :   cb_pari_break_loop = NULL;
     900        1328 :   cb_pari_is_interactive = NULL;
     901        1328 :   cb_pari_start_output = NULL;
     902        1328 :   cb_pari_sigint = dflt_sigint_fun;
     903        1328 :   if (init_opts&INIT_JMPm) cb_pari_err_recover = dflt_err_recover;
     904             : 
     905        1328 :   pari_stackcheck_init(&u);
     906        1328 :   pari_init_homedir();
     907        1328 :   if (init_opts&INIT_DFTm) {
     908           0 :     pari_init_defaults();
     909           0 :     GP_DATA = default_gp_data();
     910           0 :     gp_expand_path(GP_DATA->path);
     911             :   }
     912             : 
     913        1328 :   pari_mainstack = (struct pari_mainstack *) malloc(sizeof(*pari_mainstack));
     914        1328 :   paristack_alloc(parisize, 0);
     915        1328 :   init_universal_constants();
     916        1328 :   diffptr = NULL;
     917        1328 :   if (!(init_opts&INIT_noPRIMEm)) pari_init_primes(maxprime);
     918        1328 :   pari_kernel_init();
     919             : 
     920        1328 :   primetab = cgetalloc(t_VEC, 1);
     921        1328 :   pari_init_seadata();
     922        1328 :   pari_thread_init();
     923        1328 :   pari_init_functions();
     924        1328 :   pari_var_init();
     925        1328 :   pari_init_timer();
     926        1328 :   pari_init_buffers();
     927        1328 :   (void)getabstime();
     928        1328 :   try_to_recover = 1;
     929        1328 :   if (!(init_opts&INIT_noIMTm)) pari_mt_init();
     930        1328 :   if ((init_opts&INIT_SIGm)) pari_sig_init(pari_sighandler);
     931        1328 : }
     932             : 
     933             : void
     934           0 : pari_init(size_t parisize, ulong maxprime)
     935           0 : { pari_init_opts(parisize, maxprime, INIT_JMPm | INIT_SIGm | INIT_DFTm); }
     936             : 
     937             : void
     938        1836 : pari_close_opts(ulong init_opts)
     939             : {
     940             :   long i;
     941             : 
     942        1836 :   BLOCK_SIGINT_START;
     943        1836 :   if ((init_opts&INIT_SIGm)) pari_sig_init(SIG_DFL);
     944        1836 :   if (!(init_opts&INIT_noIMTm)) pari_mt_close();
     945             : 
     946      249696 :   for (i = 0; i < functions_tblsz; i++)
     947             :   {
     948      247860 :     entree *ep = functions_hash[i];
     949     2292494 :     while (ep) {
     950     1796774 :       entree *EP = ep->next;
     951     1796774 :       if (!EpSTATIC(ep)) { freeep(ep); free(ep); }
     952     1796774 :       ep = EP;
     953             :     }
     954             :   }
     955        1836 :   pari_var_close();
     956        1836 :   free((void*)primetab);
     957        1836 :   pari_thread_close();
     958        1836 :   pari_close_files();
     959        1836 :   pari_close_homedir();
     960        1836 :   pari_kernel_close();
     961             : 
     962        1836 :   free((void*)functions_hash);
     963        1836 :   free((void*)defaults_hash);
     964        1836 :   if (diffptr) pari_close_primes();
     965        1836 :   free(current_logfile);
     966        1836 :   free(current_psfile);
     967        1836 :   pari_mainstack_free(pari_mainstack);
     968        1836 :   free((void*)pari_mainstack);
     969        1836 :   pari_stack_delete(&s_MODULES);
     970        1836 :   if (pari_datadir) free(pari_datadir);
     971        1836 :   if (init_opts&INIT_DFTm)
     972             :   { /* delete GP_DATA */
     973        1836 :     if (GP_DATA->hist->v) free((void*)GP_DATA->hist->v);
     974        1836 :     if (GP_DATA->pp->cmd) free((void*)GP_DATA->pp->cmd);
     975        1836 :     delete_dirs(GP_DATA->path);
     976        1836 :     free((void*)GP_DATA->path->PATH);
     977        1836 :     delete_dirs(GP_DATA->sopath);
     978        1836 :     free((void*)GP_DATA->sopath->PATH);
     979        1836 :     if (GP_DATA->help) free((void*)GP_DATA->help);
     980        1836 :     free((void*)GP_DATA->prompt);
     981        1836 :     free((void*)GP_DATA->prompt_cont);
     982        1836 :     free((void*)GP_DATA->histfile);
     983             :   }
     984        1836 :   BLOCK_SIGINT_END;
     985        1836 : }
     986             : 
     987             : void
     988        1836 : pari_close(void)
     989        1836 : { pari_close_opts(INIT_JMPm | INIT_SIGm | INIT_DFTm); }
     990             : 
     991             : /*******************************************************************/
     992             : /*                                                                 */
     993             : /*                         ERROR RECOVERY                          */
     994             : /*                                                                 */
     995             : /*******************************************************************/
     996             : void
     997       79122 : gp_context_save(struct gp_context* rec)
     998             : {
     999       79122 :   rec->file = pari_last_tmp_file();
    1000       79122 :   if (DEBUGFILES>1)
    1001           0 :     err_printf("gp_context_save: %s\n", rec->file ? rec->file->name: "NULL");
    1002       79122 :   rec->prettyp = GP_DATA->fmt->prettyp;
    1003       79122 :   rec->listloc = next_block;
    1004       79122 :   rec->iferr_env = iferr_env;
    1005       79122 :   rec->err_data  = global_err_data;
    1006       79122 :   varstate_save(&rec->var);
    1007       79122 :   evalstate_save(&rec->eval);
    1008       79122 :   parsestate_save(&rec->parse);
    1009       79122 : }
    1010             : 
    1011             : void
    1012       15770 : gp_context_restore(struct gp_context* rec)
    1013             : {
    1014             :   long i;
    1015             : 
    1016       31540 :   if (!try_to_recover) return;
    1017             :   /* disable gp_context_restore() and SIGINT */
    1018       15770 :   try_to_recover = 0;
    1019       15770 :   BLOCK_SIGINT_START
    1020       15770 :   if (DEBUGMEM>2) err_printf("entering recover(), loc = %ld\n", rec->listloc);
    1021       15770 :   evalstate_restore(&rec->eval);
    1022       15770 :   parsestate_restore(&rec->parse);
    1023       15770 :   filestate_restore(rec->file);
    1024       15770 :   global_err_data = rec->err_data;
    1025       15770 :   iferr_env = rec->iferr_env;
    1026       15770 :   GP_DATA->fmt->prettyp = rec->prettyp;
    1027             : 
    1028     2144720 :   for (i = 0; i < functions_tblsz; i++)
    1029             :   {
    1030     2128950 :     entree *ep = functions_hash[i];
    1031    20290017 :     while (ep)
    1032             :     {
    1033    16032117 :       entree *EP = ep->next;
    1034    16032117 :       switch(EpVALENCE(ep))
    1035             :       {
    1036             :         case EpVAR:
    1037      161695 :           while (pop_val_if_newer(ep,rec->listloc)) /* empty */;
    1038      161695 :           break;
    1039      636602 :         case EpNEW: break;
    1040             :       }
    1041    16032117 :       ep = EP;
    1042             :     }
    1043             :   }
    1044       15770 :   varstate_restore(&rec->var);
    1045       15770 :   if (DEBUGMEM>2) err_printf("leaving recover()\n");
    1046       15770 :   BLOCK_SIGINT_END
    1047       15770 :   try_to_recover = 1;
    1048             : }
    1049             : 
    1050             : static void
    1051       15721 : err_recover(long numerr)
    1052             : {
    1053       15721 :   if (cb_pari_pre_recover)
    1054       15721 :     cb_pari_pre_recover(numerr);
    1055           0 :   evalstate_reset();
    1056           0 :   killallfiles();
    1057           0 :   pari_init_errcatch();
    1058           0 :   cb_pari_err_recover(numerr);
    1059           0 : }
    1060             : 
    1061             : static void
    1062       16127 : err_init(void)
    1063             : {
    1064             :   /* make sure pari_err msg starts at the beginning of line */
    1065       16127 :   if (!pari_last_was_newline()) pari_putc('\n');
    1066       16127 :   pariOut->flush();
    1067       16127 :   pariErr->flush();
    1068       16127 :   out_term_color(pariErr, c_ERR);
    1069       16127 : }
    1070             : 
    1071             : static void
    1072       16099 : err_init_msg(int user)
    1073             : {
    1074             :   const char *gp_function_name;
    1075       16099 :   out_puts(pariErr, "  *** ");
    1076       16099 :   if (!user && (gp_function_name = closure_func_err()))
    1077       11325 :     out_printf(pariErr, "%s: ", gp_function_name);
    1078             :   else
    1079        4774 :     out_puts(pariErr, "  ");
    1080       16099 : }
    1081             : 
    1082             : void
    1083         385 : pari_warn(int numerr, ...)
    1084             : {
    1085             :   char *ch1;
    1086             :   va_list ap;
    1087             : 
    1088         385 :   va_start(ap,numerr);
    1089             : 
    1090         385 :   err_init();
    1091         385 :   err_init_msg(numerr==warnuser || numerr==warnstack);
    1092         385 :   switch (numerr)
    1093             :   {
    1094             :     case warnuser:
    1095           7 :       out_puts(pariErr, "user warning: ");
    1096           7 :       out_print0(pariErr, NULL, va_arg(ap, GEN), f_RAW);
    1097           7 :       break;
    1098             : 
    1099             :     case warnmem:
    1100           0 :       out_puts(pariErr, "collecting garbage in "); ch1=va_arg(ap, char*);
    1101           0 :       out_vprintf(pariErr, ch1,ap); out_putc(pariErr, '.');
    1102           0 :       break;
    1103             : 
    1104             :     case warner:
    1105         378 :       out_puts(pariErr, "Warning: "); ch1=va_arg(ap, char*);
    1106         378 :       out_vprintf(pariErr, ch1,ap); out_putc(pariErr, '.');
    1107         378 :       break;
    1108             : 
    1109             :     case warnprec:
    1110           0 :       out_vprintf(pariErr, "Warning: increasing prec in %s; new prec = %ld",
    1111             :                       ap);
    1112           0 :       break;
    1113             : 
    1114             :     case warnfile:
    1115           0 :       out_puts(pariErr, "Warning: failed to "),
    1116           0 :       ch1 = va_arg(ap, char*);
    1117           0 :       out_printf(pariErr, "%s: %s", ch1, va_arg(ap, char*));
    1118           0 :       break;
    1119             : 
    1120             :     case warnstack:
    1121             :     {
    1122           0 :       ulong  s = va_arg(ap, ulong);
    1123             :       char buf[128];
    1124           0 :       sprintf(buf,"Warning: not enough memory, new stack %lu", (ulong)s);
    1125           0 :       out_puts(pariErr,buf);
    1126           0 :       break;
    1127             :     }
    1128             : 
    1129             :   }
    1130         385 :   va_end(ap);
    1131         385 :   out_term_color(pariErr, c_NONE);
    1132         385 :   out_putc(pariErr, '\n');
    1133         385 :   pariErr->flush();
    1134         385 : }
    1135             : void
    1136           0 : pari_sigint(const char *time_s)
    1137             : {
    1138           0 :   int recover=0;
    1139           0 :   BLOCK_SIGALRM_START
    1140           0 :   err_init();
    1141           0 :   closure_err(0);
    1142           0 :   err_init_msg(0);
    1143           0 :   out_puts(pariErr, "user interrupt after ");
    1144           0 :   out_puts(pariErr, time_s);
    1145           0 :   out_term_color(pariErr, c_NONE);
    1146           0 :   pariErr->flush();
    1147           0 :   if (cb_pari_handle_exception)
    1148           0 :     recover = cb_pari_handle_exception(-1);
    1149           0 :   if (!recover && !block)
    1150           0 :     PARI_SIGINT_pending = 0;
    1151           0 :   BLOCK_SIGINT_END
    1152           0 :   if (!recover) err_recover(e_MISC);
    1153           0 : }
    1154             : 
    1155             : #define retmkerr2(x,y)\
    1156             :   do { GEN _v = cgetg(3, t_ERROR);\
    1157             :        _v[1] = (x);\
    1158             :        gel(_v,2) = (y); return _v; } while(0)
    1159             : #define retmkerr3(x,y,z)\
    1160             :   do { GEN _v = cgetg(4, t_ERROR);\
    1161             :        _v[1] = (x);\
    1162             :        gel(_v,2) = (y);\
    1163             :        gel(_v,3) = (z); return _v; } while(0)
    1164             : #define retmkerr4(x,y,z,t)\
    1165             :   do { GEN _v = cgetg(5, t_ERROR);\
    1166             :        _v[1] = (x);\
    1167             :        gel(_v,2) = (y);\
    1168             :        gel(_v,3) = (z);\
    1169             :        gel(_v,4) = (t); return _v; } while(0)
    1170             : #define retmkerr5(x,y,z,t,u)\
    1171             :   do { GEN _v = cgetg(6, t_ERROR);\
    1172             :        _v[1] = (x);\
    1173             :        gel(_v,2) = (y);\
    1174             :        gel(_v,3) = (z);\
    1175             :        gel(_v,4) = (t);\
    1176             :        gel(_v,5) = (u); return _v; } while(0)
    1177             : #define retmkerr6(x,y,z,t,u,v)\
    1178             :   do { GEN _v = cgetg(7, t_ERROR);\
    1179             :        _v[1] = (x);\
    1180             :        gel(_v,2) = (y);\
    1181             :        gel(_v,3) = (z);\
    1182             :        gel(_v,4) = (t);\
    1183             :        gel(_v,5) = (u);\
    1184             :        gel(_v,6) = (v); return _v; } while(0)
    1185             : 
    1186             : static GEN
    1187       31037 : pari_err2GEN(long numerr, va_list ap)
    1188             : {
    1189       31037 :   switch ((enum err_list) numerr)
    1190             :   {
    1191             :   case e_SYNTAX:
    1192             :     {
    1193          28 :       const char *msg = va_arg(ap, char*);
    1194          28 :       const char *s = va_arg(ap,char *);
    1195          28 :       const char *entry = va_arg(ap,char *);
    1196          28 :       retmkerr3(numerr,strtoGENstr(msg), mkvecsmall2((long)s,(long)entry));
    1197             :     }
    1198             :   case e_MISC: case e_ALARM:
    1199             :     {
    1200        2678 :       const char *ch1 = va_arg(ap, char*);
    1201        2678 :       retmkerr2(numerr, gvsprintf(ch1,ap));
    1202             :     }
    1203             :   case e_NOTFUNC:
    1204             :   case e_USER:
    1205        2730 :     retmkerr2(numerr,va_arg(ap, GEN));
    1206             :   case e_FILE:
    1207             :     {
    1208           0 :       const char *f = va_arg(ap, const char*);
    1209           0 :       retmkerr3(numerr, strtoGENstr(f), strtoGENstr(va_arg(ap, char*)));
    1210             :     }
    1211             :   case e_OVERFLOW:
    1212             :   case e_IMPL:
    1213             :   case e_DIM:
    1214             :   case e_CONSTPOL:
    1215             :   case e_ROOTS0:
    1216             :   case e_FLAG:
    1217             :   case e_PREC:
    1218             :   case e_BUG:
    1219             :   case e_ARCH:
    1220             :   case e_PACKAGE:
    1221        1500 :     retmkerr2(numerr, strtoGENstr(va_arg(ap, char*)));
    1222             :   case e_MODULUS:
    1223             :   case e_VAR:
    1224             :     {
    1225        1211 :       const char *f = va_arg(ap, const char*);
    1226        1211 :       GEN x = va_arg(ap, GEN);
    1227        1211 :       GEN y = va_arg(ap, GEN);
    1228        1211 :       retmkerr4(numerr, strtoGENstr(f), x,y);
    1229             :     }
    1230             :   case e_INV:
    1231             :   case e_IRREDPOL:
    1232             :   case e_PRIME:
    1233             :   case e_SQRTN:
    1234             :   case e_TYPE:
    1235             :     {
    1236       14098 :       const char *f = va_arg(ap, const char*);
    1237       14098 :       GEN x = va_arg(ap, GEN);
    1238       14098 :       retmkerr3(numerr, strtoGENstr(f), x);
    1239             :     }
    1240             :   case e_COPRIME: case e_OP: case e_TYPE2:
    1241             :     {
    1242        3374 :       const char *f = va_arg(ap, const char*);
    1243        3374 :       GEN x = va_arg(ap, GEN);
    1244        3374 :       GEN y = va_arg(ap, GEN);
    1245        3374 :       retmkerr4(numerr,strtoGENstr(f),x,y);
    1246             :     }
    1247             :   case e_COMPONENT:
    1248             :     {
    1249         224 :       const char *f= va_arg(ap, const char *);
    1250         224 :       const char *op = va_arg(ap, const char *);
    1251         224 :       GEN l = va_arg(ap, GEN);
    1252         224 :       GEN x = va_arg(ap, GEN);
    1253         224 :       retmkerr5(numerr,strtoGENstr(f),strtoGENstr(op),l,x);
    1254             :     }
    1255             :   case e_DOMAIN:
    1256             :     {
    1257        5082 :       const char *f = va_arg(ap, const char*);
    1258        5082 :       const char *v = va_arg(ap, const char *);
    1259        5082 :       const char *op = va_arg(ap, const char *);
    1260        5082 :       GEN l = va_arg(ap, GEN);
    1261        5082 :       GEN x = va_arg(ap, GEN);
    1262        5082 :       retmkerr6(numerr,strtoGENstr(f),strtoGENstr(v),strtoGENstr(op),l,x);
    1263             :     }
    1264             :   case e_PRIORITY:
    1265             :     {
    1266         112 :       const char *f = va_arg(ap, const char*);
    1267         112 :       GEN x = va_arg(ap, GEN);
    1268         112 :       const char *op = va_arg(ap, const char *);
    1269         112 :       long v = va_arg(ap, long);
    1270         112 :       retmkerr5(numerr,strtoGENstr(f),x,strtoGENstr(op),stoi(v));
    1271             :     }
    1272             :   case e_MAXPRIME:
    1273           0 :     retmkerr2(numerr, utoi(va_arg(ap, ulong)));
    1274             :   case e_STACK:
    1275           0 :     return err_e_STACK;
    1276             :   case e_STACKTHREAD:
    1277           0 :     retmkerr3(numerr, utoi(va_arg(ap, ulong)), utoi(va_arg(ap, ulong)));
    1278             :   default:
    1279           0 :     return mkerr(numerr);
    1280             :   }
    1281             : }
    1282             : 
    1283             : static char *
    1284        6146 : type_dim(GEN x)
    1285             : {
    1286        6146 :   char *v = stack_malloc(64);
    1287        6146 :   switch(typ(x))
    1288             :   {
    1289             :     case t_MAT:
    1290             :     {
    1291          63 :       long l = lg(x), r = (l == 1)? 1: lgcols(x);
    1292          63 :       sprintf(v, "t_MAT (%ldx%ld)", r-1,l-1);
    1293          63 :       break;
    1294             :     }
    1295             :     case t_COL:
    1296          98 :       sprintf(v, "t_COL (%ld elts)", lg(x)-1);
    1297          98 :       break;
    1298             :     case t_VEC:
    1299         140 :       sprintf(v, "t_VEC (%ld elts)", lg(x)-1);
    1300         140 :       break;
    1301             :     default:
    1302        5845 :       v = (char*)type_name(typ(x));
    1303             :   }
    1304        6146 :   return v;
    1305             : }
    1306             : 
    1307             : static char *
    1308        2359 : gdisplay(GEN x)
    1309             : {
    1310        2359 :   char *s = GENtostr_raw(x);
    1311        2359 :   if (strlen(s) < 1600) return s;
    1312          21 :   if (! GP_DATA->breakloop) return (char*)"(...)";
    1313           0 :   return stack_sprintf("\n  ***  (...) Huge %s omitted; you can access it via dbg_err()", type_name(typ(x)));
    1314             : }
    1315             : 
    1316             : char *
    1317       23330 : pari_err2str(GEN e)
    1318             : {
    1319       23330 :   long numerr = err_get_num(e);
    1320       23330 :   switch ((enum err_list) numerr)
    1321             :   {
    1322             :   case e_ALARM:
    1323           0 :     return pari_sprintf("alarm interrupt after %Ps.",gel(e,2));
    1324             :   case e_MISC:
    1325        2676 :     return pari_sprintf("%Ps.",gel(e,2));
    1326             : 
    1327             :   case e_ARCH:
    1328           0 :     return pari_sprintf("sorry, '%Ps' not available on this system.",gel(e,2));
    1329             :   case e_BUG:
    1330          14 :     return pari_sprintf("bug in %Ps, please report.",gel(e,2));
    1331             :   case e_CONSTPOL:
    1332           7 :     return pari_sprintf("constant polynomial in %Ps.", gel(e,2));
    1333             :   case e_COPRIME:
    1334         210 :     return pari_sprintf("elements not coprime in %Ps:\n    %s\n    %s",
    1335         210 :                         gel(e,2), gdisplay(gel(e,3)), gdisplay(gel(e,4)));
    1336             :   case e_DIM:
    1337         890 :     return pari_sprintf("inconsistent dimensions in %Ps.", gel(e,2));
    1338             :   case e_FILE:
    1339           0 :     return pari_sprintf("error opening %Ps: `%Ps'.", gel(e,2), gel(e,3));
    1340             :   case e_FLAG:
    1341          14 :     return pari_sprintf("invalid flag in %Ps.", gel(e,2));
    1342             :   case e_IMPL:
    1343         210 :     return pari_sprintf("sorry, %Ps is not yet implemented.", gel(e,2));
    1344             :   case e_PACKAGE:
    1345           0 :     return pari_sprintf("package %Ps is required, please install it.", gel(e,2));
    1346             :   case e_INV:
    1347         637 :     return pari_sprintf("impossible inverse in %Ps: %s.", gel(e,2),
    1348         637 :                         gdisplay(gel(e,3)));
    1349             :   case e_IRREDPOL:
    1350          28 :     return pari_sprintf("not an irreducible polynomial in %Ps: %s.",
    1351          28 :                         gel(e,2), gdisplay(gel(e,3)));
    1352             :   case e_MAXPRIME:
    1353             :     {
    1354           0 :       const char * msg = "not enough precomputed primes";
    1355           0 :       ulong c = itou(gel(e,2));
    1356           0 :       if (c) return pari_sprintf("%s, need primelimit ~ %lu.",msg, c);
    1357           0 :       else   return pari_strdup(msg);
    1358             :     }
    1359             :   case e_MEM:
    1360           0 :     return pari_strdup("not enough memory");
    1361             :   case e_MODULUS:
    1362             :     {
    1363         721 :       GEN x = gel(e,3), y = gel(e,4);
    1364        1442 :       return pari_sprintf("inconsistent moduli in %Ps: %s != %s",
    1365         721 :                           gel(e,2), gdisplay(x), gdisplay(y));
    1366             :     }
    1367           0 :   case e_NONE: return NULL;
    1368             :   case e_NOTFUNC:
    1369        2716 :     return pari_strdup("not a function in function call");
    1370             :   case e_OP: case e_TYPE2:
    1371             :     {
    1372        3073 :       pari_sp av = avma;
    1373             :       char *v;
    1374        3073 :       const char *f, *op = GSTR(gel(e,2));
    1375        3073 :       const char *what = numerr == e_OP? "inconsistent": "forbidden";
    1376        3073 :       GEN x = gel(e,3);
    1377        3073 :       GEN y = gel(e,4);
    1378        3073 :       switch(*op)
    1379             :       {
    1380           7 :       case '+': f = "addition"; break;
    1381          49 :       case '*': f = "multiplication"; break;
    1382        2387 :       case '/': case '%': case '\\': f = "division"; break;
    1383           0 :       case '=': op = "-->"; f = "assignment"; break;
    1384         630 :       default:  f = op; op = ","; break;
    1385             :       }
    1386        3073 :       v = pari_sprintf("%s %s %s %s %s.", what,f,type_dim(x),op,type_dim(y));
    1387        3073 :       avma = av; return v;
    1388             :     }
    1389             :   case e_COMPONENT:
    1390             :     {
    1391         224 :       const char *f= GSTR(gel(e,2));
    1392         224 :       const char *op= GSTR(gel(e,3));
    1393         224 :       GEN l = gel(e,4);
    1394         224 :       if (!*f)
    1395         126 :         return pari_sprintf("non-existent component: index %s %Ps",op,l);
    1396          98 :       return pari_sprintf("non-existent component in %s: index %s %Ps",f,op,l);
    1397             :     }
    1398             :   case e_DOMAIN:
    1399             :     {
    1400        4984 :       const char *f = GSTR(gel(e,2));
    1401        4984 :       const char *v = GSTR(gel(e,3));
    1402        4984 :       const char *op= GSTR(gel(e,4));
    1403        4984 :       GEN l = gel(e,5);
    1404        4984 :       if (!*op)
    1405          28 :         return pari_sprintf("domain error in %s: %s out of range",f,v);
    1406        4956 :       return pari_sprintf("domain error in %s: %s %s %Ps",f,v,op,l);
    1407             :     }
    1408             :   case e_PRIORITY:
    1409             :     {
    1410          63 :       const char *f = GSTR(gel(e,2));
    1411          63 :       long vx = gvar(gel(e,3));
    1412          63 :       const char *op= GSTR(gel(e,4));
    1413          63 :       long v = itos(gel(e,5));
    1414          63 :       return pari_sprintf("incorrect priority in %s: variable %Ps %s %Ps",f,
    1415             :              pol_x(vx), op, pol_x(v));
    1416             :     }
    1417             :   case e_OVERFLOW:
    1418          70 :     return pari_sprintf("overflow in %Ps.", gel(e,2));
    1419             :   case e_PREC:
    1420         217 :     return pari_sprintf("precision too low in %Ps.", gel(e,2));
    1421             :   case e_PRIME:
    1422          98 :     return pari_sprintf("not a prime number in %Ps: %s.",
    1423          98 :                         gel(e,2), gdisplay(gel(e,3)));
    1424             :   case e_ROOTS0:
    1425          35 :     return pari_sprintf("zero polynomial in %Ps.", gel(e,2));
    1426             :   case e_SQRTN:
    1427         154 :     return pari_sprintf("not an n-th power residue in %Ps: %s.",
    1428         154 :                         gel(e,2), gdisplay(gel(e,3)));
    1429             :   case e_STACK:
    1430             :   case e_STACKTHREAD:
    1431             :     {
    1432           0 :       const char *stack = numerr == e_STACK? "PARI": "thread";
    1433           0 :       const char *var = numerr == e_STACK? "parisizemax": "threadsizemax";
    1434           0 :       size_t rsize = numerr == e_STACKTHREAD && GP_DATA->threadsize ?
    1435           0 :                                 GP_DATA->threadsize: pari_mainstack->rsize;
    1436           0 :       size_t vsize = numerr == e_STACK? pari_mainstack->vsize:
    1437           0 :                                         GP_DATA->threadsizemax;
    1438           0 :       char *buf = (char *) pari_malloc(512*sizeof(char));
    1439           0 :       if (vsize)
    1440             :       {
    1441           0 :         sprintf(buf, "the %s stack overflows !\n"
    1442             :             "  current stack size: %lu (%.3f Mbytes)\n"
    1443             :             "  [hint] you can increase '%s' using default()\n",
    1444           0 :             stack, (ulong)vsize, (double)vsize/1048576., var);
    1445             :       }
    1446             :       else
    1447             :       {
    1448           0 :         sprintf(buf, "the %s stack overflows !\n"
    1449             :             "  current stack size: %lu (%.3f Mbytes)\n"
    1450             :             "  [hint] set '%s' to a non-zero value in your GPRC\n",
    1451           0 :             stack, (ulong)rsize, (double)rsize/1048576., var);
    1452             :       }
    1453           0 :       return buf;
    1454             :     }
    1455             :   case e_SYNTAX:
    1456           0 :     return pari_strdup(GSTR(gel(e,2)));
    1457             :   case e_TYPE:
    1458       12130 :     return pari_sprintf("incorrect type in %Ps (%s).",
    1459       12130 :                         gel(e,2), type_name(typ(gel(e,3))));
    1460             :   case e_USER:
    1461          14 :     return pari_sprint0("user error: ", gel(e,2), f_RAW);
    1462             :   case e_VAR:
    1463             :     {
    1464         490 :       GEN x = gel(e,3), y = gel(e,4);
    1465        1470 :       return pari_sprintf("inconsistent variables in %Ps, %Ps != %Ps.",
    1466        1470 :                           gel(e,2), pol_x(varn(x)), pol_x(varn(y)));
    1467             :     }
    1468             :   }
    1469           0 :   return NULL; /*NOT REACHED*/
    1470             : }
    1471             : 
    1472             : static int
    1473       15742 : pari_err_display(GEN err)
    1474             : {
    1475       15742 :   long numerr=err_get_num(err);
    1476       15742 :   err_init();
    1477       15742 :   if (numerr==e_SYNTAX)
    1478             :   {
    1479          28 :     const char *msg = GSTR(gel(err,2));
    1480          28 :     const char *s     = (const char *) gmael(err,3,1);
    1481          28 :     const char *entry = (const char *) gmael(err,3,2);
    1482          28 :     print_errcontext(pariErr, msg, s, entry);
    1483             :   }
    1484             :   else
    1485             :   {
    1486       15714 :     char *s = pari_err2str(err);
    1487       15714 :     closure_err(0);
    1488       15714 :     err_init_msg(numerr==e_USER);
    1489       15714 :     pariErr->puts(s);
    1490       15714 :     if (numerr==e_NOTFUNC)
    1491             :     {
    1492        2716 :       GEN fun = gel(err,2);
    1493        2716 :       if (gequalX(fun))
    1494             :       {
    1495        2716 :         entree *ep = varentries[varn(fun)];
    1496        2716 :         const char *s = ep->name;
    1497        2716 :         if (cb_pari_whatnow) cb_pari_whatnow(pariErr,s,1);
    1498             :       }
    1499             :     }
    1500       15700 :     pari_free(s);
    1501             :   }
    1502       15728 :   out_term_color(pariErr, c_NONE);
    1503       15728 :   pariErr->flush(); return 0;
    1504             : }
    1505             : 
    1506             : void
    1507       31053 : pari_err(int numerr, ...)
    1508             : {
    1509             :   va_list ap;
    1510             :   GEN E;
    1511             : 
    1512       31053 :   va_start(ap,numerr);
    1513             : 
    1514       31053 :   if (numerr)
    1515       31037 :     E = pari_err2GEN(numerr,ap);
    1516             :   else
    1517             :   {
    1518          16 :     E = va_arg(ap,GEN);
    1519          16 :     numerr = err_get_num(E);
    1520             :   }
    1521       31053 :   global_err_data = E;
    1522       31053 :   if (*iferr_env) longjmp(*iferr_env, numerr);
    1523       15744 :   mt_err_recover(numerr);
    1524       15742 :   va_end(ap);
    1525       31470 :   if (cb_pari_err_handle &&
    1526       15742 :       cb_pari_err_handle(E)) return;
    1527       31449 :   if (cb_pari_handle_exception &&
    1528       15728 :       cb_pari_handle_exception(numerr)) return;
    1529       15721 :   err_recover(numerr);
    1530             : }
    1531             : 
    1532             : GEN
    1533       30607 : pari_err_last(void) { return global_err_data; }
    1534             : 
    1535             : const char *
    1536        7291 : numerr_name(long numerr)
    1537             : {
    1538        7291 :   switch ((enum err_list) numerr)
    1539             :   {
    1540           0 :   case e_ALARM:    return "e_ALARM";
    1541           0 :   case e_ARCH:     return "e_ARCH";
    1542           0 :   case e_BUG:      return "e_BUG";
    1543           0 :   case e_COMPONENT: return "e_COMPONENT";
    1544           0 :   case e_CONSTPOL: return "e_CONSTPOL";
    1545           0 :   case e_COPRIME:  return "e_COPRIME";
    1546           0 :   case e_DIM:      return "e_DIM";
    1547          56 :   case e_DOMAIN:   return "e_DOMAIN";
    1548           0 :   case e_FILE:     return "e_FILE";
    1549           7 :   case e_FLAG:     return "e_FLAG";
    1550          28 :   case e_IMPL:     return "e_IMPL";
    1551          53 :   case e_INV:      return "e_INV";
    1552           0 :   case e_IRREDPOL: return "e_IRREDPOL";
    1553           0 :   case e_MAXPRIME: return "e_MAXPRIME";
    1554           0 :   case e_MEM:      return "e_MEM";
    1555           0 :   case e_MISC:     return "e_MISC";
    1556           0 :   case e_MODULUS:  return "e_MODULUS";
    1557           0 :   case e_NONE:     return "e_NONE";
    1558           0 :   case e_NOTFUNC:  return "e_NOTFUNC";
    1559           0 :   case e_OP:       return "e_OP";
    1560           0 :   case e_OVERFLOW: return "e_OVERFLOW";
    1561           0 :   case e_PACKAGE:  return "e_PACKAGE";
    1562           0 :   case e_PREC:     return "e_PREC";
    1563           0 :   case e_PRIME:    return "e_PRIME";
    1564          49 :   case e_PRIORITY: return "e_PRIORITY";
    1565           0 :   case e_ROOTS0:   return "e_ROOTS0";
    1566           0 :   case e_SQRTN:    return "e_SQRTN";
    1567           0 :   case e_STACK:    return "e_STACK";
    1568           0 :   case e_SYNTAX:   return "e_SYNTAX";
    1569           0 :   case e_STACKTHREAD:   return "e_STACKTHREAD";
    1570           0 :   case e_TYPE2:    return "e_TYPE2";
    1571        7098 :   case e_TYPE:     return "e_TYPE";
    1572           0 :   case e_USER:     return "e_USER";
    1573           0 :   case e_VAR:      return "e_VAR";
    1574             :   }
    1575           0 :   return "invalid error number";
    1576             : }
    1577             : 
    1578             : long
    1579          21 : name_numerr(const char *s)
    1580             : {
    1581          21 :   if (!strcmp(s,"e_ALARM"))    return e_ALARM;
    1582          21 :   if (!strcmp(s,"e_ARCH"))     return e_ARCH;
    1583          21 :   if (!strcmp(s,"e_BUG"))      return e_BUG;
    1584          21 :   if (!strcmp(s,"e_COMPONENT")) return e_COMPONENT;
    1585          21 :   if (!strcmp(s,"e_CONSTPOL")) return e_CONSTPOL;
    1586          21 :   if (!strcmp(s,"e_COPRIME"))  return e_COPRIME;
    1587          21 :   if (!strcmp(s,"e_DIM"))      return e_DIM;
    1588          21 :   if (!strcmp(s,"e_DOMAIN"))   return e_DOMAIN;
    1589          21 :   if (!strcmp(s,"e_FILE"))     return e_FILE;
    1590          21 :   if (!strcmp(s,"e_FLAG"))     return e_FLAG;
    1591          21 :   if (!strcmp(s,"e_IMPL"))     return e_IMPL;
    1592          21 :   if (!strcmp(s,"e_INV"))      return e_INV;
    1593           0 :   if (!strcmp(s,"e_IRREDPOL")) return e_IRREDPOL;
    1594           0 :   if (!strcmp(s,"e_MAXPRIME")) return e_MAXPRIME;
    1595           0 :   if (!strcmp(s,"e_MEM"))      return e_MEM;
    1596           0 :   if (!strcmp(s,"e_MISC"))     return e_MISC;
    1597           0 :   if (!strcmp(s,"e_MODULUS"))  return e_MODULUS;
    1598           0 :   if (!strcmp(s,"e_NONE"))     return e_NONE;
    1599           0 :   if (!strcmp(s,"e_NOTFUNC"))  return e_NOTFUNC;
    1600           0 :   if (!strcmp(s,"e_OP"))       return e_OP;
    1601           0 :   if (!strcmp(s,"e_OVERFLOW")) return e_OVERFLOW;
    1602           0 :   if (!strcmp(s,"e_PACKAGE"))  return e_PACKAGE;
    1603           0 :   if (!strcmp(s,"e_PREC"))     return e_PREC;
    1604           0 :   if (!strcmp(s,"e_PRIME"))    return e_PRIME;
    1605           0 :   if (!strcmp(s,"e_PRIORITY")) return e_PRIORITY;
    1606           0 :   if (!strcmp(s,"e_ROOTS0"))   return e_ROOTS0;
    1607           0 :   if (!strcmp(s,"e_SQRTN"))    return e_SQRTN;
    1608           0 :   if (!strcmp(s,"e_STACK"))    return e_STACK;
    1609           0 :   if (!strcmp(s,"e_SYNTAX"))   return e_SYNTAX;
    1610           0 :   if (!strcmp(s,"e_TYPE"))     return e_TYPE;
    1611           0 :   if (!strcmp(s,"e_TYPE2"))    return e_TYPE2;
    1612           0 :   if (!strcmp(s,"e_USER"))     return e_USER;
    1613           0 :   if (!strcmp(s,"e_VAR"))      return e_VAR;
    1614           0 :   pari_err(e_MISC,"unknown error name");
    1615           0 :   return -1; /* NOT REACHED */
    1616             : }
    1617             : 
    1618             : GEN
    1619        7291 : errname(GEN err)
    1620             : {
    1621        7291 :   if (typ(err)!=t_ERROR) pari_err_TYPE("errname",err);
    1622        7291 :   return strtoGENstr(numerr_name(err_get_num(err)));
    1623             : }
    1624             : 
    1625             : /* Try f (trapping error e), recover using r (break_loop, if NULL) */
    1626             : GEN
    1627          21 : trap0(const char *e, GEN r, GEN f)
    1628             : {
    1629          21 :   long numerr = CATCH_ALL;
    1630             :   GEN x;
    1631          21 :   if (!e || !*e) numerr = CATCH_ALL;
    1632          21 :   else numerr = name_numerr(e);
    1633          21 :   if (!f) {
    1634           0 :     pari_warn(warner,"default handlers are no longer supported --> ignored");
    1635           0 :     return gnil;
    1636             :   }
    1637          21 :   x = closure_trapgen(f, numerr);
    1638          14 :   if (x == (GEN)1L) x = r? closure_evalgen(r): gnil;
    1639          14 :   return x;
    1640             : }
    1641             : 
    1642             : /*******************************************************************/
    1643             : /*                                                                */
    1644             : /*                       CLONING & COPY                            */
    1645             : /*                  Replicate an existing GEN                      */
    1646             : /*                                                                 */
    1647             : /*******************************************************************/
    1648             : /* lontyp[tx] = 0 (non recursive type) or number of codewords for type tx */
    1649             : const  long lontyp[] = { 0,0,0,1,1,2,1,2,1,1, 2,2,0,1,1,1,1,1,1,1, 2,0,0,2,2,1 };
    1650             : 
    1651             : static GEN
    1652         683 : list_internal_copy(GEN z, long nmax)
    1653             : {
    1654             :   long i, l;
    1655             :   GEN a;
    1656         683 :   if (!z) return NULL;
    1657         560 :   l = lg(z);
    1658         560 :   a = newblock(nmax+1);
    1659         560 :   for (i = 1; i < l; i++) gel(a,i) = gel(z,i)? gclone(gel(z,i)): gen_0;
    1660         560 :   a[0] = z[0]; return a;
    1661             : }
    1662             : 
    1663             : static void
    1664         683 : listassign(GEN x, GEN y)
    1665             : {
    1666         683 :   long nmax = list_nmax(x);
    1667         683 :   GEN L = list_data(x);
    1668         683 :   if (!nmax && L) nmax = lg(L) + 32; /* not malloc'ed yet */
    1669         683 :   y[1] = evaltyp(list_typ(x))|evallg(nmax);
    1670         683 :   list_data(y) = list_internal_copy(L, nmax);
    1671         683 : }
    1672             : 
    1673             : /* copy list on the PARI stack */
    1674             : GEN
    1675         165 : listcopy(GEN x)
    1676             : {
    1677         165 :   GEN y = listcreate(), L = list_data(x);
    1678         165 :   if (L) list_data(y) = gcopy(L);
    1679         165 :   y[1] = evaltyp(list_typ(x));
    1680         165 :   return y;
    1681             : }
    1682             : 
    1683             : GEN
    1684  3085156609 : gcopy(GEN x)
    1685             : {
    1686  3085156609 :   long tx = typ(x), lx, i;
    1687             :   GEN y;
    1688  3085156609 :   switch(tx)
    1689             :   { /* non recursive types */
    1690  2876219235 :     case t_INT: return signe(x)? icopy(x): gen_0;
    1691             :     case t_REAL:
    1692             :     case t_STR:
    1693   110967008 :     case t_VECSMALL: return leafcopy(x);
    1694             :     /* one more special case */
    1695         165 :     case t_LIST: return listcopy(x);
    1696             :   }
    1697    97970201 :   y = cgetg_copy(x, &lx);
    1698    97970202 :   if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1699    97970202 :   for (; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
    1700    97970201 :   return y;
    1701             : }
    1702             : 
    1703             : /* as gcopy, but truncate to the first lx components if recursive type
    1704             :  * [ leaves use their own lg ]. No checks. */
    1705             : GEN
    1706         294 : gcopy_lg(GEN x, long lx)
    1707             : {
    1708         294 :   long tx = typ(x), i;
    1709             :   GEN y;
    1710         294 :   switch(tx)
    1711             :   { /* non recursive types */
    1712           0 :     case t_INT: return signe(x)? icopy(x): gen_0;
    1713             :     case t_REAL:
    1714             :     case t_STR:
    1715           0 :     case t_VECSMALL: return leafcopy(x);
    1716             :     /* one more special case */
    1717           0 :     case t_LIST: return listcopy(x);
    1718             :   }
    1719         294 :   y = cgetg(lx, tx);
    1720         294 :   if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1721         294 :   for (; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
    1722         294 :   return y;
    1723             : }
    1724             : 
    1725             : /* cf cgetg_copy: "allocate" (by updating first codeword only) for subsequent
    1726             :  * copy of x, as if avma = *AVMA */
    1727             : INLINE GEN
    1728   192929977 : cgetg_copy_avma(GEN x, long *plx, pari_sp *AVMA) {
    1729             :   GEN z;
    1730   192929977 :   *plx = lg(x);
    1731   192929977 :   z = ((GEN)*AVMA) - *plx;
    1732   192929977 :   z[0] = x[0] & (TYPBITS|LGBITS);
    1733   192929977 :   *AVMA = (pari_sp)z; return z;
    1734             : }
    1735             : INLINE GEN
    1736         133 : cgetlist_avma(pari_sp *AVMA)
    1737             : {
    1738         133 :   GEN y = ((GEN)*AVMA) - 3;
    1739         133 :   y[0] = _evallg(3) | evaltyp(t_LIST);
    1740         133 :   *AVMA = (pari_sp)y; return y;
    1741             : }
    1742             : 
    1743             : /* copy x as if avma = *AVMA, update *AVMA */
    1744             : GEN
    1745  2527605202 : gcopy_avma(GEN x, pari_sp *AVMA)
    1746             : {
    1747  2527605202 :   long i, lx, tx = typ(x);
    1748             :   GEN y;
    1749             : 
    1750  2527605202 :   switch(typ(x))
    1751             :   { /* non recursive types */
    1752             :     case t_INT:
    1753  2474174802 :       *AVMA = (pari_sp)icopy_avma(x, *AVMA);
    1754  2474174725 :       return (GEN)*AVMA;
    1755             :     case t_REAL: case t_STR: case t_VECSMALL:
    1756    11609599 :       *AVMA = (pari_sp)leafcopy_avma(x, *AVMA);
    1757    11609601 :       return (GEN)*AVMA;
    1758             : 
    1759             :     /* one more special case */
    1760             :     case t_LIST:
    1761         133 :       y = cgetlist_avma(AVMA);
    1762         133 :       listassign(x, y); return y;
    1763             : 
    1764             :   }
    1765    41820668 :   y = cgetg_copy_avma(x, &lx, AVMA);
    1766    41820671 :   if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1767    41820671 :   for (; i<lx; i++) gel(y,i) = gcopy_avma(gel(x,i), AVMA);
    1768    41820678 :   return y;
    1769             : }
    1770             : 
    1771             : /* [copy_bin/bin_copy:] same as gcopy_avma but use NULL to code an exact 0, and
    1772             :  * make shallow copies of finalized t_LISTs */
    1773             : static GEN
    1774   850909239 : gcopy_av0(GEN x, pari_sp *AVMA)
    1775             : {
    1776   850909239 :   long i, lx, tx = typ(x);
    1777             :   GEN y;
    1778             : 
    1779   850909239 :   switch(tx)
    1780             :   { /* non recursive types */
    1781             :     case t_INT:
    1782   616833730 :       if (!signe(x)) return NULL; /* special marker */
    1783   317073613 :       *AVMA = (pari_sp)icopy_avma(x, *AVMA);
    1784   317073662 :       return (GEN)*AVMA;
    1785             :     case t_LIST:
    1786          49 :       if (list_data(x) && !list_nmax(x)) break; /* not finalized, need copy */
    1787             :       /* else finalized: shallow copy */
    1788             :     case t_REAL: case t_STR: case t_VECSMALL:
    1789    82966233 :       *AVMA = (pari_sp)leafcopy_avma(x, *AVMA);
    1790    82966233 :       return (GEN)*AVMA;
    1791             :   }
    1792   151109276 :   y = cgetg_copy_avma(x, &lx, AVMA);
    1793   151109264 :   if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1794   151109264 :   for (; i<lx; i++) gel(y,i) = gcopy_av0(gel(x,i), AVMA);
    1795   151109363 :   return y;
    1796             : }
    1797             : 
    1798             : INLINE GEN
    1799           0 : icopy_avma_canon(GEN x, pari_sp AVMA)
    1800             : {
    1801           0 :   long i, lx = lgefint(x);
    1802           0 :   GEN y = ((GEN)AVMA) - lx;
    1803           0 :   y[0] = evaltyp(t_INT)|evallg(lx); /* kills isclone */
    1804           0 :   y[1] = x[1]; x = int_MSW(x);
    1805           0 :   for (i=2; i<lx; i++, x = int_precW(x)) y[i] = *x;
    1806           0 :   return y;
    1807             : }
    1808             : 
    1809             : /* [copy_bin_canon:] same as gcopy_av0, but copy integers in
    1810             :  * canonical (native kernel) form and make a full copy of t_LISTs */
    1811             : static GEN
    1812           0 : gcopy_av0_canon(GEN x, pari_sp *AVMA)
    1813             : {
    1814           0 :   long i, lx, tx = typ(x);
    1815             :   GEN y;
    1816             : 
    1817           0 :   switch(tx)
    1818             :   { /* non recursive types */
    1819             :     case t_INT:
    1820           0 :       if (!signe(x)) return NULL; /* special marker */
    1821           0 :       *AVMA = (pari_sp)icopy_avma_canon(x, *AVMA);
    1822           0 :       return (GEN)*AVMA;
    1823             :     case t_REAL: case t_STR: case t_VECSMALL:
    1824           0 :       *AVMA = (pari_sp)leafcopy_avma(x, *AVMA);
    1825           0 :       return (GEN)*AVMA;
    1826             : 
    1827             :     /* one more special case */
    1828             :     case t_LIST:
    1829             :     {
    1830           0 :       long t = list_typ(x);
    1831           0 :       GEN y = cgetlist_avma(AVMA), z = list_data(x);
    1832           0 :       if (z) {
    1833           0 :         list_data(y) = gcopy_av0_canon(z, AVMA);
    1834           0 :         y[1] = evaltyp(t)|evallg(lg(z)-1);
    1835             :       } else {
    1836           0 :         list_data(y) = NULL;
    1837           0 :         y[1] = evaltyp(t);
    1838             :       }
    1839           0 :       return y;
    1840             :     }
    1841             :   }
    1842           0 :   y = cgetg_copy_avma(x, &lx, AVMA);
    1843           0 :   if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1844           0 :   for (; i<lx; i++) gel(y,i) = gcopy_av0_canon(gel(x,i), AVMA);
    1845           0 :   return y;
    1846             : }
    1847             : 
    1848             : /* [copy_bin/bin_copy:] size (number of words) required for
    1849             :  * gcopy_av0_canon(x) */
    1850             : static long
    1851           0 : taille0_canon(GEN x)
    1852             : {
    1853           0 :   long i,n,lx, tx = typ(x);
    1854           0 :   switch(tx)
    1855             :   { /* non recursive types */
    1856           0 :     case t_INT: return signe(x)? lgefint(x): 0;
    1857             :     case t_REAL:
    1858             :     case t_STR:
    1859           0 :     case t_VECSMALL: return lg(x);
    1860             : 
    1861             :     /* one more special case */
    1862             :     case t_LIST:
    1863             :     {
    1864           0 :       GEN L = list_data(x);
    1865           0 :       return L? 3 + taille0_canon(L): 3;
    1866             :     }
    1867             :   }
    1868           0 :   n = lx = lg(x);
    1869           0 :   for (i=lontyp[tx]; i<lx; i++) n += taille0_canon(gel(x,i));
    1870           0 :   return n;
    1871             : }
    1872             : 
    1873             : /* [copy_bin/bin_copy:] size (number of words) required for gcopy_av0(x) */
    1874             : static long
    1875   850909734 : taille0(GEN x)
    1876             : {
    1877   850909734 :   long i,n,lx, tx = typ(x);
    1878   850909734 :   switch(tx)
    1879             :   { /* non recursive types */
    1880             :     case t_INT:
    1881   616834140 :       lx = lgefint(x);
    1882   616834140 :       return lx == 2? 0: lx;
    1883             :     case t_LIST:
    1884             :     {
    1885          49 :       GEN L = list_data(x);
    1886          49 :       if (L && !list_nmax(x)) break; /* not finalized, deep copy */
    1887             :     }
    1888             :     /* else finalized: shallow */
    1889             :     case t_REAL:
    1890             :     case t_STR:
    1891             :     case t_VECSMALL:
    1892    82966227 :       return lg(x);
    1893             :   }
    1894   151109367 :   n = lx = lg(x);
    1895   151109367 :   for (i=lontyp[tx]; i<lx; i++) n += taille0(gel(x,i));
    1896   151109371 :   return n;
    1897             : }
    1898             : 
    1899             : /* How many words do we need to allocate to copy x ? t_LIST is a special case
    1900             :  * since list_data() is malloc'ed later, in list_internal_copy() */
    1901             : static long
    1902  2665185316 : words_to_allocate(GEN x)
    1903             : {
    1904  2665185316 :   long i,n,lx, tx = typ(x);
    1905  2665185316 :   switch(tx)
    1906             :   { /* non recursive types */
    1907  2569841002 :     case t_INT: return lgefint(x);
    1908             :     case t_REAL:
    1909             :     case t_STR:
    1910    17427660 :     case t_VECSMALL: return lg(x);
    1911             : 
    1912         690 :     case t_LIST: return 3;
    1913             :     default:
    1914    77915964 :       n = lx = lg(x);
    1915    77915964 :       for (i=lontyp[tx]; i<lx; i++) n += words_to_allocate(gel(x,i));
    1916    77916008 :       return n;
    1917             :   }
    1918             : }
    1919             : 
    1920             : long
    1921        6615 : gsizeword(GEN x)
    1922             : {
    1923             :   GEN L;
    1924        6615 :   if (typ(x) != t_LIST) return words_to_allocate(x);
    1925             :   /* For t_LIST, return the actual list size, words_to_allocate() is always 3 */
    1926         147 :   L = list_data(x);
    1927         147 :   return L? 3 + words_to_allocate(L): 3;
    1928             : }
    1929             : long
    1930           0 : gsizebyte(GEN x) { return gsizeword(x) * sizeof(long); }
    1931             : 
    1932             : /* return a clone of x structured as a gcopy */
    1933             : GENbin*
    1934    46645153 : copy_bin(GEN x)
    1935             : {
    1936    46645153 :   long t = taille0(x);
    1937    46645171 :   GENbin *p = (GENbin*)pari_malloc(sizeof(GENbin) + t*sizeof(long));
    1938    46645171 :   pari_sp AVMA = (pari_sp)(GENbinbase(p) + t);
    1939    46645167 :   p->rebase = &shiftaddress;
    1940    46645167 :   p->len = t;
    1941    46645167 :   p->x   = gcopy_av0(x, &AVMA);
    1942    46645173 :   p->base= (GEN)AVMA; return p;
    1943             : }
    1944             : 
    1945             : /* same, writing t_INT in canonical native form */
    1946             : GENbin*
    1947           0 : copy_bin_canon(GEN x)
    1948             : {
    1949           0 :   long t = taille0_canon(x);
    1950           0 :   GENbin *p = (GENbin*)pari_malloc(sizeof(GENbin) + t*sizeof(long));
    1951           0 :   pari_sp AVMA = (pari_sp)(GENbinbase(p) + t);
    1952           0 :   p->rebase = &shiftaddress_canon;
    1953           0 :   p->len = t;
    1954           0 :   p->x   = gcopy_av0_canon(x, &AVMA);
    1955           0 :   p->base= (GEN)AVMA; return p;
    1956             : }
    1957             : 
    1958             : GEN
    1959   137560627 : gclone(GEN x)
    1960             : {
    1961   137560627 :   long i,lx,tx = typ(x), t = words_to_allocate(x);
    1962   137560629 :   GEN y = newblock(t);
    1963   137560628 :   switch(tx)
    1964             :   { /* non recursive types */
    1965             :     case t_INT:
    1966    95548263 :       lx = lgefint(x);
    1967    95548263 :       y[0] = evaltyp(t_INT)|evallg(lx);
    1968    95548264 :       for (i=1; i<lx; i++) y[i] = x[i];
    1969    95548264 :       break;
    1970             :     case t_REAL:
    1971             :     case t_STR:
    1972             :     case t_VECSMALL:
    1973     5925767 :       lx = lg(x);
    1974     5925767 :       for (i=0; i<lx; i++) y[i] = x[i];
    1975     5925767 :       break;
    1976             : 
    1977             :     /* one more special case */
    1978             :     case t_LIST:
    1979         550 :       y[0] = evaltyp(t_LIST)|_evallg(3);
    1980         550 :       listassign(x, y);
    1981         550 :       break;
    1982             :     default: {
    1983    36086048 :       pari_sp AVMA = (pari_sp)(y + t);
    1984    36086048 :       lx = lg(x);
    1985    36086048 :       y[0] = x[0];
    1986    36086048 :       if (lontyp[tx] == 1) i = 1; else { y[1] = x[1]; i = 2; }
    1987    36086048 :       for (; i<lx; i++) gel(y,i) = gcopy_avma(gel(x,i), &AVMA);
    1988             :     }
    1989             :   }
    1990   137560631 :   setisclone(y); return y;
    1991             : }
    1992             : 
    1993             : void
    1994   551148972 : shiftaddress(GEN x, long dec)
    1995             : {
    1996   551148972 :   long i, lx, tx = typ(x);
    1997   551148972 :   if (is_recursive_t(tx))
    1998             :   {
    1999   151109423 :     if (tx == t_LIST)
    2000             :     {
    2001   551149130 :       if (!list_data(x) || list_nmax(x)) return; /* empty or finalized */
    2002             :       /* not finalized, update pointers  */
    2003             :     }
    2004   151109381 :     lx = lg(x);
    2005   955373620 :     for (i=lontyp[tx]; i<lx; i++) {
    2006   804264144 :       if (!x[i]) gel(x,i) = gen_0;
    2007             :       else
    2008             :       {
    2009   504505720 :         x[i] += dec;
    2010   504505720 :         shiftaddress(gel(x,i), dec);
    2011             :       }
    2012             :     }
    2013             :   }
    2014             : }
    2015             : 
    2016             : void
    2017           0 : shiftaddress_canon(GEN x, long dec)
    2018             : {
    2019           0 :   long i, lx, tx = typ(x);
    2020           0 :   switch(tx)
    2021             :   { /* non recursive types */
    2022             :     case t_INT: {
    2023             :       GEN y;
    2024           0 :       lx = lgefint(x); if (lx <= 3) return;
    2025           0 :       y = x + 2;
    2026           0 :       x = int_MSW(x);  if (x == y) return;
    2027           0 :       while (x > y) { lswap(*x, *y); x = int_precW(x); y++; }
    2028           0 :       break;
    2029             :     }
    2030             :     case t_REAL:
    2031             :     case t_STR:
    2032             :     case t_VECSMALL:
    2033           0 :       break;
    2034             : 
    2035             :     /* one more special case */
    2036             :     case t_LIST: {
    2037           0 :       GEN Lx = list_data(x);
    2038           0 :       if (Lx) {
    2039           0 :         pari_sp av = avma;
    2040           0 :         GEN L = (GEN)((long)Lx+dec);
    2041           0 :         shiftaddress_canon(L, dec);
    2042           0 :         list_data(x) = list_internal_copy(L, lg(L)); avma = av;
    2043             :       }
    2044             :     }
    2045             :     default:
    2046           0 :       lx = lg(x);
    2047           0 :       for (i=lontyp[tx]; i<lx; i++) {
    2048           0 :         if (!x[i]) gel(x,i) = gen_0;
    2049             :         else
    2050             :         {
    2051           0 :           x[i] += dec;
    2052           0 :           shiftaddress_canon(gel(x,i), dec);
    2053             :         }
    2054             :       }
    2055             :   }
    2056             : }
    2057             : 
    2058             : /********************************************************************/
    2059             : /**                                                                **/
    2060             : /**                INSERT DYNAMIC OBJECT IN STRUCTURE              **/
    2061             : /**                                                                **/
    2062             : /********************************************************************/
    2063             : GEN
    2064           7 : obj_reinit(GEN S)
    2065             : {
    2066           7 :   GEN s, T = leafcopy(S);
    2067           7 :   long a = lg(T)-1;
    2068           7 :   s = gel(T,a);
    2069           7 :   gel(T,a) = zerovec(lg(s)-1);
    2070           7 :   return T;
    2071             : }
    2072             : 
    2073             : GEN
    2074     1790837 : obj_init(long d, long n)
    2075             : {
    2076     1790837 :   GEN S = cgetg(d+2, t_VEC);
    2077     1790837 :   gel(S, d+1) = zerovec(n);
    2078     1790839 :   return S;
    2079             : }
    2080             : /* insert O in S [last position] at position K, return it */
    2081             : GEN
    2082     1046189 : obj_insert(GEN S, long K, GEN O)
    2083     1046189 : { return obj_insert_shallow(S, K, gclone(O)); }
    2084             : /* as obj_insert. WITHOUT cloning (for libpari, when creating a *new* obj
    2085             :  * from an existing one) */
    2086             : GEN
    2087     1048947 : obj_insert_shallow(GEN S, long K, GEN O)
    2088             : {
    2089     1048947 :   GEN o, v = gel(S, lg(S)-1);
    2090     1048947 :   if (typ(v) != t_VEC) pari_err_TYPE("obj_insert", S);
    2091     1048947 :   o = gel(v,K);
    2092     1048947 :   gel(v,K) = O; /*SIGINT: before unclone(o)*/
    2093     1048947 :   if (isclone(o)) gunclone(o);
    2094     1048947 :   return gel(v,K);
    2095             : }
    2096             : 
    2097             : /* Does S [last position] contain data at position K ? Return it, or NULL */
    2098             : GEN
    2099     2337331 : obj_check(GEN S, long K)
    2100             : {
    2101     2337331 :   GEN O, v = gel(S, lg(S)-1);
    2102     2337331 :   if (typ(v) != t_VEC || K >= lg(v)) pari_err_TYPE("obj_check", S);
    2103     2337324 :   O = gel(v,K); return isintzero(O)? NULL: O;
    2104             : }
    2105             : 
    2106             : GEN
    2107      670007 : obj_checkbuild(GEN S, long tag, GEN (*build)(GEN))
    2108             : {
    2109      670007 :   GEN O = obj_check(S, tag);
    2110      670007 :   if (!O)
    2111      589276 :   { pari_sp av = avma; O = obj_insert(S, tag, build(S)); avma = av; }
    2112      670007 :   return O;
    2113             : }
    2114             : 
    2115             : GEN
    2116       26020 : obj_checkbuild_prec(GEN S, long tag, GEN (*build)(GEN,long),
    2117             :   long (*pr)(GEN), long prec)
    2118             : {
    2119       26020 :   pari_sp av = avma;
    2120       26020 :   GEN w = obj_check(S, tag);
    2121       26013 :   if (!w || pr(w) < prec) w = obj_insert(S, tag, build(S, prec));
    2122       26006 :   avma = av; return gcopy(w);
    2123             : }
    2124             : GEN
    2125        4257 : obj_checkbuild_realprec(GEN S, long tag, GEN (*build)(GEN,long), long prec)
    2126        4257 : { return obj_checkbuild_prec(S,tag,build,gprecision,prec); }
    2127             : GEN
    2128         294 : obj_checkbuild_padicprec(GEN S, long tag, GEN (*build)(GEN,long), long prec)
    2129         294 : { return obj_checkbuild_prec(S,tag,build,padicprec_relative,prec); }
    2130             : 
    2131             : /* Reset S [last position], freeing all clones */
    2132             : void
    2133        5124 : obj_free(GEN S)
    2134             : {
    2135        5124 :   GEN v = gel(S, lg(S)-1);
    2136             :   long i;
    2137        5124 :   if (typ(v) != t_VEC) pari_err_TYPE("obj_free", S);
    2138       29708 :   for (i = 1; i < lg(v); i++)
    2139             :   {
    2140       24584 :     GEN o = gel(v,i);
    2141       24584 :     if (isclone(o)) gunclone(o);
    2142       24584 :     gel(v,i) = gen_0;
    2143             :   }
    2144        5124 : }
    2145             : 
    2146             : /*******************************************************************/
    2147             : /*                                                                 */
    2148             : /*                         STACK MANAGEMENT                        */
    2149             : /*                                                                 */
    2150             : /*******************************************************************/
    2151             : INLINE void
    2152  2027672296 : dec_gerepile(pari_sp *x, pari_sp av0, pari_sp av, pari_sp tetpil, size_t dec)
    2153             : {
    2154  2027672296 :   if (*x < av && *x >= av0)
    2155             :   { /* update address if in stack */
    2156  1627478863 :     if (*x < tetpil) *x += dec;
    2157           0 :     else pari_err_BUG("gerepile, significant pointers lost");
    2158             :   }
    2159  2027672296 : }
    2160             : 
    2161             : void
    2162      202097 : gerepileallsp(pari_sp av, pari_sp tetpil, int n, ...)
    2163             : {
    2164      202097 :   const pari_sp av0 = avma;
    2165      202097 :   const size_t dec = av-tetpil;
    2166             :   int i;
    2167      202097 :   va_list a; va_start(a, n);
    2168      202097 :   (void)gerepile(av,tetpil,NULL);
    2169      202097 :   for (i=0; i<n; i++) dec_gerepile((pari_sp*)va_arg(a,GEN*), av0,av,tetpil,dec);
    2170      202097 : }
    2171             : 
    2172             : /* Takes an array of pointers to GENs, of length n.
    2173             :  * Cleans up the stack between av and tetpil, updating those GENs. */
    2174             : void
    2175     5363592 : gerepilemanysp(pari_sp av, pari_sp tetpil, GEN* gptr[], int n)
    2176             : {
    2177     5363592 :   const pari_sp av0 = avma;
    2178     5363592 :   const size_t dec = av-tetpil;
    2179             :   int i;
    2180     5363592 :   (void)gerepile(av,tetpil,NULL);
    2181     5363592 :   for (i=0; i<n; i++) dec_gerepile((pari_sp*)gptr[i], av0, av, tetpil, dec);
    2182     5363592 : }
    2183             : 
    2184             : /* Takes an array of GENs (cast to longs), of length n.
    2185             :  * Cleans up the stack between av and tetpil, updating those GENs. */
    2186             : void
    2187    97897127 : gerepilecoeffssp(pari_sp av, pari_sp tetpil, long *g, int n)
    2188             : {
    2189    97897127 :   const pari_sp av0 = avma;
    2190    97897127 :   const size_t dec = av-tetpil;
    2191             :   int i;
    2192    97897127 :   (void)gerepile(av,tetpil,NULL);
    2193    97897127 :   for (i=0; i<n; i++,g++) dec_gerepile((pari_sp*)g, av0, av, tetpil, dec);
    2194    97897127 : }
    2195             : 
    2196             : static int
    2197           0 : dochk_gerepileupto(GEN av, GEN x)
    2198             : {
    2199             :   long i,lx,tx;
    2200           0 :   if (!isonstack(x)) return 1;
    2201           0 :   if (x > av)
    2202             :   {
    2203           0 :     pari_warn(warner,"bad object %Ps",x);
    2204           0 :     return 0;
    2205             :   }
    2206           0 :   tx = typ(x);
    2207           0 :   if (! is_recursive_t(tx)) return 1;
    2208             : 
    2209           0 :   lx = lg(x);
    2210           0 :   for (i=lontyp[tx]; i<lx; i++)
    2211           0 :     if (!dochk_gerepileupto(av, gel(x,i)))
    2212             :     {
    2213           0 :       pari_warn(warner,"bad component %ld in object %Ps",i,x);
    2214           0 :       return 0;
    2215             :     }
    2216           0 :   return 1;
    2217             : }
    2218             : /* check that x and all its components are out of stack, or have been
    2219             :  * created after av */
    2220             : int
    2221           0 : chk_gerepileupto(GEN x) { return dochk_gerepileupto(x, x); }
    2222             : 
    2223             : /* print stack between avma & av */
    2224             : void
    2225           0 : dbg_gerepile(pari_sp av)
    2226             : {
    2227           0 :   GEN x = (GEN)avma;
    2228           0 :   while (x < (GEN)av)
    2229             :   {
    2230           0 :     const long tx = typ(x), lx = lg(x);
    2231             :     GEN *a;
    2232             : 
    2233           0 :     pari_printf(" [%ld] %Ps:", x - (GEN)avma, x);
    2234           0 :     if (! is_recursive_t(tx)) { pari_putc('\n'); x += lx; continue; }
    2235           0 :     a = (GEN*)x + lontyp[tx]; x += lx;
    2236           0 :     for (  ; a < (GEN*)x; a++)
    2237             :     {
    2238           0 :       if (*a == gen_0)
    2239           0 :         pari_puts("  gen_0");
    2240           0 :       else if (*a == gen_1)
    2241           0 :         pari_puts("  gen_1");
    2242           0 :       else if (*a == gen_m1)
    2243           0 :         pari_puts("  gen_m1");
    2244           0 :       else if (*a == gen_2)
    2245           0 :         pari_puts("  gen_2");
    2246           0 :       else if (*a == gen_m2)
    2247           0 :         pari_puts("  gen_m2");
    2248           0 :       else if (*a == ghalf)
    2249           0 :         pari_puts("  ghalf");
    2250           0 :       else if (isclone(*a))
    2251           0 :         pari_printf("  %Ps (clone)", *a);
    2252             :       else
    2253           0 :         pari_printf("  %Ps [%ld]", *a, *a - (GEN)avma);
    2254           0 :       if (a+1 < (GEN*)x) pari_putc(',');
    2255             :     }
    2256           0 :     pari_printf("\n");
    2257             :   }
    2258           0 : }
    2259             : void
    2260           0 : dbg_gerepileupto(GEN q)
    2261             : {
    2262           0 :   err_printf("%Ps:\n", q);
    2263           0 :   dbg_gerepile((pari_sp) (q+lg(q)));
    2264           0 : }
    2265             : 
    2266             : GEN
    2267   407928847 : gerepile(pari_sp av, pari_sp tetpil, GEN q)
    2268             : {
    2269   407928847 :   const size_t dec = av - tetpil;
    2270   407928847 :   const pari_sp av0 = avma;
    2271             :   GEN x, a;
    2272             : 
    2273   407928847 :   if (dec == 0) return q;
    2274   342913157 :   if ((long)dec < 0) pari_err(e_MISC,"lbot>ltop in gerepile");
    2275             : 
    2276             :   /* dec_gerepile(&q, av0, av, tetpil, dec), saving 1 comparison */
    2277   342880105 :   if (q >= (GEN)av0 && q < (GEN)tetpil)
    2278   243179413 :     q = (GEN) (((pari_sp)q) + dec);
    2279             : 
    2280   342880105 :   for (x = (GEN)av, a = (GEN)tetpil; a > (GEN)av0; ) *--x = *--a;
    2281   342880105 :   avma = (pari_sp)x;
    2282  2677296517 :   while (x < (GEN)av)
    2283             :   {
    2284  1991487868 :     const long tx = typ(x), lx = lg(x);
    2285             : 
    2286  1991487868 :     if (! is_recursive_t(tx)) { x += lx; continue; }
    2287   414601395 :     a = x + lontyp[tx]; x += lx;
    2288   414601395 :     for (  ; a < x; a++) dec_gerepile((pari_sp*)a, av0, av, tetpil, dec);
    2289             :   }
    2290   342928544 :   return q;
    2291             : }
    2292             : 
    2293             : void
    2294           0 : fill_stack(void)
    2295             : {
    2296           0 :   GEN x = ((GEN)pari_mainstack->bot);
    2297           0 :   while (x < (GEN)avma) *x++ = 0xfefefefeUL;
    2298           0 : }
    2299             : 
    2300             : void
    2301           0 : debug_stack(void)
    2302             : {
    2303           0 :   pari_sp top = pari_mainstack->top, bot = pari_mainstack->bot;
    2304             :   GEN z;
    2305           0 :   err_printf("bot=0x%lx\ttop=0x%lx\tavma=0x%lx\n", bot, top, avma);
    2306           0 :   for (z = ((GEN)top)-1; z >= (GEN)avma; z--)
    2307           0 :     err_printf("%p:\t0x%lx\t%lu\n",z,*z,*z);
    2308           0 : }
    2309             : 
    2310             : void
    2311           0 : setdebugvar(long n) { DEBUGVAR=n; }
    2312             : 
    2313             : long
    2314           0 : getdebugvar(void) { return DEBUGVAR; }
    2315             : 
    2316             : long
    2317           7 : getstack(void) { return pari_mainstack->top-avma; }
    2318             : 
    2319             : /*******************************************************************/
    2320             : /*                                                                 */
    2321             : /*                               timer_delay                             */
    2322             : /*                                                                 */
    2323             : /*******************************************************************/
    2324             : 
    2325             : #if defined(USE_CLOCK_GETTIME)
    2326             : #if defined(_POSIX_THREAD_CPUTIME)
    2327             : static THREAD clockid_t time_type = CLOCK_THREAD_CPUTIME_ID;
    2328             : #else
    2329             : static const THREAD clockid_t time_type = CLOCK_PROCESS_CPUTIME_ID;
    2330             : #endif
    2331             : static void
    2332             : pari_init_timer(void)
    2333             : {
    2334             : #if defined(_POSIX_THREAD_CPUTIME)
    2335             :   time_type = CLOCK_PROCESS_CPUTIME_ID;
    2336             : #endif
    2337             : }
    2338             : 
    2339             : void
    2340             : timer_start(pari_timer *T)
    2341             : {
    2342             :   struct timespec t;
    2343             :   clock_gettime(time_type,&t);
    2344             :   T->us = t.tv_nsec / 1000;
    2345             :   T->s  = t.tv_sec;
    2346             : }
    2347             : #elif defined(USE_GETRUSAGE)
    2348             : #ifdef RUSAGE_THREAD
    2349             : static THREAD int rusage_type = RUSAGE_THREAD;
    2350             : #else
    2351             : static const THREAD int rusage_type = RUSAGE_SELF;
    2352             : #endif /*RUSAGE_THREAD*/
    2353             : static void
    2354        1328 : pari_init_timer(void)
    2355             : {
    2356             : #ifdef RUSAGE_THREAD
    2357        1328 :   rusage_type = RUSAGE_SELF;
    2358             : #endif
    2359        1328 : }
    2360             : 
    2361             : void
    2362      447001 : timer_start(pari_timer *T)
    2363             : {
    2364             :   struct rusage r;
    2365      447001 :   getrusage(rusage_type,&r);
    2366      447001 :   T->us = r.ru_utime.tv_usec;
    2367      447001 :   T->s  = r.ru_utime.tv_sec;
    2368      447001 : }
    2369             : #elif defined(USE_FTIME)
    2370             : 
    2371             : static void
    2372             : pari_init_timer(void) { }
    2373             : 
    2374             : void
    2375             : timer_start(pari_timer *T)
    2376             : {
    2377             :   struct timeb t;
    2378             :   ftime(&t);
    2379             :   T->us = ((long)t.millitm) * 1000;
    2380             :   T->s  = t.time;
    2381             : }
    2382             : 
    2383             : #else
    2384             : 
    2385             : static void
    2386             : _get_time(pari_timer *T, long Ticks, long TickPerSecond)
    2387             : {
    2388             :   T->us = (long) ((Ticks % TickPerSecond) * (1000000. / TickPerSecond));
    2389             :   T->s  = Ticks / TickPerSecond;
    2390             : }
    2391             : 
    2392             : # ifdef USE_TIMES
    2393             : static void
    2394             : pari_init_timer(void) { }
    2395             : 
    2396             : void
    2397             : timer_start(pari_timer *T)
    2398             : {
    2399             : # ifdef _SC_CLK_TCK
    2400             :   long tck = sysconf(_SC_CLK_TCK);
    2401             : # else
    2402             :   long tck = CLK_TCK;
    2403             : # endif
    2404             :   struct tms t; times(&t);
    2405             :   _get_time(T, t.tms_utime, tck);
    2406             : }
    2407             : # elif defined(_WIN32)
    2408             : static void
    2409             : pari_init_timer(void) { }
    2410             : 
    2411             : void
    2412             : timer_start(pari_timer *T)
    2413             : { _get_time(T, win32_timer(), 1000); }
    2414             : # else
    2415             : #  include <time.h>
    2416             : #  ifndef CLOCKS_PER_SEC
    2417             : #   define CLOCKS_PER_SEC 1000000 /* may be false on YOUR system */
    2418             : #  endif
    2419             : static void
    2420             : pari_init_timer(void) { }
    2421             : 
    2422             : void
    2423             : timer_start(pari_timer *T)
    2424             : { _get_time(T, clock(), CLOCKS_PER_SEC); }
    2425             : # endif
    2426             : #endif
    2427             : 
    2428             : static long
    2429       54382 : timer_aux(pari_timer *T, pari_timer *U)
    2430             : {
    2431       54382 :   long s = T->s, us = T->us; timer_start(U);
    2432       54382 :   return 1000 * (U->s - s) + (U->us - us + 500) / 1000;
    2433             : }
    2434             : /* return delay, reset timer */
    2435             : long
    2436       53052 : timer_delay(pari_timer *T) { return timer_aux(T, T); }
    2437             : /* return delay, don't reset timer */
    2438             : long
    2439        1330 : timer_get(pari_timer *T) { pari_timer t; return timer_aux(T, &t); }
    2440             : 
    2441             : static void
    2442           0 : timer_vprintf(pari_timer *T, const char *format, va_list args)
    2443             : {
    2444           0 :   out_puts(pariErr, "Time ");
    2445           0 :   out_vprintf(pariErr, format,args);
    2446           0 :   out_printf(pariErr, ": %ld\n", timer_delay(T));
    2447           0 :   pariErr->flush();
    2448           0 : }
    2449             : void
    2450           0 : timer_printf(pari_timer *T, const char *format, ...)
    2451             : {
    2452           0 :   va_list args; va_start(args, format);
    2453           0 :   timer_vprintf(T, format, args);
    2454           0 :   va_end(args);
    2455           0 : }
    2456             : 
    2457             : long
    2458           0 : timer(void)  { static THREAD pari_timer T; return timer_delay(&T);}
    2459             : long
    2460        3138 : gettime(void)  { static THREAD pari_timer T; return timer_delay(&T);}
    2461             : 
    2462             : static THREAD pari_timer timer2_T, abstimer_T;
    2463             : long
    2464           0 : timer2(void) {  return timer_delay(&timer2_T);}
    2465             : void
    2466           0 : msgtimer(const char *format, ...)
    2467             : {
    2468           0 :   va_list args; va_start(args, format);
    2469           0 :   timer_vprintf(&timer2_T, format, args);
    2470           0 :   va_end(args);
    2471           0 : }
    2472             : long
    2473        1328 : getabstime(void)  { return timer_get(&abstimer_T);}
    2474             : #if defined(USE_CLOCK_GETTIME) || defined(USE_GETTIMEOFDAY) \
    2475             :  || defined(USE_FTIMEFORWALLTIME)
    2476             : static GEN
    2477           0 : timetoi(ulong s, ulong m)
    2478             : {
    2479           0 :   pari_sp av = avma;
    2480           0 :   GEN r = addiu(muliu(utoi(s), 1000), m);
    2481           0 :   return gerepileuptoint(av, r);
    2482             : }
    2483             : #endif
    2484             : GEN
    2485           0 : getwalltime(void)
    2486             : {
    2487             : #if defined(USE_CLOCK_GETTIME)
    2488             :   struct timespec t;
    2489             :   if (!clock_gettime(CLOCK_REALTIME,&t))
    2490             :     return timetoi(t.tv_sec, (t.tv_nsec + 500000)/1000000);
    2491             : #elif defined(USE_GETTIMEOFDAY)
    2492             :   struct timeval tv;
    2493           0 :   if (!gettimeofday(&tv, NULL))
    2494           0 :     return timetoi(tv.tv_sec, (tv.tv_usec + 500)/1000);
    2495             : #elif defined(USE_FTIMEFORWALLTIME)
    2496             :   struct timeb tp;
    2497             :   ftime(&tp); return timetoi(tp.time, tp.millitm);
    2498             : #endif
    2499           0 :   return utoi(getabstime());
    2500             : }
    2501             : 
    2502             : /*******************************************************************/
    2503             : /*                                                                 */
    2504             : /*                   FUNCTIONS KNOWN TO THE ANALYZER               */
    2505             : /*                                                                 */
    2506             : /*******************************************************************/
    2507             : GEN
    2508           7 : pari_version(void)
    2509             : {
    2510           7 :   const ulong mask = (1UL<<PARI_VERSION_SHIFT) - 1;
    2511           7 :   ulong major, minor, patch, n = paricfg_version_code;
    2512           7 :   patch = n & mask; n >>= PARI_VERSION_SHIFT;
    2513           7 :   minor = n & mask; n >>= PARI_VERSION_SHIFT;
    2514           7 :   major = n;
    2515           7 :   if (*paricfg_vcsversion) {
    2516           7 :     const char *ver = paricfg_vcsversion;
    2517           7 :     const char *s = strchr(ver, '-');
    2518             :     char t[8];
    2519           7 :     const long len = s-ver;
    2520             :     GEN v;
    2521           7 :     if (!s || len > 6) pari_err_BUG("pari_version()"); /* paranoia */
    2522           7 :     memcpy(t, ver, len); t[len] = 0;
    2523           7 :     v = cgetg(6, t_VEC);
    2524           7 :     gel(v,1) = utoi(major);
    2525           7 :     gel(v,2) = utoi(minor);
    2526           7 :     gel(v,3) = utoi(patch);
    2527           7 :     gel(v,4) = stoi( atoi(t) );
    2528           7 :     gel(v,5) = strtoGENstr(s+1);
    2529           7 :     return v;
    2530             :   } else {
    2531           0 :     GEN v = cgetg(4, t_VEC);
    2532           0 :     gel(v,1) = utoi(major);
    2533           0 :     gel(v,2) = utoi(minor);
    2534           0 :     gel(v,3) = utoi(patch);
    2535           0 :     return v;
    2536             :   }
    2537             : }
    2538             : 
    2539             : /* List of GP functions: generated from the description system.
    2540             :  * Format (struct entree) :
    2541             :  *   char *name   : name (under GP).
    2542             :  *   ulong valence: (EpNEW, EpALIAS,EpVAR, EpINSTALL)|EpSTATIC
    2543             :  *   void *value  : For PREDEFINED FUNCTIONS: C function to call.
    2544             :  *                  For USER FUNCTIONS: pointer to defining data (block) =
    2545             :  *                   entree*: NULL, list of entree (arguments), NULL
    2546             :  *                   char*  : function text
    2547             :  *   long menu    : which help section do we belong to
    2548             :  *                   1: Standard monadic or dyadic OPERATORS
    2549             :  *                   2: CONVERSIONS and similar elementary functions
    2550             :  *                   3: TRANSCENDENTAL functions, etc.
    2551             :  *   char *code   : GP prototype, aka Parser Code (see libpari's manual)
    2552             :  *                  if NULL, use valence instead.
    2553             :  *   char *help   : short help text (init to NULL).
    2554             :  *   void *pvalue : push_val history.
    2555             :  *   long arity   : maximum number of arguments.
    2556             :  *   entree *next : next entree (init to NULL, used in hashing code). */
    2557             : #include "init.h"
    2558             : #include "default.h"

Generated by: LCOV version 1.11