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.10.0 lcov report (development 21348-d75f58f) Lines: 640 719 89.0 %
Date: 2017-11-20 06:21:05 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          28 : eval_mnemonic(GEN str, const char *tmplate)
      47             : {
      48          28 :   pari_sp av=avma;
      49          28 :   ulong retval = 0;
      50          28 :   const char *etmplate = NULL;
      51             :   const char *arg;
      52             : 
      53          28 :   if (typ(str)==t_INT) return itos(str);
      54          28 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      55             : 
      56          28 :   arg=GSTR(str);
      57          28 :   etmplate = strchr(tmplate, '\n');
      58          28 :   if (!etmplate)
      59          28 :     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          64 :     ulong l, action = 0, first = 1, singleton = 0;
      68             :     char *buf, *inibuf;
      69             :     static char b[80];
      70             : 
      71          64 :     while (isspace((int)*arg)) arg++;
      72          64 :     if (!*arg)
      73          28 :       break;
      74          36 :     e = arg;
      75          36 :     while (IS_ID(*e)) e++;
      76             :     /* Now the ID is whatever is between arg and e. */
      77          36 :     l = e - arg;
      78          36 :     if (l >= sizeof(b))
      79           0 :       pari_err(e_MISC,"id too long in a stringified flag");
      80          36 :     if (!l)                             /* Garbage after whitespace? */
      81           0 :       pari_err(e_MISC,"a stringified flag does not start with an id");
      82          36 :     strncpy(b, arg, l);
      83          36 :     b[l] = 0;
      84          36 :     arg = e;
      85          36 :     e = inibuf = buf = b;
      86          72 :     while (('0' <= *e) && (*e <= '9'))
      87           0 :       e++;
      88          36 :     if (*e == 0)
      89           0 :       pari_err(e_MISC,"numeric id in a stringified flag");
      90          36 :     negate = 0;
      91          36 :     negated = NULL;
      92             : find:
      93          36 :     id = tmplate;
      94          72 :     while ((id = strstr(id, buf)) && id < etmplate)
      95             :     {
      96          36 :       if (IS_ID(id[l])) {       /* We do not allow abbreviations yet */
      97           0 :         id += l;                /* False positive */
      98           0 :         continue;
      99             :       }
     100          36 :       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          36 :       id += l;
     121          36 :       break;
     122             :     }
     123          36 :     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          36 :     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          36 :     if (!id)
     138           0 :       pari_err(e_MISC,"Unrecognized id '%s' in a stringified flag", inibuf);
     139          36 :     if (singleton && !first)
     140           0 :       pari_err(e_MISC,"Singleton id non-single in a stringified flag");
     141          36 :     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          36 :     } 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          36 :     } else if (id[0] == '|') {
     161          36 :       id++;
     162          36 :       if (negate)
     163           0 :         action = A_ACTION_UNSET;
     164             :       else
     165          36 :         action = A_ACTION_SET;
     166             :     }
     167             : 
     168          36 :     e = id;
     169             : 
     170          36 :     while ((*e >= '0' && *e <= '9')) e++;
     171          72 :     while (isspace((int)*e))
     172           0 :       e++;
     173          36 :     if (*e && (*e != ';') && (*e != ','))
     174           0 :       pari_err(e_MISC, "Non-numeric argument of an action in a template");
     175          36 :     numarg = atol(id);          /* Now it is safe to get it... */
     176          36 :     switch (action) {
     177             :     case A_ACTION_SET:
     178          36 :       retval |= numarg;
     179          36 :       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          36 :     first = 0;
     190          72 :     while (isspace((int)*arg))
     191           0 :       arg++;
     192          36 :     if (*arg && !(ispunct((int)*arg) && *arg != '-'))
     193           0 :       pari_err(e_MISC,"Junk after an id in a stringified flag");
     194             :     /* Skip punctuation */
     195          36 :     if (*arg)
     196           8 :       arg++;
     197          36 :   }
     198          28 :   avma=av;
     199          28 :   return retval;
     200             : }
     201             : 
     202             : /********************************************************************/
     203             : /**                                                                **/
     204             : /**                   HASH TABLE MANIPULATIONS                     **/
     205             : /**                                                                **/
     206             : /********************************************************************/
     207             : /* return hashing value for identifier s */
     208             : static ulong
     209     1796372 : hashvalue(const char *s)
     210             : {
     211     1796372 :   ulong n = 0, c;
     212     1796372 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     213     1796372 :   return n;
     214             : }
     215             : 
     216             : static ulong
     217     6252875 : hashvalue_raw(const char *s, long len)
     218             : {
     219     6252875 :   long n = 0, i;
     220     6252875 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     221     6252875 :   return n;
     222             : }
     223             : 
     224             : static void
     225     1821917 : insertep(entree *ep, entree **table, ulong hash)
     226             : {
     227     1821917 :   ep->hash = hash;
     228     1821917 :   hash %= functions_tblsz;
     229     1821917 :   ep->next = table[hash];
     230     1821917 :   table[hash] = ep;
     231     1821917 : }
     232             : 
     233             : static entree *
     234       25629 : initep(const char *name, long len)
     235             : {
     236       25629 :   const long add = 4*sizeof(long);
     237       25629 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     238       25629 :   entree *ep1 = initial_value(ep);
     239       25629 :   char *u = (char *) ep1 + add;
     240       25629 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     241       25629 :   ep->valence = EpNEW;
     242       25629 :   ep->value   = NULL;
     243       25629 :   ep->menu    = 0;
     244       25629 :   ep->code    = NULL;
     245       25629 :   ep->help    = NULL;
     246       25629 :   ep->pvalue  = NULL;
     247       25629 :   ep->arity   = 0;
     248       25629 :   return ep;
     249             : }
     250             : 
     251             : /* Look for s of length len in T; if 'insert', insert if missing */
     252             : static entree *
     253     6252875 : findentry(const char *s, long len, entree **T, int insert)
     254             : {
     255     6252875 :   ulong hash = hashvalue_raw(s, len);
     256             :   entree *ep;
     257    35202139 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     258    35176544 :     if (ep->hash == hash)
     259             :     {
     260     6272195 :       const char *t = ep->name;
     261     6272195 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     262             :     }
     263             :   /* not found */
     264       25595 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     265       25595 :   return ep;
     266             : }
     267             : entree *
     268        1163 : pari_is_default(const char *s)
     269        1163 : { return findentry(s, strlen(s), defaults_hash, 0); }
     270             : entree *
     271      265225 : is_entry(const char *s)
     272      265225 : { return findentry(s, strlen(s), functions_hash, 0); }
     273             : entree *
     274     5986487 : fetch_entry_raw(const char *s, long len)
     275     5986487 : { return findentry(s, len, functions_hash, 1); }
     276             : entree *
     277      385783 : 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        4394 : readseq(char *t)
     286             : {
     287        4394 :   pari_sp av = avma;
     288             :   GEN x;
     289        4394 :   if (gp_meta(t,0)) return gnil;
     290        4394 :   x = pari_compile_str(t);
     291        4394 :   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     1779462 : check_proto(const char *code)
     313             : {
     314     1779462 :   long arity = 0;
     315     1779462 :   const char *s = code, *old;
     316     1779462 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     317     8662010 :   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     3288252 :       arity++;
     335     3288252 :       break;
     336             :     case 'E':
     337             :     case 's':
     338      107660 :       if (*s == '*') s++;
     339      107660 :       arity++;
     340      107660 :       break;
     341             :     case 'D':
     342      855126 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     343      393726 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     344             :       {
     345      493698 :         if (*s != 'V') arity++;
     346      493698 :         s++; break;
     347             :       }
     348      361428 :       old = s; while (*s && *s != ',') s++;
     349      361428 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     350      361428 :       break;
     351             :     case 'V':
     352             :     case '=':
     353      852048 :     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     1779462 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     363     1779462 :   return arity;
     364             : }
     365             : static void
     366           8 : check_name(const char *name)
     367             : {
     368           8 :   const char *s = name;
     369           8 :   if (isalpha((int)*s))
     370           8 :     while (is_keyword_char(*++s)) /* empty */;
     371           8 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     372           8 : }
     373             : 
     374             : entree *
     375           8 : install(void *f, const char *name, const char *code)
     376             : {
     377           8 :   long arity = check_proto(code);
     378             :   entree *ep;
     379             : 
     380           8 :   check_name(name);
     381           8 :   ep = fetch_entry(name);
     382           8 :   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           8 :     ep->value = f;
     392           8 :     ep->valence = EpINSTALL;
     393             :   }
     394           8 :   ep->code = pari_strdup(code);
     395           8 :   ep->arity = arity; return ep;
     396             : }
     397             : 
     398             : static void
     399          18 : killep(entree *ep)
     400             : {
     401          18 :   GEN p = (GEN)initial_value(ep);
     402          18 :   freeep(ep);
     403          18 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     404          18 :   ep->valence = EpNEW;
     405          18 :   ep->value   = NULL;
     406          18 :   ep->pvalue  = NULL;
     407          18 : }
     408             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     409             : void
     410          18 : kill0(const char *e)
     411             : {
     412          18 :   entree *ep = is_entry(e);
     413          18 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     414          18 :   killep(ep);
     415          18 : }
     416             : 
     417             : void
     418          50 : addhelp(const char *e, char *s)
     419             : {
     420          50 :   entree *ep = fetch_entry(e);
     421          50 :   void *f = (void *) ep->help;
     422          50 :   ep->help = pari_strdup(s);
     423          50 :   if (f && !EpSTATIC(ep)) pari_free(f);
     424          50 : }
     425             : 
     426             : GEN
     427       23409 : type0(GEN x)
     428             : {
     429       23409 :   const char *s = type_name(typ(x));
     430       23409 :   return strtoGENstr(s);
     431             : }
     432             : 
     433             : /*******************************************************************/
     434             : /*                                                                 */
     435             : /*                              PARSER                             */
     436             : /*                                                                 */
     437             : /*******************************************************************/
     438             : 
     439             : #ifdef LONG_IS_64BIT
     440             : static const long MAX_DIGITS  = 19;
     441             : #else
     442             : static const long MAX_DIGITS  = 9;
     443             : #endif
     444             : 
     445             : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     446             : static const long MAX_BDIGITS = BITS_IN_LONG;
     447             : 
     448             : static int
     449    34641949 : ishex(const char **s)
     450             : {
     451    34641949 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     452             :   {
     453          49 :     *s += 2;
     454          49 :     return 1;
     455             :   }
     456             :   else
     457    34641900 :     return 0;
     458             : }
     459             : 
     460             : static int
     461    34641998 : isbin(const char **s)
     462             : {
     463    34641998 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     464             :   {
     465          49 :     *s += 2;
     466          49 :     return 1;
     467             :   }
     468             :   else
     469    34641949 :     return 0;
     470             : }
     471             : 
     472             : static ulong
     473          38 : bin_number_len(const char *s, long n)
     474             : {
     475          38 :   ulong m = 0;
     476             :   long i;
     477        1494 :   for (i = 0; i < n; i++,s++)
     478        1456 :     m = 2*m + (*s - '0');
     479          38 :   return m;
     480             : }
     481             : 
     482             : static int
     483        1484 : pari_isbdigit(int c)
     484             : {
     485        1484 :   return c=='0' || c=='1';
     486             : }
     487             : 
     488             : static ulong
     489          54 : hex_number_len(const char *s, long n)
     490             : {
     491          54 :   ulong m = 0;
     492             :   long i;
     493         593 :   for(i = 0; i < n; i++, s++)
     494             :   {
     495             :     ulong c;
     496         539 :     if( *s >= '0' && *s <= '9')
     497         455 :       c = *s - '0';
     498          84 :     else if( *s >= 'A' && *s <= 'F')
     499          84 :       c = *s - 'A' + 10;
     500             :     else
     501           0 :       c = *s - 'a' + 10;
     502         539 :     m = 16*m + c;
     503             :   }
     504          54 :   return m;
     505             : }
     506             : 
     507             : static GEN
     508          56 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     509             : {
     510          56 :   long i, l = (n+B-1)/B;
     511             :   GEN N, Np;
     512          56 :   N = cgetipos(l+2);
     513          56 :   Np = int_LSW(N);
     514          92 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     515          36 :     uel(Np, 0) = num(s+n-i*B, B);
     516          56 :   uel(Np, 0) = num(s, n-(i-1)*B);
     517          56 :   return int_normalize(N, 0);
     518             : }
     519             : 
     520             : static GEN
     521          56 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     522             : {
     523          56 :   const char *s = *ps;
     524          56 :   while (is((int)**ps)) (*ps)++;
     525          56 :   return strtobin_len(s, *ps-s, B, num);
     526             : }
     527             : 
     528             : static GEN
     529          28 : bin_read(const char **ps)
     530             : {
     531          28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     532             : }
     533             : 
     534             : static GEN
     535          28 : hex_read(const char **ps)
     536             : {
     537          28 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     538             : }
     539             : 
     540             : static ulong
     541     2996940 : dec_number_len(const char *s, long B)
     542             : {
     543     2996940 :   ulong m = 0;
     544             :   long n;
     545    45363521 :   for (n = 0; n < B; n++,s++)
     546    42366581 :     m = 10*m + (*s - '0');
     547     2996940 :   return m;
     548             : }
     549             : 
     550             : static GEN
     551      833090 : dec_strtoi_len(const char *s, long n)
     552             : {
     553      833090 :   const long B = MAX_DIGITS;
     554      833090 :   long i, l = (n+B-1)/B;
     555      833090 :   GEN V = cgetg(l+1, t_VECSMALL);
     556     2996940 :   for (i=1; i<l; i++)
     557     2163850 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     558      833090 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     559      833090 :   return fromdigitsu(V, powuu(10, B));
     560             : }
     561             : 
     562             : static GEN
     563      833090 : dec_read_more(const char **ps)
     564             : {
     565      833090 :   pari_sp av = avma;
     566      833090 :   const char *s = *ps;
     567      833090 :   while (isdigit((int)**ps)) (*ps)++;
     568      833090 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     569             : }
     570             : 
     571             : static ulong
     572     7838723 : number(int *n, const char **s)
     573             : {
     574     7838723 :   ulong m = 0;
     575    38577813 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     576    30739090 :     m = 10*m + (**s - '0');
     577     7838723 :   return m;
     578             : }
     579             : 
     580             : static GEN
     581     7763242 : dec_read(const char **s)
     582             : {
     583             :   int nb;
     584     7763242 :   ulong y  = number(&nb, s);
     585     7763242 :   if (nb < MAX_DIGITS)
     586     6930152 :     return utoi(y);
     587      833090 :   *s -= MAX_DIGITS;
     588      833090 :   return dec_read_more(s);
     589             : }
     590             : 
     591             : static GEN
     592        1915 : real_read_more(GEN y, const char **ps)
     593             : {
     594        1915 :   pari_sp av = avma;
     595        1915 :   const char *s = *ps;
     596        1915 :   GEN z = dec_read(ps);
     597        1915 :   long e = *ps-s;
     598        1915 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     599             : }
     600             : 
     601             : static long
     602       75481 : exponent(const char **pts)
     603             : {
     604       75481 :   const char *s = *pts;
     605             :   long n;
     606             :   int nb;
     607       75481 :   switch(*++s)
     608             :   {
     609       75348 :     case '-': s++; n = -(long)number(&nb, &s); break;
     610           0 :     case '+': s++; /* Fall through */
     611         133 :     default: n = (long)number(&nb, &s);
     612             :   }
     613       75481 :   *pts = s; return n;
     614             : }
     615             : 
     616             : static GEN
     617         168 : real_0_digits(long n) {
     618         168 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     619         168 :   return real_0_bit(b);
     620             : }
     621             : 
     622             : static GEN
     623       82742 : real_read(pari_sp av, const char **s, GEN y, long prec)
     624             : {
     625       82742 :   long l, n = 0;
     626       82742 :   switch(**s)
     627             :   {
     628           0 :     default: return y; /* integer */
     629             :     case '.':
     630             :     {
     631        8472 :       const char *old = ++*s;
     632        8472 :       if (isalpha((int)**s) || **s=='.')
     633             :       {
     634        1204 :         if (**s == 'E' || **s == 'e') {
     635        1204 :           n = exponent(s);
     636        1204 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     637        1183 :           break;
     638             :         }
     639           0 :         --*s; return y; /* member */
     640             :       }
     641        7268 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     642        7268 :       n = old - *s;
     643        7268 :       if (**s != 'E' && **s != 'e')
     644             :       {
     645        7261 :         if (!signe(y)) { avma = av; return real_0(prec); }
     646        6330 :         break;
     647             :       }
     648             :     }
     649             :     /* Fall through */
     650             :     case 'E': case 'e':
     651       74277 :       n += exponent(s);
     652       74277 :       if (!signe(y)) { avma = av; return real_0_digits(n); }
     653             :   }
     654       81643 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     655       81643 :   if (l < prec) l = prec; else prec = l;
     656       81643 :   if (!n) return itor(y, prec);
     657       76514 :   incrprec(l);
     658       76514 :   y = itor(y, l);
     659       76514 :   if (n > 0)
     660          56 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     661             :   else
     662       76458 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     663       76514 :   return gerepileuptoleaf(av, rtor(y, prec));
     664             : }
     665             : 
     666             : static GEN
     667     7678641 : int_read(const char **s)
     668             : {
     669             :   GEN y;
     670     7678641 :   if (isbin(s))
     671          28 :     y = bin_read(s);
     672     7678613 :   else if (ishex(s))
     673          28 :     y = hex_read(s);
     674             :   else
     675     7678585 :     y = dec_read(s);
     676     7678641 :   return y;
     677             : }
     678             : 
     679             : GEN
     680     7678641 : strtoi(const char *s) { return int_read(&s); }
     681             : 
     682             : GEN
     683       82742 : strtor(const char *s, long prec)
     684             : {
     685       82742 :   pari_sp av = avma;
     686       82742 :   GEN y = dec_read(&s);
     687       82742 :   y = real_read(av, &s, y, prec);
     688       82742 :   if (typ(y) == t_REAL) return y;
     689           0 :   return gerepileuptoleaf(av, itor(y, prec));
     690             : }
     691             : 
     692             : static void
     693     7480890 : skipdigits(char **lex) {
     694     7480890 :   while (isdigit((int)**lex)) ++*lex;
     695     7480890 : }
     696             : 
     697             : static int
     698     7477734 : skipexponent(char **lex)
     699             : {
     700     7477734 :   char *old=*lex;
     701     7477734 :   if ((**lex=='e' || **lex=='E'))
     702             :   {
     703         917 :     ++*lex;
     704         917 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     705         917 :     if (!isdigit((int)**lex))
     706             :     {
     707         441 :       *lex=old;
     708         441 :       return KINTEGER;
     709             :     }
     710         476 :     skipdigits(lex);
     711         476 :     return KREAL;
     712             :   }
     713     7476817 :   return KINTEGER;
     714             : }
     715             : 
     716             : static int
     717     7478492 : skipconstante(char **lex)
     718             : {
     719     7478492 :   skipdigits(lex);
     720     7478492 :   if (**lex=='.')
     721             :   {
     722       13082 :     char *old = ++*lex;
     723       13082 :     if (**lex == '.') { --*lex; return KINTEGER; }
     724       12324 :     if (isalpha((int)**lex))
     725             :     {
     726       10402 :       skipexponent(lex);
     727       10402 :       if (*lex == old)
     728             :       {
     729       10374 :         --*lex; /* member */
     730       10374 :         return KINTEGER;
     731             :       }
     732          28 :       return KREAL;
     733             :     }
     734        1922 :     skipdigits(lex);
     735        1922 :     skipexponent(lex);
     736        1922 :     return KREAL;
     737             :   }
     738     7465410 :   return skipexponent(lex);
     739             : }
     740             : 
     741             : static void
     742     1106962 : skipstring(char **lex)
     743             : {
     744     8996755 :   while (**lex)
     745             :   {
     746     7889793 :     while (**lex == '\\') *lex+=2;
     747     7889793 :     if (**lex == '"')
     748             :     {
     749     1106962 :       if ((*lex)[1] != '"') break;
     750           0 :       *lex += 2; continue;
     751             :     }
     752     6782831 :     (*lex)++;
     753             :   }
     754     1106962 : }
     755             : 
     756             : int
     757    28521773 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     758             : {
     759             :   (void) yylval;
     760    28521773 :   yylloc->start=*lex;
     761    28521773 :   if (!**lex)
     762             :   {
     763       85098 :     yylloc->end=*lex;
     764       85098 :     return 0;
     765             :   }
     766    28436675 :   if (isalpha((int)**lex))
     767             :   {
     768      355189 :     while (is_keyword_char(**lex)) ++*lex;
     769      355189 :     yylloc->end=*lex;
     770      355189 :     return KENTRY;
     771             :   }
     772    28081486 :   if (**lex=='"')
     773             :   {
     774     1106962 :     ++*lex;
     775     1106962 :     skipstring(lex);
     776     1106962 :     if (!**lex)
     777           0 :       compile_err("run-away string",*lex-1);
     778     1106962 :     ++*lex;
     779     1106962 :     yylloc->end=*lex;
     780     1106962 :     return KSTRING;
     781             :   }
     782    26974524 :   if (**lex == '.')
     783             :   {
     784             :     int token;
     785       11167 :     if ((*lex)[1]== '.')
     786             :     {
     787         786 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     788             :     }
     789       10381 :     token=skipconstante(lex);
     790       10381 :     if (token==KREAL)
     791             :     {
     792           7 :       yylloc->end = *lex;
     793           7 :       return token;
     794             :     }
     795       10374 :     ++*lex;
     796       10374 :     yylloc->end=*lex;
     797       10374 :     return '.';
     798             :   }
     799    26963357 :   if (isbin((const char**)lex))
     800             :   {
     801          21 :     while (**lex=='0' || **lex=='1') ++*lex;
     802          21 :     return KINTEGER;
     803             :   }
     804    26963336 :   if (ishex((const char**)lex))
     805             :   {
     806          21 :     while (isxdigit((int)**lex)) ++*lex;
     807          21 :     return KINTEGER;
     808             :   }
     809    26963315 :   if (isdigit((int)**lex))
     810             :   {
     811     7468111 :     int token=skipconstante(lex);
     812     7468111 :     yylloc->end = *lex;
     813     7468111 :     return token;
     814             :   }
     815    19495204 :   if ((*lex)[1]=='=')
     816       18591 :     switch (**lex)
     817             :     {
     818             :     case '=':
     819        6994 :       if ((*lex)[2]=='=')
     820         329 :       { *lex+=3; yylloc->end = *lex; return KID; }
     821             :       else
     822        6665 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     823             :     case '>':
     824          69 :       *lex+=2; yylloc->end = *lex; return KGE;
     825             :     case '<':
     826         160 :       *lex+=2; yylloc->end = *lex; return KLE;
     827             :     case '*':
     828         146 :       *lex+=2; yylloc->end = *lex; return KME;
     829             :     case '/':
     830          35 :       *lex+=2; yylloc->end = *lex; return KDE;
     831             :     case '%':
     832           7 :       if ((*lex)[2]=='=') break;
     833           7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     834             :     case '!':
     835        1617 :       if ((*lex)[2]=='=') break;
     836        1617 :       *lex+=2; yylloc->end = *lex; return KNE;
     837             :     case '\\':
     838           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     839             :     case '+':
     840         127 :       *lex+=2; yylloc->end = *lex; return KPE;
     841             :     case '-':
     842          35 :       *lex+=2; yylloc->end = *lex; return KSE;
     843             :     }
     844    19486007 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     845             :   {
     846        3884 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     847             :   }
     848    19482123 :   if (**lex=='-' && (*lex)[1]=='>')
     849             :   {
     850         817 :     *lex+=2; yylloc->end = *lex; return KARROW;
     851             :   }
     852    19481306 :   if (**lex=='<' && (*lex)[1]=='>')
     853             :   {
     854           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     855             :   }
     856    19481306 :   if (**lex=='\\' && (*lex)[1]=='/')
     857          35 :     switch((*lex)[2])
     858             :     {
     859             :     case '=':
     860           7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     861             :     default:
     862          28 :       *lex+=2; yylloc->end = *lex; return KDR;
     863             :     }
     864    19481271 :   if ((*lex)[1]==**lex)
     865     2113428 :     switch (**lex)
     866             :     {
     867             :     case '&':
     868         651 :       *lex+=2; yylloc->end = *lex; return KAND;
     869             :     case '|':
     870         287 :       *lex+=2; yylloc->end = *lex; return KOR;
     871             :     case '+':
     872          91 :       *lex+=2; yylloc->end = *lex; return KPP;
     873             :     case '-':
     874          14 :       *lex+=2; yylloc->end = *lex; return KSS;
     875             :     case '>':
     876          28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     877          21 :       *lex+=2; yylloc->end = *lex; return KSR;
     878             :     case '<':
     879         112 :       if ((*lex)[2]=='=')
     880           7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     881         105 :       *lex+=2; yylloc->end = *lex; return KSL;
     882             :     }
     883    19480088 :   yylloc->end = *lex+1;
     884    19480088 :   return (unsigned char) *(*lex)++;
     885             : }
     886             : 
     887             : /********************************************************************/
     888             : /**                                                                **/
     889             : /**                            STRINGS                             **/
     890             : /**                                                                **/
     891             : /********************************************************************/
     892             : 
     893             : /* return the first n0 chars of s as a GEN [s may not be 0-terminated] */
     894             : GEN
     895      430014 : strntoGENstr(const char *s, long n0)
     896             : {
     897      430014 :   long n = nchar2nlong(n0+1);
     898      430014 :   GEN x = cgetg(n+1, t_STR);
     899      430014 :   char *t = GSTR(x);
     900      430014 :   strncpy(t, s, n0); t[n0] = 0; return x;
     901             : }
     902             : 
     903             : GEN
     904      326607 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     905             : 
     906             : GEN
     907          56 : chartoGENstr(char c)
     908             : {
     909          56 :   GEN x = cgetg(2, t_STR);
     910          56 :   char *t = GSTR(x);
     911          56 :   t[0] = c; t[1] = 0; return x;
     912             : }
     913             : 
     914             : /********************************************************************/
     915             : /*                                                                  */
     916             : /*                Formal variables management                       */
     917             : /*                                                                  */
     918             : /********************************************************************/
     919             : static THREAD long max_priority, min_priority;
     920             : static THREAD long max_avail; /* max variable not yet used */
     921             : static THREAD long nvar; /* first GP free variable */
     922             : static hashtable *h_polvar;
     923             : static struct pari_varstate global_varstate;
     924             : static long *global_varpriority;
     925             : 
     926             : void
     927       97172 : varstate_save(struct pari_varstate *s)
     928             : {
     929       97172 :   s->nvar = nvar;
     930       97172 :   s->max_avail = max_avail;
     931       97172 :   s->max_priority = max_priority;
     932       97172 :   s->min_priority = min_priority;
     933       97172 : }
     934             : 
     935             : static void
     936        8312 : varentries_set(long v, entree *ep)
     937             : {
     938        8312 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     939        8312 :   varentries[v] = ep;
     940        8312 : }
     941             : static int
     942        3129 : _given_value(void *E, hashentry *e) { return e->val == E; }
     943             : 
     944             : static void
     945       11486 : varentries_unset(long v)
     946             : {
     947       11486 :   entree *ep = varentries[v];
     948       11486 :   if (ep)
     949             :   {
     950        3129 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     951             :         _given_value);
     952        3129 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     953        3129 :     varentries[v] = NULL;
     954        3129 :     pari_free(e);
     955        3129 :     if (v <= nvar && ep == is_entry(ep->name))
     956        2891 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     957        2891 :       GEN p = (GEN)initial_value(ep);
     958        2891 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     959        2891 :       *p = 0;
     960             :     }
     961             :     else /* from name_var() or a direct pari_var_create() */
     962         238 :       pari_free(ep);
     963             :  }
     964       11486 : }
     965             : static void
     966         336 : varentries_reset(long v, entree *ep)
     967             : {
     968         336 :   varentries_unset(v);
     969         336 :   varentries_set(v, ep);
     970         336 : }
     971             : 
     972             : static void
     973       97674 : var_restore(struct pari_varstate *s)
     974             : {
     975       97674 :   nvar = s->nvar;
     976       97674 :   max_avail = s->max_avail;
     977       97674 :   max_priority = s->max_priority;
     978       97674 :   min_priority = s->min_priority;
     979       97674 : }
     980             : 
     981             : void
     982        8217 : varstate_restore(struct pari_varstate *s)
     983             : {
     984             :   long i;
     985       19332 :   for (i = nvar; i >= s->nvar; i--)
     986             :   {
     987       11115 :     varentries_unset(i);
     988       11115 :     varpriority[i] = -i;
     989             :   }
     990        8252 :   for (i = max_avail+1; i <= s->max_avail; i++)
     991             :   {
     992          35 :     varentries_unset(i);
     993          35 :     varpriority[i] = -i;
     994             :   }
     995        8217 :   var_restore(s);
     996        8217 : }
     997             : 
     998             : void
     999       90246 : pari_thread_init_varstate(void)
    1000             : {
    1001             :   long i;
    1002       90246 :   var_restore(&global_varstate);
    1003       88938 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
    1004       91528 :   varpriority[-1] = 1-LONG_MAX;
    1005       91528 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
    1006       91528 : }
    1007             : 
    1008             : void
    1009       11790 : pari_pthread_init_varstate(void)
    1010             : {
    1011       11790 :   varstate_save(&global_varstate);
    1012       11790 :   global_varpriority = varpriority;
    1013       11790 : }
    1014             : 
    1015             : void
    1016        1536 : pari_var_close(void)
    1017             : {
    1018        1536 :   free((void*)varentries);
    1019        1536 :   free((void*)(varpriority-1));
    1020        1536 :   hash_destroy(h_polvar);
    1021        1536 : }
    1022             : 
    1023             : void
    1024        1538 : pari_var_init(void)
    1025             : {
    1026             :   long i;
    1027        1538 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
    1028        1538 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
    1029        1538 :   varpriority[-1] = 1-LONG_MAX;
    1030        1538 :   h_polvar = hash_create_str(100, 0);
    1031        1538 :   nvar = 0; max_avail = MAXVARN;
    1032        1538 :   max_priority = min_priority = 0;
    1033        1538 :   (void)fetch_user_var("x");
    1034        1538 :   (void)fetch_user_var("y");
    1035             :   /* initialize so that people can use pol_x(i) directly */
    1036        1538 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
    1037             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
    1038        1538 :   nvar = 10;
    1039        1538 :   min_priority = -MAXVARN;
    1040        1538 : }
    1041         260 : long pari_var_next(void) { return nvar; }
    1042         147 : long pari_var_next_temp(void) { return max_avail; }
    1043             : long
    1044       22326 : pari_var_create(entree *ep)
    1045             : {
    1046       22326 :   GEN p = (GEN)initial_value(ep);
    1047             :   long v;
    1048       22326 :   if (*p) return varn(p);
    1049        7976 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1050        7976 :   v = nvar++;
    1051             :   /* set p = pol_x(v) */
    1052        7976 :   p[0] = evaltyp(t_POL) | _evallg(4);
    1053        7976 :   p[1] = evalsigne(1) | evalvarn(v);
    1054        7976 :   gel(p,2) = gen_0;
    1055        7976 :   gel(p,3) = gen_1;
    1056        7976 :   varentries_set(v, ep);
    1057        7976 :   varpriority[v]= min_priority--;
    1058        7976 :   return v;
    1059             : }
    1060             : 
    1061             : long
    1062       69773 : delete_var(void)
    1063             : { /* user wants to delete one of his/her/its variables */
    1064       69773 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
    1065       69773 :   max_avail++;
    1066       69773 :   if      (varpriority[max_avail] == min_priority) min_priority++;
    1067       69773 :   else if (varpriority[max_avail] == max_priority) max_priority--;
    1068       69773 :   return max_avail+1;
    1069             : }
    1070             : long
    1071       39663 : fetch_var(void)
    1072             : {
    1073       39663 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1074       39663 :   varpriority[max_avail] = min_priority--;
    1075       39663 :   return max_avail--;
    1076             : }
    1077             : long
    1078       30171 : fetch_var_higher(void)
    1079             : {
    1080       30171 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1081       30172 :   varpriority[max_avail] = ++max_priority;
    1082       30172 :   return max_avail--;
    1083             : }
    1084             : 
    1085             : static int
    1086          49 : _higher(void *E, hashentry *e)
    1087          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1088             : static int
    1089          42 : _lower(void *E, hashentry *e)
    1090          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1091             : 
    1092             : static GEN
    1093          84 : var_register(long v, const char *s)
    1094             : {
    1095          84 :   varentries_reset(v, initep(s, strlen(s)));
    1096          84 :   return pol_x(v);
    1097             : }
    1098             : GEN
    1099          77 : varhigher(const char *s, long w)
    1100             : {
    1101             :   long v;
    1102          77 :   if (w >= 0)
    1103             :   {
    1104          49 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1105          49 :     if (e) return pol_x((long)e->val);
    1106             :   }
    1107             :   /* no luck: need to create */
    1108          63 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1109          63 :   v = nvar++;
    1110          63 :   varpriority[v]= ++max_priority;
    1111          63 :   return var_register(v, s);
    1112             : }
    1113             : GEN
    1114          28 : varlower(const char *s, long w)
    1115             : {
    1116             :   long v;
    1117          28 :   if (w >= 0)
    1118             :   {
    1119          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1120          21 :     if (e) return pol_x((long)e->val);
    1121             :   }
    1122             :   /* no luck: need to create */
    1123          21 :   v = fetch_var();
    1124          21 :   return var_register(v, s);
    1125             : }
    1126             : 
    1127             : long
    1128      385669 : fetch_user_var(const char *s)
    1129             : {
    1130      385669 :   entree *ep = fetch_entry(s);
    1131             :   long v;
    1132      385669 :   switch (EpVALENCE(ep))
    1133             :   {
    1134      382453 :     case EpVAR: return varn((GEN)initial_value(ep));
    1135        3216 :     case EpNEW: break;
    1136           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1137             :   }
    1138        3216 :   v = pari_var_create(ep);
    1139        3216 :   ep->valence = EpVAR;
    1140        3216 :   ep->value = initial_value(ep);
    1141        3216 :   return v;
    1142             : }
    1143             : 
    1144             : GEN
    1145           7 : fetch_var_value(long v, GEN t)
    1146             : {
    1147           7 :   entree *ep = varentries[v];
    1148           7 :   if (!ep) return NULL;
    1149           7 :   if (t)
    1150             :   {
    1151           7 :     long vn = localvars_find(t,ep);
    1152           7 :     if (vn) return get_lex(vn);
    1153             :   }
    1154           7 :   return (GEN)ep->value;
    1155             : }
    1156             : 
    1157             : void
    1158         252 : name_var(long n, const char *s)
    1159             : {
    1160             :   entree *ep;
    1161             :   char *u;
    1162             : 
    1163         252 :   if (n < pari_var_next())
    1164           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1165         252 :   if (n > (long)MAXVARN)
    1166           0 :     pari_err_OVERFLOW("variable number");
    1167             : 
    1168         252 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1169         252 :   u = (char *)initial_value(ep);
    1170         252 :   ep->valence = EpVAR;
    1171         252 :   ep->name = u; strcpy(u,s);
    1172         252 :   ep->value = gen_0; /* in case geval is called */
    1173         252 :   varentries_reset(n, ep);
    1174         252 : }
    1175             : 
    1176             : static int
    1177        5122 : cmp_by_var(void *E,GEN x, GEN y)
    1178        5122 : { (void)E; return varncmp((long)x,(long)y); }
    1179             : GEN
    1180         574 : vars_sort_inplace(GEN z)
    1181         574 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1182             : GEN
    1183         154 : vars_to_RgXV(GEN h)
    1184             : {
    1185         154 :   long i, l = lg(h);
    1186         154 :   GEN z = cgetg(l, t_VEC);
    1187         154 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1188         154 :   return z;
    1189             : }
    1190             : GEN
    1191         728 : gpolvar(GEN x)
    1192             : {
    1193             :   long v;
    1194         728 :   if (!x) {
    1195         140 :     GEN h = hash_values(h_polvar);
    1196         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1197             :   }
    1198         588 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1199         581 :   v = gvar(x);
    1200         581 :   if (v==NO_VARIABLE) return gen_0;
    1201         518 :   return pol_x(v);
    1202             : }
    1203             : 
    1204             : static void
    1205     1796372 : fill_hashtable_single(entree **table, entree *ep)
    1206             : {
    1207     1796372 :   EpSETSTATIC(ep);
    1208     1796372 :   insertep(ep, table,  hashvalue(ep->name));
    1209     1796372 :   if (ep->code) ep->arity = check_proto(ep->code);
    1210     1796372 :   ep->pvalue = NULL;
    1211     1796372 : }
    1212             : 
    1213             : void
    1214        4612 : pari_fill_hashtable(entree **table, entree *ep)
    1215             : {
    1216        4612 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1217        4612 : }
    1218             : 
    1219             : void
    1220           0 : pari_add_function(entree *ep)
    1221             : {
    1222           0 :   fill_hashtable_single(functions_hash, ep);
    1223           0 : }
    1224             : 
    1225             : /********************************************************************/
    1226             : /**                                                                **/
    1227             : /**                        SIMPLE GP FUNCTIONS                     **/
    1228             : /**                                                                **/
    1229             : /********************************************************************/
    1230             : 
    1231             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1232             : 
    1233             : entree *
    1234     5847278 : do_alias(entree *ep)
    1235             : {
    1236     5847278 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1237     5847278 :   return ep;
    1238             : }
    1239             : 
    1240             : void
    1241          28 : alias0(const char *s, const char *old)
    1242             : {
    1243             :   entree *ep, *e;
    1244             :   GEN x;
    1245             : 
    1246          28 :   ep = fetch_entry(old);
    1247          28 :   e  = fetch_entry(s);
    1248          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1249           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1250          28 :   freeep(e);
    1251          28 :   x = newblock(2); x[0] = evaltyp(t_STR)|_evallg(2); /* for getheap */
    1252          28 :   gel(x,1) = (GEN)ep;
    1253          28 :   e->value=x; e->valence=EpALIAS;
    1254          28 : }
    1255             : 
    1256             : GEN
    1257    12829551 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1258             : {
    1259    12829551 :   if (gequal0(g)) /* false */
    1260     9956995 :     return b? closure_evalgen(b): gnil;
    1261             :   else /* true */
    1262     2872557 :     return a? closure_evalgen(a): gnil;
    1263             : }
    1264             : 
    1265             : void
    1266    31388889 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1267             : {
    1268    31388889 :   if (gequal0(g)) /* false */
    1269    30718315 :   { if (b) closure_evalvoid(b); }
    1270             :   else /* true */
    1271      670574 :   { if (a) closure_evalvoid(a); }
    1272    31388868 : }
    1273             : 
    1274             : GEN
    1275       28126 : ifpari_multi(GEN g, GEN a/*closure*/)
    1276             : {
    1277       28126 :   long i, nb = lg(a)-1;
    1278       28126 :   if (!gequal0(g)) /* false */
    1279        5285 :     return closure_evalgen(gel(a,1));
    1280       39907 :   for(i=2;i<nb;i+=2)
    1281             :   {
    1282       22939 :     GEN g = closure_evalgen(gel(a,i));
    1283       22939 :     if (!g) return g;
    1284       22932 :     if (!gequal0(g))
    1285        5866 :       return closure_evalgen(gel(a,i+1));
    1286             :   }
    1287       16968 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1288             : }
    1289             : 
    1290             : GEN
    1291      265090 : andpari(GEN a, GEN b/*closure*/)
    1292             : {
    1293             :   GEN g;
    1294      265090 :   if (gequal0(a))
    1295       41979 :     return gen_0;
    1296      223111 :   g=closure_evalgen(b);
    1297      223111 :   if (!g) return g;
    1298      223111 :   return gequal0(g)?gen_0:gen_1;
    1299             : }
    1300             : 
    1301             : GEN
    1302    16420089 : orpari(GEN a, GEN b/*closure*/)
    1303             : {
    1304             :   GEN g;
    1305    16420089 :   if (!gequal0(a))
    1306      118887 :     return gen_1;
    1307    16301202 :   g=closure_evalgen(b);
    1308    16301202 :   if (!g) return g;
    1309    16301202 :   return gequal0(g)?gen_0:gen_1;
    1310             : }
    1311             : 
    1312       80010 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1313          56 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1314           7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1315           7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1316           7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1317           7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1318           7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1319     2373646 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1320    17164266 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addiu(*x,1):gaddgs(*x,1); return *x; }
    1321    15171541 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1322          14 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subiu(*x,1):gsubgs(*x,1); return *x; }
    1323             : 
    1324        1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.11