Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - anal.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.8.0 lcov report (development 19628-9774e23) Lines: 638 718 88.9 %
Date: 2016-10-01 05:54:29 Functions: 98 100 98.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  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             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : #include "anal.h"
      17             : #include "parse.h"
      18             : 
      19             : /***************************************************************************
      20             :  **                                                                       **
      21             :  **                           Mnemonic codes parser                       **
      22             :  **                                                                       **
      23             :  ***************************************************************************/
      24             : 
      25             : /* TEMPLATE is assumed to be ";"-separated list of items.  Each item
      26             :  * may have one of the following forms: id=value id==value id|value id&~value.
      27             :  * Each id consists of alphanum characters, dashes and underscores.
      28             :  * IDs are case-sensitive.
      29             : 
      30             :  * ARG consists of several IDs separated by punctuation (and optional
      31             :  * whitespace).  Each modifies the return value in a "natural" way: an
      32             :  * ID from id=value should be the first in the sequence and sets RETVAL to
      33             :  * VALUE (and cannot be negated), ID from id|value bit-ORs RETVAL with
      34             :  * VALUE (and bit-ANDs RETVAL with ~VALUE if negated), ID from
      35             :  * id&~value behaves as if it were noid|value, ID from
      36             :  * id==value behaves the same as id=value, but should come alone.
      37             : 
      38             :  * For items of the form id|value and id&~value negated forms are
      39             :  * allowed: either when arg looks like no[-_]id, or when id looks like
      40             :  * this, and arg is not-negated. */
      41             : 
      42             : enum { A_ACTION_ASSIGN, A_ACTION_SET, A_ACTION_UNSET };
      43             : #define IS_ID(c)        (isalnum((int)c) || ((c) == '_') || ((c) == '-'))
      44             : 
      45             : long
      46        1584 : eval_mnemonic(GEN str, const char *tmplate)
      47             : {
      48        1584 :   pari_sp av=avma;
      49        1584 :   ulong retval = 0;
      50        1584 :   const char *etmplate = NULL;
      51             :   const char *arg;
      52             : 
      53        1584 :   if (typ(str)==t_INT) return itos(str);
      54        1584 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      55             : 
      56        1584 :   arg=GSTR(str);
      57        1584 :   etmplate = strchr(tmplate, '\n');
      58        1584 :   if (!etmplate)
      59        1584 :     etmplate = tmplate + strlen(tmplate);
      60             : 
      61             :   while (1)
      62             :   {
      63             :     long numarg;
      64             :     const char *e, *id;
      65             :     const char *negated;                /* action found with 'no'-ID */
      66             :     int negate;                 /* Arg has 'no' prefix removed */
      67        3192 :     ulong l, action = 0, first = 1, singleton = 0;
      68             :     char *buf, *inibuf;
      69             :     static char b[80];
      70             : 
      71        3192 :     while (isspace((int)*arg)) arg++;
      72        3192 :     if (!*arg)
      73        1584 :       break;
      74        1608 :     e = arg;
      75        1608 :     while (IS_ID(*e)) e++;
      76             :     /* Now the ID is whatever is between arg and e. */
      77        1608 :     l = e - arg;
      78        1608 :     if (l >= sizeof(b))
      79           0 :       pari_err(e_MISC,"id too long in a stringified flag");
      80        1608 :     if (!l)                             /* Garbage after whitespace? */
      81           0 :       pari_err(e_MISC,"a stringified flag does not start with an id");
      82        1608 :     strncpy(b, arg, l);
      83        1608 :     b[l] = 0;
      84        1608 :     arg = e;
      85        1608 :     e = inibuf = buf = b;
      86        3216 :     while (('0' <= *e) && (*e <= '9'))
      87           0 :       e++;
      88        1608 :     if (*e == 0)
      89           0 :       pari_err(e_MISC,"numeric id in a stringified flag");
      90        1608 :     negate = 0;
      91        1608 :     negated = NULL;
      92             : find:
      93        1608 :     id = tmplate;
      94        3216 :     while ((id = strstr(id, buf)) && id < etmplate)
      95             :     {
      96        1608 :       if (IS_ID(id[l])) {       /* We do not allow abbreviations yet */
      97           0 :         id += l;                /* False positive */
      98           0 :         continue;
      99             :       }
     100        1608 :       if ((id >= tmplate + 2) && (IS_ID(id[-1])))
     101             :       {
     102           0 :         const char *s = id;
     103             : 
     104           0 :         if ( !negate && s >= tmplate+3
     105           0 :             && ((id[-1] == '_') || (id[-1] == '-')) )
     106           0 :           s--;
     107             :         /* Check whether we are preceeded by "no" */
     108           0 :         if ( negate             /* buf initially started with "no" */
     109           0 :             || (s < tmplate+2) || (s[-1] != 'o') || (s[-2] != 'n')
     110           0 :             || (s >= tmplate+3 && IS_ID(s[-3]))) {
     111           0 :           id += l;              /* False positive */
     112           0 :           continue;
     113             :         }
     114             :         /* Found noID in the template! */
     115           0 :         id += l;
     116           0 :         negated = id;
     117           0 :         continue;               /* Try to find without 'no'. */
     118             :       }
     119             :       /* Found as is */
     120        1608 :       id += l;
     121        1608 :       break;
     122             :     }
     123        1608 :     if ( !id && !negated && !negate
     124           0 :         && (l > 2) && buf[0] == 'n' && buf[1] == 'o' ) {
     125             :       /* Try to find the flag without the prefix "no". */
     126           0 :       buf += 2; l -= 2;
     127           0 :       if ((buf[0] == '_') || (buf[0] == '-')) { buf++; l--; }
     128           0 :       negate = 1;
     129           0 :       if (buf[0])
     130           0 :         goto find;
     131             :     }
     132        1608 :     if (!id && negated) /* Negated and AS_IS forms, prefer AS_IS */
     133             :     {
     134           0 :       id = negated;     /* Otherwise, use negated form */
     135           0 :       negate = 1;
     136             :     }
     137        1608 :     if (!id)
     138           0 :       pari_err(e_MISC,"Unrecognized id '%s' in a stringified flag", inibuf);
     139        1608 :     if (singleton && !first)
     140           0 :       pari_err(e_MISC,"Singleton id non-single in a stringified flag");
     141        1608 :     if (id[0] == '=') {
     142           0 :       if (negate)
     143           0 :         pari_err(e_MISC,"Cannot negate id=value in a stringified flag");
     144           0 :       if (!first)
     145           0 :         pari_err(e_MISC,"Assign action should be first in a stringified flag");
     146           0 :       action = A_ACTION_ASSIGN;
     147           0 :       id++;
     148           0 :       if (id[0] == '=') {
     149           0 :         singleton = 1;
     150           0 :         id++;
     151             :       }
     152        1608 :     } else if (id[0] == '^') {
     153           0 :       if (id[1] != '~')
     154           0 :         pari_err(e_MISC, "Unrecognized action in a template");
     155           0 :       id += 2;
     156           0 :       if (negate)
     157           0 :         action = A_ACTION_SET;
     158             :       else
     159           0 :         action = A_ACTION_UNSET;
     160        1608 :     } else if (id[0] == '|') {
     161        1608 :       id++;
     162        1608 :       if (negate)
     163           0 :         action = A_ACTION_UNSET;
     164             :       else
     165        1608 :         action = A_ACTION_SET;
     166             :     }
     167             : 
     168        1608 :     e = id;
     169             : 
     170        1608 :     while ((*e >= '0' && *e <= '9')) e++;
     171        3216 :     while (isspace((int)*e))
     172           0 :       e++;
     173        1608 :     if (*e && (*e != ';') && (*e != ','))
     174           0 :       pari_err(e_MISC, "Non-numeric argument of an action in a template");
     175        1608 :     numarg = atol(id);          /* Now it is safe to get it... */
     176        1608 :     switch (action) {
     177             :     case A_ACTION_SET:
     178        1608 :       retval |= numarg;
     179        1608 :       break;
     180             :     case A_ACTION_UNSET:
     181           0 :       retval &= ~numarg;
     182           0 :       break;
     183             :     case A_ACTION_ASSIGN:
     184           0 :       retval = numarg;
     185           0 :       break;
     186             :     default:
     187           0 :       pari_err(e_MISC,"error in parse_option_string");
     188             :     }
     189        1608 :     first = 0;
     190        3216 :     while (isspace((int)*arg))
     191           0 :       arg++;
     192        1608 :     if (*arg && !(ispunct((int)*arg) && *arg != '-'))
     193           0 :       pari_err(e_MISC,"Junk after an id in a stringified flag");
     194             :     /* Skip punctuation */
     195        1608 :     if (*arg)
     196          24 :       arg++;
     197        1608 :   }
     198        1584 :   avma=av;
     199        1584 :   return retval;
     200             : }
     201             : 
     202             : /********************************************************************/
     203             : /**                                                                **/
     204             : /**                   HASH TABLE MANIPULATIONS                     **/
     205             : /**                                                                **/
     206             : /********************************************************************/
     207             : /* return hashing value for identifier s */
     208             : static ulong
     209     1378316 : hashvalue(const char *s)
     210             : {
     211     1378316 :   ulong n = 0, c;
     212     1378316 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     213     1378316 :   return n;
     214             : }
     215             : 
     216             : static ulong
     217     5635638 : hashvalue_raw(const char *s, long len)
     218             : {
     219     5635638 :   long n = 0, i;
     220     5635638 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     221     5635638 :   return n;
     222             : }
     223             : 
     224             : static void
     225     1399943 : insertep(entree *ep, entree **table, ulong hash)
     226             : {
     227     1399943 :   ep->hash = hash;
     228     1399943 :   hash %= functions_tblsz;
     229     1399943 :   ep->next = table[hash];
     230     1399943 :   table[hash] = ep;
     231     1399943 : }
     232             : 
     233             : static entree *
     234       21697 : initep(const char *name, long len)
     235             : {
     236       21697 :   const long add = 4*sizeof(long);
     237       21697 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     238       21697 :   entree *ep1 = initial_value(ep);
     239       21697 :   char *u = (char *) ep1 + add;
     240       21697 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     241       21697 :   ep->valence = EpNEW;
     242       21697 :   ep->value   = NULL;
     243       21697 :   ep->menu    = 0;
     244       21697 :   ep->code    = NULL;
     245       21697 :   ep->help    = NULL;
     246       21697 :   ep->pvalue  = NULL;
     247       21697 :   ep->arity   = 0;
     248       21697 :   return ep;
     249             : }
     250             : 
     251             : /* Look for s of length len in T; if 'insert', insert if missing */
     252             : static entree *
     253     5635638 : findentry(const char *s, long len, entree **T, int insert)
     254             : {
     255     5635638 :   ulong hash = hashvalue_raw(s, len);
     256             :   entree *ep;
     257    32747855 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     258    32726179 :     if (ep->hash == hash)
     259             :     {
     260     5659359 :       const char *t = ep->name;
     261     5659359 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     262             :     }
     263             :   /* not found */
     264       21676 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     265       21676 :   return ep;
     266             : }
     267             : entree *
     268         915 : pari_is_default(const char *s)
     269         915 : { return findentry(s, strlen(s), defaults_hash, 0); }
     270             : entree *
     271      159141 : is_entry(const char *s)
     272      159141 : { return findentry(s, strlen(s), functions_hash, 0); }
     273             : entree *
     274     5475582 : fetch_entry_raw(const char *s, long len)
     275     5475582 : { return findentry(s, len, functions_hash, 1); }
     276             : entree *
     277        2812 : fetch_entry(const char *s) { return fetch_entry_raw(s, strlen(s)); }
     278             : 
     279             : /*******************************************************************/
     280             : /*                                                                 */
     281             : /*                  SYNTACTICAL ANALYZER FOR GP                    */
     282             : /*                                                                 */
     283             : /*******************************************************************/
     284             : GEN
     285        3675 : readseq(char *t)
     286             : {
     287        3675 :   pari_sp av = avma;
     288             :   GEN x;
     289        3675 :   if (gp_meta(t,0)) return gnil;
     290        3675 :   x = pari_compile_str(t);
     291        3675 :   return gerepileupto(av, closure_evalres(x));
     292             : }
     293             : 
     294             : /* filtered readseq = remove blanks and comments */
     295             : GEN
     296           0 : gp_read_str(const char *s)
     297             : {
     298           0 :   char *t = gp_filter(s);
     299           0 :   GEN x = readseq(t);
     300           0 :   pari_free(t); return x;
     301             : }
     302             : 
     303             : GEN
     304       10108 : compile_str(const char *s)
     305             : {
     306       10108 :   char *t = gp_filter(s);
     307       10108 :   GEN x = pari_compile_str(t);
     308       10101 :   pari_free(t); return x;
     309             : }
     310             : 
     311             : static long
     312     1368873 : check_proto(const char *code)
     313             : {
     314     1368873 :   long arity = 0;
     315     1368873 :   const char *s = code, *old;
     316     1368873 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     317     6593207 :   while (*s && *s != '\n') switch (*s++)
     318             :   {
     319             :     case '&':
     320             :     case 'C':
     321             :     case 'G':
     322             :     case 'I':
     323             :     case 'J':
     324             :     case 'U':
     325             :     case 'L':
     326             :     case 'M':
     327             :     case 'P':
     328             :     case 'W':
     329             :     case 'f':
     330             :     case 'n':
     331             :     case 'p':
     332             :     case 'b':
     333             :     case 'r':
     334     2459630 :       arity++;
     335     2459630 :       break;
     336             :     case 'E':
     337             :     case 's':
     338       90446 :       if (*s == '*') s++;
     339       90446 :       arity++;
     340       90446 :       break;
     341             :     case 'D':
     342      656079 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     343      302381 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     344             :       {
     345      382048 :         if (*s != 'V') arity++;
     346      382048 :         s++; break;
     347             :       }
     348      274031 :       old = s; while (*s && *s != ',') s++;
     349      274031 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     350      274031 :       break;
     351             :     case 'V':
     352             :     case '=':
     353      649306 :     case ',': break;
     354           0 :     case '\n': break; /* Before the mnemonic */
     355             : 
     356             :     case 'm':
     357             :     case 'l':
     358             :     case 'i':
     359           0 :     case 'v': pari_err(e_SYNTAX, "this code has to come first", s-1, code);
     360           0 :     default: pari_err(e_SYNTAX, "unknown parser code", s-1, code);
     361             :   }
     362     1368873 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     363     1368873 :   return arity;
     364             : }
     365             : static void
     366           7 : check_name(const char *name)
     367             : {
     368           7 :   const char *s = name;
     369           7 :   if (isalpha((int)*s))
     370           7 :     while (is_keyword_char(*++s)) /* empty */;
     371           7 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     372           7 : }
     373             : 
     374             : entree *
     375           7 : install(void *f, const char *name, const char *code)
     376             : {
     377           7 :   long arity = check_proto(code);
     378             :   entree *ep;
     379             : 
     380           7 :   check_name(name);
     381           7 :   ep = fetch_entry(name);
     382           7 :   if (ep->valence != EpNEW)
     383             :   {
     384           0 :     if (ep->valence != EpINSTALL)
     385           0 :       pari_err(e_MISC,"[install] identifier '%s' already in use", name);
     386           0 :     pari_warn(warner, "[install] updating '%s' prototype; module not reloaded", name);
     387           0 :     if (ep->code) pari_free((void*)ep->code);
     388             :   }
     389             :   else
     390             :   {
     391           7 :     ep->value = f;
     392           7 :     ep->valence = EpINSTALL;
     393             :   }
     394           7 :   ep->code = pari_strdup(code);
     395           7 :   ep->arity = arity; return ep;
     396             : }
     397             : 
     398             : static void
     399          21 : killep(entree *ep)
     400             : {
     401          21 :   GEN p = (GEN)initial_value(ep);
     402          21 :   freeep(ep);
     403          21 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     404          21 :   ep->valence = EpNEW;
     405          21 :   ep->value   = NULL;
     406          21 :   ep->pvalue  = NULL;
     407          21 : }
     408             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     409             : void
     410          21 : kill0(const char *e)
     411             : {
     412          21 :   entree *ep = is_entry(e);
     413          21 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     414          21 :   killep(ep);
     415          21 : }
     416             : 
     417             : void
     418          49 : addhelp(const char *e, char *s)
     419             : {
     420          49 :   entree *ep = fetch_entry(e);
     421          49 :   if (ep->help && !EpSTATIC(ep)) pari_free((void*)ep->help);
     422          49 :   ep->help = pari_strdup(s);
     423          49 : }
     424             : 
     425             : GEN
     426       23108 : type0(GEN x)
     427             : {
     428       23108 :   const char *s = type_name(typ(x));
     429       23108 :   return strtoGENstr(s);
     430             : }
     431             : 
     432             : /*******************************************************************/
     433             : /*                                                                 */
     434             : /*                              PARSER                             */
     435             : /*                                                                 */
     436             : /*******************************************************************/
     437             : 
     438             : #ifdef LONG_IS_64BIT
     439             : static const long MAX_DIGITS  = 19;
     440             : #else
     441             : static const long MAX_DIGITS  = 9;
     442             : #endif
     443             : 
     444             : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     445             : static const long MAX_BDIGITS = BITS_IN_LONG;
     446             : 
     447             : static int
     448    34265771 : ishex(const char **s)
     449             : {
     450    34265771 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     451             :   {
     452          49 :     *s += 2;
     453          49 :     return 1;
     454             :   }
     455             :   else
     456    34265722 :     return 0;
     457             : }
     458             : 
     459             : static int
     460    34265820 : isbin(const char **s)
     461             : {
     462    34265820 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     463             :   {
     464          49 :     *s += 2;
     465          49 :     return 1;
     466             :   }
     467             :   else
     468    34265771 :     return 0;
     469             : }
     470             : 
     471             : static ulong
     472          38 : bin_number_len(const char *s, long n)
     473             : {
     474          38 :   ulong m = 0;
     475             :   long i;
     476        1494 :   for (i = 0; i < n; i++,s++)
     477        1456 :     m = 2*m + (*s - '0');
     478          38 :   return m;
     479             : }
     480             : 
     481             : static int
     482        1484 : pari_isbdigit(int c)
     483             : {
     484        1484 :   return c=='0' || c=='1';
     485             : }
     486             : 
     487             : static ulong
     488          54 : hex_number_len(const char *s, long n)
     489             : {
     490          54 :   ulong m = 0;
     491             :   long i;
     492         593 :   for(i = 0; i < n; i++, s++)
     493             :   {
     494             :     ulong c;
     495         539 :     if( *s >= '0' && *s <= '9')
     496         455 :       c = *s - '0';
     497          84 :     else if( *s >= 'A' && *s <= 'F')
     498          84 :       c = *s - 'A' + 10;
     499             :     else
     500           0 :       c = *s - 'a' + 10;
     501         539 :     m = 16*m + c;
     502             :   }
     503          54 :   return m;
     504             : }
     505             : 
     506             : static GEN
     507          56 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     508             : {
     509          56 :   long i, l = (n+B-1)/B;
     510             :   GEN N, Np;
     511          56 :   N = cgetipos(l+2);
     512          56 :   Np = int_LSW(N);
     513          92 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     514          36 :     uel(Np, 0) = num(s+n-i*B, B);
     515          56 :   uel(Np, 0) = num(s, n-(i-1)*B);
     516          56 :   return int_normalize(N, 0);
     517             : }
     518             : 
     519             : static GEN
     520          56 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     521             : {
     522          56 :   const char *s = *ps;
     523          56 :   while (is((int)**ps)) (*ps)++;
     524          56 :   return strtobin_len(s, *ps-s, B, num);
     525             : }
     526             : 
     527             : static GEN
     528          28 : bin_read(const char **ps)
     529             : {
     530          28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     531             : }
     532             : 
     533             : static GEN
     534          28 : hex_read(const char **ps)
     535             : {
     536          28 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     537             : }
     538             : 
     539             : static ulong
     540     2812547 : dec_number_len(const char *s, long B)
     541             : {
     542     2812547 :   ulong m = 0;
     543             :   long n;
     544    42634841 :   for (n = 0; n < B; n++,s++)
     545    39822294 :     m = 10*m + (*s - '0');
     546     2812547 :   return m;
     547             : }
     548             : 
     549             : static GEN
     550      751989 : dec_strtoi_len(const char *s, long n)
     551             : {
     552      751989 :   const long B = MAX_DIGITS;
     553      751989 :   long i, l = (n+B-1)/B;
     554      751989 :   GEN V = cgetg(l+1, t_VECSMALL);
     555     2812547 :   for (i=1; i<l; i++)
     556     2060558 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     557      751989 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     558      751989 :   return fromdigitsu(V, powuu(10, B));
     559             : }
     560             : 
     561             : static GEN
     562      751989 : dec_read_more(const char **ps)
     563             : {
     564      751989 :   pari_sp av = avma;
     565      751989 :   const char *s = *ps;
     566      751989 :   while (isdigit((int)**ps)) (*ps)++;
     567      751989 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     568             : }
     569             : 
     570             : static ulong
     571     7691472 : number(int *n, const char **s)
     572             : {
     573     7691472 :   ulong m = 0;
     574    36770210 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     575    29078738 :     m = 10*m + (**s - '0');
     576     7691472 :   return m;
     577             : }
     578             : 
     579             : static GEN
     580     7616173 : dec_read(const char **s)
     581             : {
     582             :   int nb;
     583     7616173 :   ulong y  = number(&nb, s);
     584     7616173 :   if (nb < MAX_DIGITS)
     585     6864184 :     return utoi(y);
     586      751989 :   *s -= MAX_DIGITS;
     587      751989 :   return dec_read_more(s);
     588             : }
     589             : 
     590             : static GEN
     591        2052 : real_read_more(GEN y, const char **ps)
     592             : {
     593        2052 :   pari_sp av = avma;
     594        2052 :   const char *s = *ps;
     595        2052 :   GEN z = dec_read(ps);
     596        2052 :   long e = *ps-s;
     597        2052 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     598             : }
     599             : 
     600             : static long
     601       75299 : exponent(const char **pts)
     602             : {
     603       75299 :   const char *s = *pts;
     604             :   long n;
     605             :   int nb;
     606       75299 :   switch(*++s)
     607             :   {
     608       75208 :     case '-': s++; n = -(long)number(&nb, &s); break;
     609           0 :     case '+': s++; /* Fall through */
     610          91 :     default: n = (long)number(&nb, &s);
     611             :   }
     612       75299 :   *pts = s; return n;
     613             : }
     614             : 
     615             : static GEN
     616         168 : real_0_digits(long n) {
     617         168 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     618         168 :   return real_0_bit(b);
     619             : }
     620             : 
     621             : static GEN
     622       82599 : real_read(pari_sp av, const char **s, GEN y, long prec)
     623             : {
     624       82599 :   long l, n = 0;
     625       82599 :   switch(**s)
     626             :   {
     627           0 :     default: return y; /* integer */
     628             :     case '.':
     629             :     {
     630        8511 :       const char *old = ++*s;
     631        8511 :       if (isalpha((int)**s) || **s=='.')
     632             :       {
     633        1204 :         if (**s == 'E' || **s == 'e') {
     634        1204 :           n = exponent(s);
     635        1204 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     636        1183 :           break;
     637             :         }
     638           0 :         --*s; return y; /* member */
     639             :       }
     640        7307 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     641        7307 :       n = old - *s;
     642        7307 :       if (**s != 'E' && **s != 'e')
     643             :       {
     644        7300 :         if (!signe(y)) { avma = av; return real_0(prec); }
     645        6376 :         break;
     646             :       }
     647             :     }
     648             :     /* Fall through */
     649             :     case 'E': case 'e':
     650       74095 :       n += exponent(s);
     651       74095 :       if (!signe(y)) { avma = av; return real_0_digits(n); }
     652             :   }
     653       81507 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     654       81507 :   if (l < prec) l = prec; else prec = l;
     655       81507 :   if (!n) return itor(y, prec);
     656       76469 :   incrprec(l);
     657       76469 :   y = itor(y, l);
     658       76469 :   if (n > 0)
     659          14 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     660             :   else
     661       76455 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     662       76469 :   return gerepileuptoleaf(av, rtor(y, prec));
     663             : }
     664             : 
     665             : static GEN
     666     7531578 : int_read(const char **s)
     667             : {
     668             :   GEN y;
     669     7531578 :   if (isbin(s))
     670          28 :     y = bin_read(s);
     671     7531550 :   else if (ishex(s))
     672          28 :     y = hex_read(s);
     673             :   else
     674     7531522 :     y = dec_read(s);
     675     7531578 :   return y;
     676             : }
     677             : 
     678             : GEN
     679     7531578 : strtoi(const char *s) { return int_read(&s); }
     680             : 
     681             : GEN
     682       82599 : strtor(const char *s, long prec)
     683             : {
     684       82599 :   pari_sp av = avma;
     685       82599 :   GEN y = dec_read(&s);
     686       82599 :   y = real_read(av, &s, y, prec);
     687       82599 :   if (typ(y) == t_REAL) return y;
     688           0 :   return gerepileuptoleaf(av, itor(y, prec));
     689             : }
     690             : 
     691             : static void
     692     7416763 : skipdigits(char **lex) {
     693     7416763 :   while (isdigit((int)**lex)) ++*lex;
     694     7416763 : }
     695             : 
     696             : static int
     697     7413924 : skipexponent(char **lex)
     698             : {
     699     7413924 :   char *old=*lex;
     700     7413924 :   if ((**lex=='e' || **lex=='E'))
     701             :   {
     702         805 :     ++*lex;
     703         805 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     704         805 :     if (!isdigit((int)**lex))
     705             :     {
     706         413 :       *lex=old;
     707         413 :       return KINTEGER;
     708             :     }
     709         392 :     skipdigits(lex);
     710         392 :     return KREAL;
     711             :   }
     712     7413119 :   return KINTEGER;
     713             : }
     714             : 
     715             : static int
     716     7414536 : skipconstante(char **lex)
     717             : {
     718     7414536 :   skipdigits(lex);
     719     7414536 :   if (**lex=='.')
     720             :   {
     721       12674 :     char *old = ++*lex;
     722       12674 :     if (**lex == '.') { --*lex; return KINTEGER; }
     723       12062 :     if (isalpha((int)**lex))
     724             :     {
     725       10227 :       skipexponent(lex);
     726       10227 :       if (*lex == old)
     727             :       {
     728       10199 :         --*lex; /* member */
     729       10199 :         return KINTEGER;
     730             :       }
     731          28 :       return KREAL;
     732             :     }
     733        1835 :     skipdigits(lex);
     734        1835 :     skipexponent(lex);
     735        1835 :     return KREAL;
     736             :   }
     737     7401862 :   return skipexponent(lex);
     738             : }
     739             : 
     740             : static void
     741     1107895 : skipstring(char **lex)
     742             : {
     743     9013258 :   while (**lex)
     744             :   {
     745     7905363 :     while (**lex == '\\') *lex+=2;
     746     7905363 :     if (**lex == '"')
     747             :     {
     748     1107895 :       if ((*lex)[1] != '"') break;
     749           0 :       *lex += 2; continue;
     750             :     }
     751     6797468 :     (*lex)++;
     752             :   }
     753     1107895 : }
     754             : 
     755             : int
     756    28251677 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     757             : {
     758             :   (void) yylval;
     759    28251677 :   yylloc->start=*lex;
     760    28251677 :   if (!**lex)
     761             :   {
     762       81355 :     yylloc->end=*lex;
     763       81355 :     return 0;
     764             :   }
     765    28170322 :   if (isalpha((int)**lex))
     766             :   {
     767      317346 :     while (is_keyword_char(**lex)) ++*lex;
     768      317346 :     yylloc->end=*lex;
     769      317346 :     return KENTRY;
     770             :   }
     771    27852976 :   if (**lex=='"')
     772             :   {
     773     1107895 :     ++*lex;
     774     1107895 :     skipstring(lex);
     775     1107895 :     if (!**lex)
     776           0 :       compile_err("run-away string",*lex-1);
     777     1107895 :     ++*lex;
     778     1107895 :     yylloc->end=*lex;
     779     1107895 :     return KSTRING;
     780             :   }
     781    26745081 :   if (**lex == '.')
     782             :   {
     783             :     int token;
     784       10839 :     if ((*lex)[1]== '.')
     785             :     {
     786         633 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     787             :     }
     788       10206 :     token=skipconstante(lex);
     789       10206 :     if (token==KREAL)
     790             :     {
     791           7 :       yylloc->end = *lex;
     792           7 :       return token;
     793             :     }
     794       10199 :     ++*lex;
     795       10199 :     yylloc->end=*lex;
     796       10199 :     return '.';
     797             :   }
     798    26734242 :   if (isbin((const char**)lex))
     799             :   {
     800          21 :     while (**lex=='0' || **lex=='1') ++*lex;
     801          21 :     return KINTEGER;
     802             :   }
     803    26734221 :   if (ishex((const char**)lex))
     804             :   {
     805          21 :     while (isxdigit((int)**lex)) ++*lex;
     806          21 :     return KINTEGER;
     807             :   }
     808    26734200 :   if (isdigit((int)**lex))
     809             :   {
     810     7404330 :     int token=skipconstante(lex);
     811     7404330 :     yylloc->end = *lex;
     812     7404330 :     return token;
     813             :   }
     814    19329870 :   if ((*lex)[1]=='=')
     815       16517 :     switch (**lex)
     816             :     {
     817             :     case '=':
     818        6579 :       if ((*lex)[2]=='=')
     819         329 :       { *lex+=3; yylloc->end = *lex; return KID; }
     820             :       else
     821        6250 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     822             :     case '>':
     823          58 :       *lex+=2; yylloc->end = *lex; return KGE;
     824             :     case '<':
     825         163 :       *lex+=2; yylloc->end = *lex; return KLE;
     826             :     case '*':
     827         156 :       *lex+=2; yylloc->end = *lex; return KME;
     828             :     case '/':
     829          14 :       *lex+=2; yylloc->end = *lex; return KDE;
     830             :     case '%':
     831           7 :       if ((*lex)[2]=='=') break;
     832           7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     833             :     case '!':
     834        1001 :       if ((*lex)[2]=='=') break;
     835        1001 :       *lex+=2; yylloc->end = *lex; return KNE;
     836             :     case '\\':
     837           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     838             :     case '+':
     839         103 :       *lex+=2; yylloc->end = *lex; return KPE;
     840             :     case '-':
     841          35 :       *lex+=2; yylloc->end = *lex; return KSE;
     842             :     }
     843    19321747 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     844             :   {
     845        3859 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     846             :   }
     847    19317888 :   if (**lex=='-' && (*lex)[1]=='>')
     848             :   {
     849         711 :     *lex+=2; yylloc->end = *lex; return KARROW;
     850             :   }
     851    19317177 :   if (**lex=='<' && (*lex)[1]=='>')
     852             :   {
     853           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     854             :   }
     855    19317177 :   if (**lex=='\\' && (*lex)[1]=='/')
     856          35 :     switch((*lex)[2])
     857             :     {
     858             :     case '=':
     859           7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     860             :     default:
     861          28 :       *lex+=2; yylloc->end = *lex; return KDR;
     862             :     }
     863    19317142 :   if ((*lex)[1]==**lex)
     864     2108547 :     switch (**lex)
     865             :     {
     866             :     case '&':
     867         609 :       *lex+=2; yylloc->end = *lex; return KAND;
     868             :     case '|':
     869         259 :       *lex+=2; yylloc->end = *lex; return KOR;
     870             :     case '+':
     871          70 :       *lex+=2; yylloc->end = *lex; return KPP;
     872             :     case '-':
     873          14 :       *lex+=2; yylloc->end = *lex; return KSS;
     874             :     case '>':
     875          28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     876          21 :       *lex+=2; yylloc->end = *lex; return KSR;
     877             :     case '<':
     878         112 :       if ((*lex)[2]=='=')
     879           7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     880         105 :       *lex+=2; yylloc->end = *lex; return KSL;
     881             :     }
     882    19316050 :   yylloc->end = *lex+1;
     883    19316050 :   return (unsigned char) *(*lex)++;
     884             : }
     885             : 
     886             : /********************************************************************/
     887             : /**                                                                **/
     888             : /**                            STRINGS                             **/
     889             : /**                                                                **/
     890             : /********************************************************************/
     891             : 
     892             : /* return the first n0 chars of s as a GEN [s may not be 0-terminated] */
     893             : GEN
     894      296617 : strntoGENstr(const char *s, long n0)
     895             : {
     896      296617 :   long n = nchar2nlong(n0+1);
     897      296617 :   GEN x = cgetg(n+1, t_STR);
     898      296617 :   char *t = GSTR(x);
     899      296617 :   strncpy(t, s, n0); t[n0] = 0; return x;
     900             : }
     901             : 
     902             : GEN
     903      198564 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     904             : 
     905             : GEN
     906          56 : chartoGENstr(char c)
     907             : {
     908          56 :   GEN x = cgetg(2, t_STR);
     909          56 :   char *t = GSTR(x);
     910          56 :   t[0] = c; t[1] = 0; return x;
     911             : }
     912             : 
     913             : /********************************************************************/
     914             : /*                                                                  */
     915             : /*                Formal variables management                       */
     916             : /*                                                                  */
     917             : /********************************************************************/
     918             : static THREAD long max_priority, min_priority;
     919             : static THREAD long max_avail; /* max variable not yet used */
     920             : static long nvar; /* first GP free variable */
     921             : static hashtable *h_polvar;
     922             : static struct pari_varstate global_varstate;
     923             : static long *global_varpriority;
     924             : 
     925             : void
     926       94564 : varstate_save(struct pari_varstate *s)
     927             : {
     928       94564 :   s->nvar = nvar;
     929       94564 :   s->max_avail = max_avail;
     930       94564 :   s->max_priority = max_priority;
     931       94564 :   s->min_priority = min_priority;
     932       94564 : }
     933             : 
     934             : static void
     935        7457 : varentries_set(long v, entree *ep)
     936             : {
     937        7457 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     938        7457 :   varentries[v] = ep;
     939        7457 : }
     940             : static int
     941        3035 : _given_value(void *E, hashentry *e) { return e->val == E; }
     942             : 
     943             : static void
     944       19050 : varentries_unset(long v)
     945             : {
     946       19050 :   entree *ep = varentries[v];
     947       19050 :   if (ep)
     948             :   {
     949        3035 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     950             :         _given_value);
     951        3035 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     952        3035 :     varentries[v] = NULL;
     953        3035 :     pari_free(e);
     954        3035 :     if (v <= nvar && ep == is_entry(ep->name))
     955        2818 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     956        2818 :       GEN p = (GEN)initial_value(ep);
     957        2818 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     958        2818 :       *p = 0;
     959             :     }
     960             :     else /* from name_var() or a direct pari_var_create() */
     961         217 :       pari_free(ep);
     962             :  }
     963       19050 : }
     964             : static void
     965         294 : varentries_reset(long v, entree *ep)
     966             : {
     967         294 :   varentries_unset(v);
     968         294 :   varentries_set(v, ep);
     969         294 : }
     970             : 
     971             : static void
     972      217846 : var_restore(struct pari_varstate *s)
     973             : {
     974      217846 :   nvar = s->nvar;
     975      217846 :   max_avail = s->max_avail;
     976      217846 :   max_priority = s->max_priority;
     977      217846 :   min_priority = s->min_priority;
     978      217846 : }
     979             : 
     980             : void
     981       15896 : varstate_restore(struct pari_varstate *s)
     982             : {
     983             :   long i;
     984       34617 :   for (i = nvar; i >= s->nvar; i--)
     985             :   {
     986       18721 :     varentries_unset(i);
     987       18721 :     varpriority[i] = -i;
     988             :   }
     989       15931 :   for (i = max_avail; i < s->max_avail; i++)
     990             :   {
     991          35 :     varentries_unset(i);
     992          35 :     varpriority[i] = -i;
     993             :   }
     994       15896 :   var_restore(s);
     995       15896 : }
     996             : 
     997             : void
     998      201959 : pari_thread_init_varstate(void)
     999             : {
    1000             :   long i;
    1001      201959 :   var_restore(&global_varstate);
    1002      201334 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
    1003      204028 :   varpriority[-1] = 1-LONG_MAX;
    1004      204028 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
    1005      204028 : }
    1006             : 
    1007             : void
    1008       12757 : pari_pthread_init_varstate(void)
    1009             : {
    1010       12757 :   varstate_save(&global_varstate);
    1011       12757 :   global_varpriority = varpriority;
    1012       12757 : }
    1013             : 
    1014             : void
    1015        1857 : pari_var_close(void)
    1016             : {
    1017        1857 :   free((void*)varentries);
    1018        1857 :   free((void*)(varpriority-1));
    1019        1857 :   hash_destroy(h_polvar);
    1020        1857 : }
    1021             : 
    1022             : void
    1023        1350 : pari_var_init(void)
    1024             : {
    1025             :   long i;
    1026        1350 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
    1027        1350 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
    1028        1350 :   varpriority[-1] = 1-LONG_MAX;
    1029        1350 :   h_polvar = hash_create_str(100, 0);
    1030        1350 :   nvar = 0; max_avail = MAXVARN;
    1031        1350 :   max_priority = min_priority = 0;
    1032        1350 :   (void)fetch_user_var("x");
    1033        1350 :   (void)fetch_user_var("y");
    1034             :   /* initialize so that people can use pol_x(i) directly */
    1035        1350 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
    1036             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
    1037        1350 :   nvar = 10;
    1038        1350 :   min_priority = -MAXVARN;
    1039        1350 : }
    1040         224 : long pari_var_next(void) { return nvar; }
    1041         126 : long pari_var_next_temp(void) { return max_avail; }
    1042             : long
    1043       18965 : pari_var_create(entree *ep)
    1044             : {
    1045       18965 :   GEN p = (GEN)initial_value(ep);
    1046             :   long v;
    1047       18965 :   if (*p) return varn(p);
    1048        7163 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1049        7163 :   v = nvar++;
    1050             :   /* set p = pol_x(v) */
    1051        7163 :   p[0] = evaltyp(t_POL) | _evallg(4);
    1052        7163 :   p[1] = evalsigne(1) | evalvarn(v);
    1053        7163 :   gel(p,2) = gen_0;
    1054        7163 :   gel(p,3) = gen_1;
    1055        7163 :   varentries_set(v, ep);
    1056        7163 :   varpriority[v]= min_priority--;
    1057        7163 :   return v;
    1058             : }
    1059             : 
    1060             : long
    1061      107002 : delete_var(void)
    1062             : { /* user wants to delete one of his/her/its variables */
    1063      107002 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
    1064      107002 :   max_avail++;
    1065      107002 :   if      (varpriority[max_avail] == min_priority) min_priority++;
    1066      107002 :   else if (varpriority[max_avail] == max_priority) max_priority--;
    1067      107002 :   return max_avail+1;
    1068             : }
    1069             : long
    1070       39349 : fetch_var(void)
    1071             : {
    1072       39349 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1073       39349 :   varpriority[max_avail] = min_priority--;
    1074       39349 :   return max_avail--;
    1075             : }
    1076             : long
    1077       67755 : fetch_var_higher(void)
    1078             : {
    1079       67755 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1080       67758 :   varpriority[max_avail] = ++max_priority;
    1081       67758 :   return max_avail--;
    1082             : }
    1083             : 
    1084             : static int
    1085          49 : _higher(void *E, hashentry *e)
    1086          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1087             : static int
    1088          42 : _lower(void *E, hashentry *e)
    1089          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1090             : 
    1091             : static GEN
    1092          70 : var_register(long v, const char *s)
    1093             : {
    1094          70 :   varentries_reset(v, initep(s, strlen(s)));
    1095          70 :   return pol_x(v);
    1096             : }
    1097             : GEN
    1098          63 : varhigher(const char *s, long w)
    1099             : {
    1100             :   long v;
    1101          63 :   if (w >= 0)
    1102             :   {
    1103          42 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1104          42 :     if (e) return pol_x((long)e->val);
    1105             :   }
    1106             :   /* no luck: need to create */
    1107          49 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1108          49 :   v = nvar++;
    1109          49 :   varpriority[v]= ++max_priority;
    1110          49 :   return var_register(v, s);
    1111             : }
    1112             : GEN
    1113          28 : varlower(const char *s, long w)
    1114             : {
    1115             :   long v;
    1116          28 :   if (w >= 0)
    1117             :   {
    1118          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1119          21 :     if (e) return pol_x((long)e->val);
    1120             :   }
    1121             :   /* no luck: need to create */
    1122          21 :   v = fetch_var();
    1123          21 :   return var_register(v, s);
    1124             : }
    1125             : 
    1126             : long
    1127        2700 : fetch_user_var(const char *s)
    1128             : {
    1129        2700 :   entree *ep = fetch_entry(s);
    1130             :   long v;
    1131        2700 :   switch (EpVALENCE(ep))
    1132             :   {
    1133           0 :     case EpVAR: return varn((GEN)initial_value(ep));
    1134        2700 :     case EpNEW: break;
    1135           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1136             :   }
    1137        2700 :   v = pari_var_create(ep);
    1138        2700 :   ep->valence = EpVAR;
    1139        2700 :   ep->value = initial_value(ep);
    1140        2700 :   return v;
    1141             : }
    1142             : 
    1143             : GEN
    1144           7 : fetch_var_value(long v, GEN t)
    1145             : {
    1146           7 :   entree *ep = varentries[v];
    1147           7 :   if (!ep) return NULL;
    1148           7 :   if (t)
    1149             :   {
    1150           7 :     long vn = localvars_find(t,ep);
    1151           7 :     if (vn) return get_lex(vn);
    1152             :   }
    1153           7 :   return (GEN)ep->value;
    1154             : }
    1155             : 
    1156             : void
    1157         224 : name_var(long n, const char *s)
    1158             : {
    1159             :   entree *ep;
    1160             :   char *u;
    1161             : 
    1162         224 :   if (n < pari_var_next())
    1163           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1164         224 :   if (n > (long)MAXVARN)
    1165           0 :     pari_err_OVERFLOW("variable number");
    1166             : 
    1167         224 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1168         224 :   u = (char *)initial_value(ep);
    1169         224 :   ep->valence = EpVAR;
    1170         224 :   ep->name = u; strcpy(u,s);
    1171         224 :   ep->value = gen_0; /* in case geval is called */
    1172         224 :   varentries_reset(n, ep);
    1173         224 : }
    1174             : 
    1175             : static int
    1176        5059 : cmp_by_var(void *E,GEN x, GEN y)
    1177        5059 : { (void)E; return varncmp((long)x,(long)y); }
    1178             : GEN
    1179         147 : vars_sort_inplace(GEN z)
    1180         147 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1181             : GEN
    1182         147 : vars_to_RgXV(GEN h)
    1183             : {
    1184         147 :   long i, l = lg(h);
    1185         147 :   GEN z = cgetg(l, t_VEC);
    1186         147 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1187         147 :   return z;
    1188             : }
    1189             : GEN
    1190         728 : gpolvar(GEN x)
    1191             : {
    1192             :   long v;
    1193         728 :   if (!x) {
    1194         140 :     GEN h = hash_values(h_polvar);
    1195         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1196             :   }
    1197         588 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1198         581 :   v = gvar(x);
    1199         581 :   if (v==NO_VARIABLE) return gen_0;
    1200         518 :   return pol_x(v);
    1201             : }
    1202             : 
    1203             : static void
    1204     1378316 : fill_hashtable_single(entree **table, entree *ep)
    1205             : {
    1206     1378316 :   EpSETSTATIC(ep);
    1207     1378316 :   insertep(ep, table,  hashvalue(ep->name));
    1208     1378316 :   if (ep->code) ep->arity = check_proto(ep->code);
    1209     1378316 :   ep->pvalue = NULL;
    1210     1378316 : }
    1211             : 
    1212             : void
    1213        5398 : pari_fill_hashtable(entree **table, entree *ep)
    1214             : {
    1215        5398 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1216        5398 : }
    1217             : 
    1218             : void
    1219           0 : pari_add_function(entree *ep)
    1220             : {
    1221           0 :   fill_hashtable_single(functions_hash, ep);
    1222           0 : }
    1223             : 
    1224             : /********************************************************************/
    1225             : /**                                                                **/
    1226             : /**                        SIMPLE GP FUNCTIONS                     **/
    1227             : /**                                                                **/
    1228             : /********************************************************************/
    1229             : 
    1230             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1231             : 
    1232             : entree *
    1233     5625338 : do_alias(entree *ep)
    1234             : {
    1235     5625338 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1236     5625338 :   return ep;
    1237             : }
    1238             : 
    1239             : void
    1240          28 : alias0(const char *s, const char *old)
    1241             : {
    1242             :   entree *ep, *e;
    1243             :   GEN x;
    1244             : 
    1245          28 :   ep = fetch_entry(old);
    1246          28 :   e  = fetch_entry(s);
    1247          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1248           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1249          28 :   freeep(e);
    1250          28 :   x = newblock(2); x[0] = evaltyp(t_STR)|_evallg(2); /* for getheap */
    1251          28 :   gel(x,1) = (GEN)ep;
    1252          28 :   e->value=x; e->valence=EpALIAS;
    1253          28 : }
    1254             : 
    1255             : GEN
    1256    12903680 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1257             : {
    1258    12903680 :   if (gequal0(g)) /* false */
    1259     9922511 :     return b? closure_evalgen(b): gnil;
    1260             :   else /* true */
    1261     2981169 :     return a? closure_evalgen(a): gnil;
    1262             : }
    1263             : 
    1264             : void
    1265    16792372 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1266             : {
    1267    16792372 :   if (gequal0(g)) /* false */
    1268    16280401 :   { if (b) closure_evalvoid(b); }
    1269             :   else /* true */
    1270      511971 :   { if (a) closure_evalvoid(a); }
    1271    16792351 : }
    1272             : 
    1273             : GEN
    1274       74452 : ifpari_multi(GEN g, GEN a/*closure*/)
    1275             : {
    1276       74452 :   long i, nb = lg(a)-1;
    1277       74452 :   if (!gequal0(g)) /* false */
    1278       19397 :     return closure_evalgen(gel(a,1));
    1279      117670 :   for(i=2;i<nb;i+=2)
    1280             :   {
    1281      109837 :     GEN g = closure_evalgen(gel(a,i));
    1282      109837 :     if (!g) return g;
    1283      109830 :     if (!gequal0(g))
    1284       47215 :       return closure_evalgen(gel(a,i+1));
    1285             :   }
    1286        7833 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1287             : }
    1288             : 
    1289             : GEN
    1290      175651 : andpari(GEN a, GEN b/*closure*/)
    1291             : {
    1292             :   GEN g;
    1293      175651 :   if (gequal0(a))
    1294       12635 :     return gen_0;
    1295      163016 :   g=closure_evalgen(b);
    1296      163016 :   if (!g) return g;
    1297      163016 :   return gequal0(g)?gen_0:gen_1;
    1298             : }
    1299             : 
    1300             : GEN
    1301     2480940 : orpari(GEN a, GEN b/*closure*/)
    1302             : {
    1303             :   GEN g;
    1304     2480940 :   if (!gequal0(a))
    1305      144998 :     return gen_1;
    1306     2335942 :   g=closure_evalgen(b);
    1307     2335942 :   if (!g) return g;
    1308     2335942 :   return gequal0(g)?gen_0:gen_1;
    1309             : }
    1310             : 
    1311       91134 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1312          35 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1313           7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1314           7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1315           7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1316           7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1317           7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1318     2373417 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1319     3163195 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addis(*x,1):gaddgs(*x,1); return *x; }
    1320    15171541 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1321          14 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subis(*x,1):gsubgs(*x,1); return *x; }
    1322             : 
    1323        1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.11