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

Generated by: LCOV version 1.11