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 to exceed 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.12.1 lcov report (development 24215-a79de5b25) Lines: 879 1247 70.5 %
Date: 2019-08-24 05:50:50 Functions: 112 147 76.2 %
Legend: Lines: hit not hit

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

Generated by: LCOV version 1.13