Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - init.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.8.0 lcov report (development 19070-36a960b) Lines: 799 1171 68.2 %
Date: 2016-06-30 Functions: 94 132 71.2 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 393 792 49.6 %

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

Generated by: LCOV version 1.9