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 20459-9710128) Lines: 624 718 86.9 %
Date: 2017-03-30 05:32:39 Functions: 96 100 96.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     1304619 : hashvalue(const char *s)
     210             : {
     211     1304619 :   ulong n = 0, c;
     212     1304619 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     213     1304619 :   return n;
     214             : }
     215             : 
     216             : static ulong
     217     4796772 : hashvalue_raw(const char *s, long len)
     218             : {
     219     4796772 :   long n = 0, i;
     220     4796772 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     221     4796772 :   return n;
     222             : }
     223             : 
     224             : static void
     225     1324167 : insertep(entree *ep, entree **table, ulong hash)
     226             : {
     227     1324167 :   ep->hash = hash;
     228     1324167 :   hash %= functions_tblsz;
     229     1324167 :   ep->next = table[hash];
     230     1324167 :   table[hash] = ep;
     231     1324167 : }
     232             : 
     233             : static entree *
     234       19608 : initep(const char *name, long len)
     235             : {
     236       19608 :   const long add = 4*sizeof(long);
     237       19608 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     238       19608 :   entree *ep1 = initial_value(ep);
     239       19608 :   char *u = (char *) ep1 + add;
     240       19608 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     241       19608 :   ep->valence = EpNEW;
     242       19608 :   ep->value   = NULL;
     243       19608 :   ep->menu    = 0;
     244       19608 :   ep->code    = NULL;
     245       19608 :   ep->help    = NULL;
     246       19608 :   ep->pvalue  = NULL;
     247       19608 :   ep->arity   = 0;
     248       19608 :   return ep;
     249             : }
     250             : 
     251             : /* Look for s of length len in T; if 'insert', insert if missing */
     252             : static entree *
     253     4796772 : findentry(const char *s, long len, entree **T, int insert)
     254             : {
     255     4796772 :   ulong hash = hashvalue_raw(s, len);
     256             :   entree *ep;
     257    28117563 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     258    28097979 :     if (ep->hash == hash)
     259             :     {
     260     4813118 :       const char *t = ep->name;
     261     4813118 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     262             :     }
     263             :   /* not found */
     264       19584 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     265       19584 :   return ep;
     266             : }
     267             : entree *
     268         856 : pari_is_default(const char *s)
     269         856 : { return findentry(s, strlen(s), defaults_hash, 0); }
     270             : entree *
     271       63208 : is_entry(const char *s)
     272       63208 : { return findentry(s, strlen(s), functions_hash, 0); }
     273             : entree *
     274     4732708 : fetch_entry_raw(const char *s, long len)
     275     4732708 : { return findentry(s, len, functions_hash, 1); }
     276             : entree *
     277        2762 : 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        3498 : readseq(char *t)
     286             : {
     287        3498 :   pari_sp av = avma;
     288             :   GEN x;
     289        3498 :   if (gp_meta(t,0)) return gnil;
     290        3498 :   x = pari_compile_str(t);
     291        3498 :   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        8664 : compile_str(const char *s)
     305             : {
     306        8664 :   char *t = gp_filter(s);
     307        8664 :   GEN x = pari_compile_str(t);
     308        8658 :   pari_free(t); return x;
     309             : }
     310             : 
     311             : static long
     312     1294819 : check_proto(const char *code)
     313             : {
     314     1294819 :   long arity = 0;
     315     1294819 :   const char *s = code, *old;
     316     1294819 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     317     6267075 :   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     2343421 :       arity++;
     335     2343421 :       break;
     336             :     case 'E':
     337             :     case 's':
     338       85750 :       if (*s == '*') s++;
     339       85750 :       arity++;
     340       85750 :       break;
     341             :     case 'D':
     342      629647 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     343      285422 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     344             :       {
     345      369950 :         if (*s != 'V') arity++;
     346      369950 :         s++; break;
     347             :       }
     348      259697 :       old = s; while (*s && *s != ',') s++;
     349      259697 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     350      259697 :       break;
     351             :     case 'V':
     352             :     case '=':
     353      618619 :     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     1294819 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     363     1294819 :   return arity;
     364             : }
     365             : static void
     366           0 : check_name(const char *name)
     367             : {
     368           0 :   const char *s = name;
     369           0 :   if (isalpha((int)*s))
     370           0 :     while (is_keyword_char(*++s)) /* empty */;
     371           0 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     372           0 : }
     373             : 
     374             : entree *
     375           0 : install(void *f, const char *name, const char *code)
     376             : {
     377           0 :   long arity = check_proto(code);
     378             :   entree *ep;
     379             : 
     380           0 :   check_name(name);
     381           0 :   ep = fetch_entry(name);
     382           0 :   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           0 :     ep->value = f;
     392           0 :     ep->valence = EpINSTALL;
     393             :   }
     394           0 :   ep->code = pari_strdup(code);
     395           0 :   ep->arity = arity; return ep;
     396             : }
     397             : 
     398             : static void
     399          12 : killep(entree *ep)
     400             : {
     401          12 :   GEN p = (GEN)initial_value(ep);
     402          12 :   freeep(ep);
     403          12 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     404          12 :   ep->valence = EpNEW;
     405          12 :   ep->value   = NULL;
     406          12 :   ep->pvalue  = NULL;
     407          12 : }
     408             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     409             : void
     410          12 : kill0(const char *e)
     411             : {
     412          12 :   entree *ep = is_entry(e);
     413          12 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     414          12 :   killep(ep);
     415          12 : }
     416             : 
     417             : void
     418          36 : addhelp(const char *e, char *s)
     419             : {
     420          36 :   entree *ep = fetch_entry(e);
     421          36 :   if (ep->help && !EpSTATIC(ep)) pari_free((void*)ep->help);
     422          36 :   ep->help = pari_strdup(s);
     423          36 : }
     424             : 
     425             : GEN
     426       19920 : type0(GEN x)
     427             : {
     428       19920 :   const char *s = type_name(typ(x));
     429       19920 :   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    29502838 : ishex(const char **s)
     449             : {
     450    29502838 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     451             :   {
     452          42 :     *s += 2;
     453          42 :     return 1;
     454             :   }
     455             :   else
     456    29502796 :     return 0;
     457             : }
     458             : 
     459             : static int
     460    29502880 : isbin(const char **s)
     461             : {
     462    29502880 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     463             :   {
     464          42 :     *s += 2;
     465          42 :     return 1;
     466             :   }
     467             :   else
     468    29502838 :     return 0;
     469             : }
     470             : 
     471             : static ulong
     472          30 : bin_number_len(const char *s, long n)
     473             : {
     474          30 :   ulong m = 0;
     475             :   long i;
     476        1278 :   for (i = 0; i < n; i++,s++)
     477        1248 :     m = 2*m + (*s - '0');
     478          30 :   return m;
     479             : }
     480             : 
     481             : static int
     482        1272 : pari_isbdigit(int c)
     483             : {
     484        1272 :   return c=='0' || c=='1';
     485             : }
     486             : 
     487             : static ulong
     488          42 : hex_number_len(const char *s, long n)
     489             : {
     490          42 :   ulong m = 0;
     491             :   long i;
     492         504 :   for(i = 0; i < n; i++, s++)
     493             :   {
     494             :     ulong c;
     495         462 :     if( *s >= '0' && *s <= '9')
     496         390 :       c = *s - '0';
     497          72 :     else if( *s >= 'A' && *s <= 'F')
     498          72 :       c = *s - 'A' + 10;
     499             :     else
     500           0 :       c = *s - 'a' + 10;
     501         462 :     m = 16*m + c;
     502             :   }
     503          42 :   return m;
     504             : }
     505             : 
     506             : static GEN
     507          48 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     508             : {
     509          48 :   long i, l = (n+B-1)/B;
     510             :   GEN N, Np;
     511          48 :   N = cgetipos(l+2);
     512          48 :   Np = int_LSW(N);
     513          72 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     514          24 :     uel(Np, 0) = num(s+n-i*B, B);
     515          48 :   uel(Np, 0) = num(s, n-(i-1)*B);
     516          48 :   return int_normalize(N, 0);
     517             : }
     518             : 
     519             : static GEN
     520          48 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     521             : {
     522          48 :   const char *s = *ps;
     523          48 :   while (is((int)**ps)) (*ps)++;
     524          48 :   return strtobin_len(s, *ps-s, B, num);
     525             : }
     526             : 
     527             : static GEN
     528          24 : bin_read(const char **ps)
     529             : {
     530          24 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     531             : }
     532             : 
     533             : static GEN
     534          24 : hex_read(const char **ps)
     535             : {
     536          24 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     537             : }
     538             : 
     539             : static ulong
     540     2112282 : dec_number_len(const char *s, long B)
     541             : {
     542     2112282 :   ulong m = 0;
     543             :   long n;
     544    36154482 :   for (n = 0; n < B; n++,s++)
     545    34042200 :     m = 10*m + (*s - '0');
     546     2112282 :   return m;
     547             : }
     548             : 
     549             : static GEN
     550      626712 : dec_strtoi_len(const char *s, long n)
     551             : {
     552      626712 :   const long B = MAX_DIGITS;
     553      626712 :   long i, l = (n+B-1)/B;
     554      626712 :   GEN V = cgetg(l+1, t_VECSMALL);
     555     2112282 :   for (i=1; i<l; i++)
     556     1485570 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     557      626712 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     558      626712 :   return fromdigitsu(V, powuu(10, B));
     559             : }
     560             : 
     561             : static GEN
     562      626712 : dec_read_more(const char **ps)
     563             : {
     564      626712 :   pari_sp av = avma;
     565      626712 :   const char *s = *ps;
     566      626712 :   while (isdigit((int)**ps)) (*ps)++;
     567      626712 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     568             : }
     569             : 
     570             : static ulong
     571     6631464 : number(int *n, const char **s)
     572             : {
     573     6631464 :   ulong m = 0;
     574    32654406 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     575    26022942 :     m = 10*m + (**s - '0');
     576     6631464 :   return m;
     577             : }
     578             : 
     579             : static GEN
     580     6566832 : dec_read(const char **s)
     581             : {
     582             :   int nb;
     583     6566832 :   ulong y  = number(&nb, s);
     584     6566832 :   if (nb < MAX_DIGITS)
     585     5940120 :     return utoi(y);
     586      626712 :   *s -= MAX_DIGITS;
     587      626712 :   return dec_read_more(s);
     588             : }
     589             : 
     590             : static GEN
     591        1630 : real_read_more(GEN y, const char **ps)
     592             : {
     593        1630 :   pari_sp av = avma;
     594        1630 :   const char *s = *ps;
     595        1630 :   GEN z = dec_read(ps);
     596        1630 :   long e = *ps-s;
     597        1630 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     598             : }
     599             : 
     600             : static long
     601       64632 : exponent(const char **pts)
     602             : {
     603       64632 :   const char *s = *pts;
     604             :   long n;
     605             :   int nb;
     606       64632 :   switch(*++s)
     607             :   {
     608       64554 :     case '-': s++; n = -(long)number(&nb, &s); break;
     609           0 :     case '+': s++; /* Fall through */
     610          78 :     default: n = (long)number(&nb, &s);
     611             :   }
     612       64632 :   *pts = s; return n;
     613             : }
     614             : 
     615             : static GEN
     616         144 : real_0_digits(long n) {
     617         144 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     618         144 :   return real_0_bit(b);
     619             : }
     620             : 
     621             : static GEN
     622       70840 : real_read(pari_sp av, const char **s, GEN y, long prec)
     623             : {
     624       70840 :   long l, n = 0;
     625       70840 :   switch(**s)
     626             :   {
     627           0 :     default: return y; /* integer */
     628             :     case '.':
     629             :     {
     630        7246 :       const char *old = ++*s;
     631        7246 :       if (isalpha((int)**s) || **s=='.')
     632             :       {
     633        1032 :         if (**s == 'E' || **s == 'e') {
     634        1032 :           n = exponent(s);
     635        1032 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     636        1014 :           break;
     637             :         }
     638           0 :         --*s; return y; /* member */
     639             :       }
     640        6214 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     641        6214 :       n = old - *s;
     642        6214 :       if (**s != 'E' && **s != 'e')
     643             :       {
     644        6208 :         if (!signe(y)) { avma = av; return real_0(prec); }
     645        5410 :         break;
     646             :       }
     647             :     }
     648             :     /* Fall through */
     649             :     case 'E': case 'e':
     650       63600 :       n += exponent(s);
     651       63600 :       if (!signe(y)) { avma = av; return real_0_digits(n); }
     652             :   }
     653       69898 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     654       69898 :   if (l < prec) l = prec; else prec = l;
     655       69898 :   if (!n) return itor(y, prec);
     656       65506 :   incrprec(l);
     657       65506 :   y = itor(y, l);
     658       65506 :   if (n > 0)
     659          12 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     660             :   else
     661       65494 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     662       65506 :   return gerepileuptoleaf(av, rtor(y, prec));
     663             : }
     664             : 
     665             : static GEN
     666     6494410 : int_read(const char **s)
     667             : {
     668             :   GEN y;
     669     6494410 :   if (isbin(s))
     670          24 :     y = bin_read(s);
     671     6494386 :   else if (ishex(s))
     672          24 :     y = hex_read(s);
     673             :   else
     674     6494362 :     y = dec_read(s);
     675     6494410 :   return y;
     676             : }
     677             : 
     678             : GEN
     679     6494410 : strtoi(const char *s) { return int_read(&s); }
     680             : 
     681             : GEN
     682       70840 : strtor(const char *s, long prec)
     683             : {
     684       70840 :   pari_sp av = avma;
     685       70840 :   GEN y = dec_read(&s);
     686       70840 :   y = real_read(av, &s, y, prec);
     687       70840 :   if (typ(y) == t_REAL) return y;
     688           0 :   return gerepileuptoleaf(av, itor(y, prec));
     689             : }
     690             : 
     691             : static void
     692     6389070 : skipdigits(char **lex) {
     693     6389070 :   while (isdigit((int)**lex)) ++*lex;
     694     6389070 : }
     695             : 
     696             : static int
     697     6386512 : skipexponent(char **lex)
     698             : {
     699     6386512 :   char *old=*lex;
     700     6386512 :   if ((**lex=='e' || **lex=='E'))
     701             :   {
     702         714 :     ++*lex;
     703         714 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     704         714 :     if (!isdigit((int)**lex))
     705             :     {
     706         372 :       *lex=old;
     707         372 :       return KINTEGER;
     708             :     }
     709         342 :     skipdigits(lex);
     710         342 :     return KREAL;
     711             :   }
     712     6385798 :   return KINTEGER;
     713             : }
     714             : 
     715             : static int
     716     6387080 : skipconstante(char **lex)
     717             : {
     718     6387080 :   skipdigits(lex);
     719     6387080 :   if (**lex=='.')
     720             :   {
     721       11072 :     char *old = ++*lex;
     722       11072 :     if (**lex == '.') { --*lex; return KINTEGER; }
     723       10504 :     if (isalpha((int)**lex))
     724             :     {
     725        8856 :       skipexponent(lex);
     726        8856 :       if (*lex == old)
     727             :       {
     728        8832 :         --*lex; /* member */
     729        8832 :         return KINTEGER;
     730             :       }
     731          24 :       return KREAL;
     732             :     }
     733        1648 :     skipdigits(lex);
     734        1648 :     skipexponent(lex);
     735        1648 :     return KREAL;
     736             :   }
     737     6376008 :   return skipexponent(lex);
     738             : }
     739             : 
     740             : static void
     741      948174 : skipstring(char **lex)
     742             : {
     743     7704324 :   while (**lex)
     744             :   {
     745     6756150 :     while (**lex == '\\') *lex+=2;
     746     6756150 :     if (**lex == '"')
     747             :     {
     748      948174 :       if ((*lex)[1] != '"') break;
     749           0 :       *lex += 2; continue;
     750             :     }
     751     5807976 :     (*lex)++;
     752             :   }
     753      948174 : }
     754             : 
     755             : int
     756    24302462 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     757             : {
     758             :   (void) yylval;
     759    24302462 :   yylloc->start=*lex;
     760    24302462 :   if (!**lex)
     761             :   {
     762       65668 :     yylloc->end=*lex;
     763       65668 :     return 0;
     764             :   }
     765    24236794 :   if (isalpha((int)**lex))
     766             :   {
     767      270726 :     while (is_keyword_char(**lex)) ++*lex;
     768      270726 :     yylloc->end=*lex;
     769      270726 :     return KENTRY;
     770             :   }
     771    23966068 :   if (**lex=='"')
     772             :   {
     773      948174 :     ++*lex;
     774      948174 :     skipstring(lex);
     775      948174 :     if (!**lex)
     776           0 :       compile_err("run-away string",*lex-1);
     777      948174 :     ++*lex;
     778      948174 :     yylloc->end=*lex;
     779      948174 :     return KSTRING;
     780             :   }
     781    23017894 :   if (**lex == '.')
     782             :   {
     783             :     int token;
     784        9424 :     if ((*lex)[1]== '.')
     785             :     {
     786         586 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     787             :     }
     788        8838 :     token=skipconstante(lex);
     789        8838 :     if (token==KREAL)
     790             :     {
     791           6 :       yylloc->end = *lex;
     792           6 :       return token;
     793             :     }
     794        8832 :     ++*lex;
     795        8832 :     yylloc->end=*lex;
     796        8832 :     return '.';
     797             :   }
     798    23008470 :   if (isbin((const char**)lex))
     799             :   {
     800          18 :     while (**lex=='0' || **lex=='1') ++*lex;
     801          18 :     return KINTEGER;
     802             :   }
     803    23008452 :   if (ishex((const char**)lex))
     804             :   {
     805          18 :     while (isxdigit((int)**lex)) ++*lex;
     806          18 :     return KINTEGER;
     807             :   }
     808    23008434 :   if (isdigit((int)**lex))
     809             :   {
     810     6378242 :     int token=skipconstante(lex);
     811     6378242 :     yylloc->end = *lex;
     812     6378242 :     return token;
     813             :   }
     814    16630192 :   if ((*lex)[1]=='=')
     815       14800 :     switch (**lex)
     816             :     {
     817             :     case '=':
     818        5808 :       if ((*lex)[2]=='=')
     819         282 :       { *lex+=3; yylloc->end = *lex; return KID; }
     820             :       else
     821        5526 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     822             :     case '>':
     823          56 :       *lex+=2; yylloc->end = *lex; return KGE;
     824             :     case '<':
     825         134 :       *lex+=2; yylloc->end = *lex; return KLE;
     826             :     case '*':
     827         122 :       *lex+=2; yylloc->end = *lex; return KME;
     828             :     case '/':
     829          18 :       *lex+=2; yylloc->end = *lex; return KDE;
     830             :     case '%':
     831           6 :       if ((*lex)[2]=='=') break;
     832           6 :       *lex+=2; yylloc->end = *lex; return KMODE;
     833             :     case '!':
     834        1008 :       if ((*lex)[2]=='=') break;
     835        1008 :       *lex+=2; yylloc->end = *lex; return KNE;
     836             :     case '\\':
     837           6 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     838             :     case '+':
     839          90 :       *lex+=2; yylloc->end = *lex; return KPE;
     840             :     case '-':
     841          30 :       *lex+=2; yylloc->end = *lex; return KSE;
     842             :     }
     843    16622914 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     844             :   {
     845        3296 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     846             :   }
     847    16619618 :   if (**lex=='-' && (*lex)[1]=='>')
     848             :   {
     849         610 :     *lex+=2; yylloc->end = *lex; return KARROW;
     850             :   }
     851    16619008 :   if (**lex=='<' && (*lex)[1]=='>')
     852             :   {
     853           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     854             :   }
     855    16619008 :   if (**lex=='\\' && (*lex)[1]=='/')
     856          30 :     switch((*lex)[2])
     857             :     {
     858             :     case '=':
     859           6 :       *lex+=3; yylloc->end = *lex; return KDRE;
     860             :     default:
     861          24 :       *lex+=2; yylloc->end = *lex; return KDR;
     862             :     }
     863    16618978 :   if ((*lex)[1]==**lex)
     864     1808310 :     switch (**lex)
     865             :     {
     866             :     case '&':
     867         534 :       *lex+=2; yylloc->end = *lex; return KAND;
     868             :     case '|':
     869         216 :       *lex+=2; yylloc->end = *lex; return KOR;
     870             :     case '+':
     871          66 :       *lex+=2; yylloc->end = *lex; return KPP;
     872             :     case '-':
     873          12 :       *lex+=2; yylloc->end = *lex; return KSS;
     874             :     case '>':
     875          24 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     876          18 :       *lex+=2; yylloc->end = *lex; return KSR;
     877             :     case '<':
     878          96 :       if ((*lex)[2]=='=')
     879           6 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     880          90 :       *lex+=2; yylloc->end = *lex; return KSL;
     881             :     }
     882    16618030 :   yylloc->end = *lex+1;
     883    16618030 :   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      163746 : strntoGENstr(const char *s, long n0)
     895             : {
     896      163746 :   long n = nchar2nlong(n0+1);
     897      163746 :   GEN x = cgetg(n+1, t_STR);
     898      163746 :   char *t = GSTR(x);
     899      163746 :   strncpy(t, s, n0); t[n0] = 0; return x;
     900             : }
     901             : 
     902             : GEN
     903       83400 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     904             : 
     905             : GEN
     906          48 : chartoGENstr(char c)
     907             : {
     908          48 :   GEN x = cgetg(2, t_STR);
     909          48 :   char *t = GSTR(x);
     910          48 :   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 THREAD 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       68831 : varstate_save(struct pari_varstate *s)
     927             : {
     928       68831 :   s->nvar = nvar;
     929       68831 :   s->max_avail = max_avail;
     930       68831 :   s->max_priority = max_priority;
     931       68831 :   s->min_priority = min_priority;
     932       68831 : }
     933             : 
     934             : static void
     935        6768 : varentries_set(long v, entree *ep)
     936             : {
     937        6768 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     938        6768 :   varentries[v] = ep;
     939        6768 : }
     940             : static int
     941        2662 : _given_value(void *E, hashentry *e) { return e->val == E; }
     942             : 
     943             : static void
     944        9588 : varentries_unset(long v)
     945             : {
     946        9588 :   entree *ep = varentries[v];
     947        9588 :   if (ep)
     948             :   {
     949        2662 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     950             :         _given_value);
     951        2662 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     952        2662 :     varentries[v] = NULL;
     953        2662 :     pari_free(e);
     954        2662 :     if (v <= nvar && ep == is_entry(ep->name))
     955        2458 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     956        2458 :       GEN p = (GEN)initial_value(ep);
     957        2458 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     958        2458 :       *p = 0;
     959             :     }
     960             :     else /* from name_var() or a direct pari_var_create() */
     961         204 :       pari_free(ep);
     962             :  }
     963        9588 : }
     964             : static void
     965         276 : varentries_reset(long v, entree *ep)
     966             : {
     967         276 :   varentries_unset(v);
     968         276 :   varentries_set(v, ep);
     969         276 : }
     970             : 
     971             : static void
     972       68567 : var_restore(struct pari_varstate *s)
     973             : {
     974       68567 :   nvar = s->nvar;
     975       68567 :   max_avail = s->max_avail;
     976       68567 :   max_priority = s->max_priority;
     977       68567 :   min_priority = s->min_priority;
     978       68567 : }
     979             : 
     980             : void
     981        6818 : varstate_restore(struct pari_varstate *s)
     982             : {
     983             :   long i;
     984       16100 :   for (i = nvar; i >= s->nvar; i--)
     985             :   {
     986        9282 :     varentries_unset(i);
     987        9282 :     varpriority[i] = -i;
     988             :   }
     989        6848 :   for (i = max_avail; i < s->max_avail; i++)
     990             :   {
     991          30 :     varentries_unset(i);
     992          30 :     varpriority[i] = -i;
     993             :   }
     994        6818 :   var_restore(s);
     995        6818 : }
     996             : 
     997             : void
     998       61703 : pari_thread_init_varstate(void)
     999             : {
    1000             :   long i;
    1001       61703 :   var_restore(&global_varstate);
    1002       61312 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
    1003       63079 :   varpriority[-1] = 1-LONG_MAX;
    1004       63079 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
    1005       63079 : }
    1006             : 
    1007             : void
    1008        3945 : pari_pthread_init_varstate(void)
    1009             : {
    1010        3945 :   varstate_save(&global_varstate);
    1011        3945 :   global_varpriority = varpriority;
    1012        3945 : }
    1013             : 
    1014             : void
    1015        1224 : pari_var_close(void)
    1016             : {
    1017        1224 :   free((void*)varentries);
    1018        1224 :   free((void*)(varpriority-1));
    1019        1224 :   hash_destroy(h_polvar);
    1020        1224 : }
    1021             : 
    1022             : void
    1023        1225 : pari_var_init(void)
    1024             : {
    1025             :   long i;
    1026        1225 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
    1027        1225 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
    1028        1225 :   varpriority[-1] = 1-LONG_MAX;
    1029        1225 :   h_polvar = hash_create_str(100, 0);
    1030        1225 :   nvar = 0; max_avail = MAXVARN;
    1031        1225 :   max_priority = min_priority = 0;
    1032        1225 :   (void)fetch_user_var("x");
    1033        1225 :   (void)fetch_user_var("y");
    1034             :   /* initialize so that people can use pol_x(i) directly */
    1035        1225 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
    1036             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
    1037        1225 :   nvar = 10;
    1038        1225 :   min_priority = -MAXVARN;
    1039        1225 : }
    1040         216 : long pari_var_next(void) { return nvar; }
    1041         108 : long pari_var_next_temp(void) { return max_avail; }
    1042             : long
    1043       18078 : pari_var_create(entree *ep)
    1044             : {
    1045       18078 :   GEN p = (GEN)initial_value(ep);
    1046             :   long v;
    1047       18078 :   if (*p) return varn(p);
    1048        6492 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1049        6492 :   v = nvar++;
    1050             :   /* set p = pol_x(v) */
    1051        6492 :   p[0] = evaltyp(t_POL) | _evallg(4);
    1052        6492 :   p[1] = evalsigne(1) | evalvarn(v);
    1053        6492 :   gel(p,2) = gen_0;
    1054        6492 :   gel(p,3) = gen_1;
    1055        6492 :   varentries_set(v, ep);
    1056        6492 :   varpriority[v]= min_priority--;
    1057        6492 :   return v;
    1058             : }
    1059             : 
    1060             : long
    1061       52614 : delete_var(void)
    1062             : { /* user wants to delete one of his/her/its variables */
    1063       52614 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
    1064       52614 :   max_avail++;
    1065       52614 :   if      (varpriority[max_avail] == min_priority) min_priority++;
    1066       52614 :   else if (varpriority[max_avail] == max_priority) max_priority--;
    1067       52614 :   return max_avail+1;
    1068             : }
    1069             : long
    1070       32277 : fetch_var(void)
    1071             : {
    1072       32277 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1073       32277 :   varpriority[max_avail] = min_priority--;
    1074       32277 :   return max_avail--;
    1075             : }
    1076             : long
    1077       20391 : fetch_var_higher(void)
    1078             : {
    1079       20391 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1080       20391 :   varpriority[max_avail] = ++max_priority;
    1081       20391 :   return max_avail--;
    1082             : }
    1083             : 
    1084             : static int
    1085          42 : _higher(void *E, hashentry *e)
    1086          42 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1087             : static int
    1088          36 : _lower(void *E, hashentry *e)
    1089          36 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1090             : 
    1091             : static GEN
    1092          60 : var_register(long v, const char *s)
    1093             : {
    1094          60 :   varentries_reset(v, initep(s, strlen(s)));
    1095          60 :   return pol_x(v);
    1096             : }
    1097             : GEN
    1098          54 : varhigher(const char *s, long w)
    1099             : {
    1100             :   long v;
    1101          54 :   if (w >= 0)
    1102             :   {
    1103          36 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1104          36 :     if (e) return pol_x((long)e->val);
    1105             :   }
    1106             :   /* no luck: need to create */
    1107          42 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1108          42 :   v = nvar++;
    1109          42 :   varpriority[v]= ++max_priority;
    1110          42 :   return var_register(v, s);
    1111             : }
    1112             : GEN
    1113          24 : varlower(const char *s, long w)
    1114             : {
    1115             :   long v;
    1116          24 :   if (w >= 0)
    1117             :   {
    1118          18 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1119          18 :     if (e) return pol_x((long)e->val);
    1120             :   }
    1121             :   /* no luck: need to create */
    1122          18 :   v = fetch_var();
    1123          18 :   return var_register(v, s);
    1124             : }
    1125             : 
    1126             : long
    1127        2678 : fetch_user_var(const char *s)
    1128             : {
    1129        2678 :   entree *ep = fetch_entry(s);
    1130             :   long v;
    1131        2678 :   switch (EpVALENCE(ep))
    1132             :   {
    1133         120 :     case EpVAR: return varn((GEN)initial_value(ep));
    1134        2558 :     case EpNEW: break;
    1135           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1136             :   }
    1137        2558 :   v = pari_var_create(ep);
    1138        2558 :   ep->valence = EpVAR;
    1139        2558 :   ep->value = initial_value(ep);
    1140        2558 :   return v;
    1141             : }
    1142             : 
    1143             : GEN
    1144           6 : fetch_var_value(long v, GEN t)
    1145             : {
    1146           6 :   entree *ep = varentries[v];
    1147           6 :   if (!ep) return NULL;
    1148           6 :   if (t)
    1149             :   {
    1150           6 :     long vn = localvars_find(t,ep);
    1151           6 :     if (vn) return get_lex(vn);
    1152             :   }
    1153           6 :   return (GEN)ep->value;
    1154             : }
    1155             : 
    1156             : void
    1157         216 : name_var(long n, const char *s)
    1158             : {
    1159             :   entree *ep;
    1160             :   char *u;
    1161             : 
    1162         216 :   if (n < pari_var_next())
    1163           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1164         216 :   if (n > (long)MAXVARN)
    1165           0 :     pari_err_OVERFLOW("variable number");
    1166             : 
    1167         216 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1168         216 :   u = (char *)initial_value(ep);
    1169         216 :   ep->valence = EpVAR;
    1170         216 :   ep->name = u; strcpy(u,s);
    1171         216 :   ep->value = gen_0; /* in case geval is called */
    1172         216 :   varentries_reset(n, ep);
    1173         216 : }
    1174             : 
    1175             : static int
    1176        4308 : cmp_by_var(void *E,GEN x, GEN y)
    1177        4308 : { (void)E; return varncmp((long)x,(long)y); }
    1178             : GEN
    1179         126 : vars_sort_inplace(GEN z)
    1180         126 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1181             : GEN
    1182         126 : vars_to_RgXV(GEN h)
    1183             : {
    1184         126 :   long i, l = lg(h);
    1185         126 :   GEN z = cgetg(l, t_VEC);
    1186         126 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1187         126 :   return z;
    1188             : }
    1189             : GEN
    1190         624 : gpolvar(GEN x)
    1191             : {
    1192             :   long v;
    1193         624 :   if (!x) {
    1194         120 :     GEN h = hash_values(h_polvar);
    1195         120 :     return vars_to_RgXV(vars_sort_inplace(h));
    1196             :   }
    1197         504 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1198         498 :   v = gvar(x);
    1199         498 :   if (v==NO_VARIABLE) return gen_0;
    1200         444 :   return pol_x(v);
    1201             : }
    1202             : 
    1203             : static void
    1204     1304619 : fill_hashtable_single(entree **table, entree *ep)
    1205             : {
    1206     1304619 :   EpSETSTATIC(ep);
    1207     1304619 :   insertep(ep, table,  hashvalue(ep->name));
    1208     1304619 :   if (ep->code) ep->arity = check_proto(ep->code);
    1209     1304619 :   ep->pvalue = NULL;
    1210     1304619 : }
    1211             : 
    1212             : void
    1213        3674 : pari_fill_hashtable(entree **table, entree *ep)
    1214             : {
    1215        3674 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1216        3674 : }
    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     4786616 : do_alias(entree *ep)
    1234             : {
    1235     4786616 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1236     4786616 :   return ep;
    1237             : }
    1238             : 
    1239             : void
    1240          24 : alias0(const char *s, const char *old)
    1241             : {
    1242             :   entree *ep, *e;
    1243             :   GEN x;
    1244             : 
    1245          24 :   ep = fetch_entry(old);
    1246          24 :   e  = fetch_entry(s);
    1247          24 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1248           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1249          24 :   freeep(e);
    1250          24 :   x = newblock(2); x[0] = evaltyp(t_STR)|_evallg(2); /* for getheap */
    1251          24 :   gel(x,1) = (GEN)ep;
    1252          24 :   e->value=x; e->valence=EpALIAS;
    1253          24 : }
    1254             : 
    1255             : GEN
    1256    10971383 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1257             : {
    1258    10971383 :   if (gequal0(g)) /* false */
    1259     8514377 :     return b? closure_evalgen(b): gnil;
    1260             :   else /* true */
    1261     2457006 :     return a? closure_evalgen(a): gnil;
    1262             : }
    1263             : 
    1264             : void
    1265    14480870 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1266             : {
    1267    14480870 :   if (gequal0(g)) /* false */
    1268    14010446 :   { if (b) closure_evalvoid(b); }
    1269             :   else /* true */
    1270      470424 :   { if (a) closure_evalvoid(a); }
    1271    14480852 : }
    1272             : 
    1273             : GEN
    1274       36390 : ifpari_multi(GEN g, GEN a/*closure*/)
    1275             : {
    1276       36390 :   long i, nb = lg(a)-1;
    1277       36390 :   if (!gequal0(g)) /* false */
    1278        4818 :     return closure_evalgen(gel(a,1));
    1279       58416 :   for(i=2;i<nb;i+=2)
    1280             :   {
    1281       31656 :     GEN g = closure_evalgen(gel(a,i));
    1282       31656 :     if (!g) return g;
    1283       31650 :     if (!gequal0(g))
    1284        4806 :       return closure_evalgen(gel(a,i+1));
    1285             :   }
    1286       26760 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1287             : }
    1288             : 
    1289             : GEN
    1290      187104 : andpari(GEN a, GEN b/*closure*/)
    1291             : {
    1292             :   GEN g;
    1293      187104 :   if (gequal0(a))
    1294       11658 :     return gen_0;
    1295      175446 :   g=closure_evalgen(b);
    1296      175446 :   if (!g) return g;
    1297      175446 :   return gequal0(g)?gen_0:gen_1;
    1298             : }
    1299             : 
    1300             : GEN
    1301     2063874 : orpari(GEN a, GEN b/*closure*/)
    1302             : {
    1303             :   GEN g;
    1304     2063874 :   if (!gequal0(a))
    1305      101904 :     return gen_1;
    1306     1961970 :   g=closure_evalgen(b);
    1307     1961970 :   if (!g) return g;
    1308     1961970 :   return gequal0(g)?gen_0:gen_1;
    1309             : }
    1310             : 
    1311       68520 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1312          36 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1313           6 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1314           6 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1315           6 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1316           6 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1317           6 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1318     2034374 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1319     2712228 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addiu(*x,1):gaddgs(*x,1); return *x; }
    1320    13004178 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1321          12 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subiu(*x,1):gsubgs(*x,1); return *x; }
    1322             : 
    1323        1194 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.11