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.11.0 lcov report (development 22853-2a61d23dd) Lines: 603 655 92.1 %
Date: 2018-07-17 05:36:42 Functions: 96 101 95.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             : static int
      43         380 : IS_ID(char c) { return isalnum((int)c) || c == '_'; }
      44             : long
      45          28 : eval_mnemonic(GEN str, const char *tmplate)
      46             : {
      47             :   const char *arg, *etmplate;
      48          28 :   ulong retval = 0;
      49             : 
      50          28 :   if (typ(str)==t_INT) return itos(str);
      51          28 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      52             : 
      53          28 :   arg = GSTR(str);
      54          28 :   etmplate = strchr(tmplate, '\n');
      55          28 :   if (!etmplate) etmplate = tmplate + strlen(tmplate);
      56             : 
      57             :   while (1)
      58          36 :   {
      59             :     long numarg;
      60          64 :     const char *e, *id, *negated = NULL;
      61          64 :     int negate = 0; /* Arg has 'no' prefix removed */
      62             :     ulong l;
      63             :     char *buf;
      64             :     static char b[80];
      65             : 
      66          64 :     while (isspace((int)*arg)) arg++;
      67          64 :     if (!*arg) break;
      68          36 :     e = arg; while (IS_ID(*e)) e++;
      69             :     /* Now the ID is whatever is between arg and e. */
      70          36 :     l = e - arg;
      71          36 :     if (l >= sizeof(b)) pari_err(e_MISC,"id too long in a mnemonic");
      72          36 :     if (!l) pari_err(e_MISC,"mnemonic does not start with an id");
      73          36 :     strncpy(b, arg, l); b[l] = 0;
      74          36 :     arg = e; e = buf = b;
      75          36 :     while ('0' <= *e && *e <= '9') e++;
      76          36 :     if (*e == 0) pari_err(e_MISC,"numeric id in a mnemonic");
      77             : FIND:
      78          36 :     id = tmplate;
      79          72 :     while ((id = strstr(id, buf)) && id < etmplate)
      80             :     {
      81          36 :       const char *s = id;
      82          36 :       id += l; if (s[l] != '|') continue; /* False positive */
      83          36 :       if (s == tmplate || !IS_ID(s[-1])) break; /* Found as is */
      84             :       /* If we found "no_ID", negate */
      85           0 :       if (!negate && s >= tmplate+3 && (s == tmplate+3 || !IS_ID(s[-4]))
      86           0 :           && s[-3] == 'n' && s[-2] == 'o' && s[-1] == '_')
      87           0 :          { negated = id; break; }
      88             :     }
      89          36 :     if (!id && !negated && !negate && l > 3
      90           0 :             && buf[0] == 'n' && buf[1] == 'o' && buf[2] == '_')
      91             :     { /* Try to find the flag without the prefix "no_". */
      92           0 :       buf += 3; l -= 3; negate = 1;
      93           0 :       if (buf[0]) goto FIND;
      94             :     }
      95             :     /* Negated and AS_IS forms, prefer AS_IS otherwise use negated form */
      96          36 :     if (!id)
      97             :     {
      98           0 :       if (!negated) pari_err(e_MISC,"Unrecognized id '%s' in mnemonic", b);
      99           0 :       id = negated; negate = 1;
     100             :     }
     101          36 :     if (*id++ != '|') pari_err(e_MISC,"Missing | in mnemonic template");
     102          36 :     e = id;
     103          36 :     while (*e >= '0' && *e <= '9') e++;
     104          36 :     while (isspace((int)*e)) e++;
     105          36 :     if (*e && *e != ';' && *e != ',')
     106           0 :       pari_err(e_MISC, "Non-numeric argument in mnemonic template");
     107          36 :     numarg = atol(id);
     108          36 :     if (negate) retval &= ~numarg; else retval |= numarg;
     109          36 :     while (isspace((int)*arg)) arg++;
     110          36 :     if (*arg && !ispunct((int)*arg++)) /* skip punctuation */
     111           0 :       pari_err(e_MISC,"Junk after id in mnemonic");
     112             :   }
     113          28 :   return retval;
     114             : }
     115             : 
     116             : /********************************************************************/
     117             : /**                                                                **/
     118             : /**                   HASH TABLE MANIPULATIONS                     **/
     119             : /**                                                                **/
     120             : /********************************************************************/
     121             : /* return hashing value for identifier s */
     122             : static ulong
     123     1861665 : hashvalue(const char *s)
     124             : {
     125     1861665 :   ulong n = 0, c;
     126     1861665 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     127     1861665 :   return n;
     128             : }
     129             : 
     130             : static ulong
     131     6522812 : hashvalue_raw(const char *s, long len)
     132             : {
     133     6522812 :   long n = 0, i;
     134     6522812 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     135     6522812 :   return n;
     136             : }
     137             : 
     138             : static void
     139     1888424 : insertep(entree *ep, entree **table, ulong hash)
     140             : {
     141     1888424 :   ep->hash = hash;
     142     1888424 :   hash %= functions_tblsz;
     143     1888424 :   ep->next = table[hash];
     144     1888424 :   table[hash] = ep;
     145     1888424 : }
     146             : 
     147             : static entree *
     148       26843 : initep(const char *name, long len)
     149             : {
     150       26843 :   const long add = 4*sizeof(long);
     151       26843 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     152       26843 :   entree *ep1 = initial_value(ep);
     153       26843 :   char *u = (char *) ep1 + add;
     154       26843 :   ep->name    = u; memcpy(u, name,len); u[len]=0;
     155       26843 :   ep->valence = EpNEW;
     156       26843 :   ep->value   = NULL;
     157       26843 :   ep->menu    = 0;
     158       26843 :   ep->code    = NULL;
     159       26843 :   ep->help    = NULL;
     160       26843 :   ep->pvalue  = NULL;
     161       26843 :   ep->arity   = 0;
     162       26843 :   return ep;
     163             : }
     164             : 
     165             : /* Look for s of length len in T; if 'insert', insert if missing */
     166             : static entree *
     167     6522812 : findentry(const char *s, long len, entree **T, int insert)
     168             : {
     169     6522812 :   ulong hash = hashvalue_raw(s, len);
     170             :   entree *ep;
     171    36942490 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     172    36915689 :     if (ep->hash == hash)
     173             :     {
     174     6549789 :       const char *t = ep->name;
     175     6549789 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     176             :     }
     177             :   /* not found */
     178       26801 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     179       26801 :   return ep;
     180             : }
     181             : entree *
     182        1238 : pari_is_default(const char *s)
     183        1238 : { return findentry(s, strlen(s), defaults_hash, 0); }
     184             : entree *
     185      288775 : is_entry(const char *s)
     186      288775 : { return findentry(s, strlen(s), functions_hash, 0); }
     187             : entree *
     188     6232799 : fetch_entry_raw(const char *s, long len)
     189     6232799 : { return findentry(s, len, functions_hash, 1); }
     190             : entree *
     191      386256 : fetch_entry(const char *s) { return fetch_entry_raw(s, strlen(s)); }
     192             : 
     193             : /*******************************************************************/
     194             : /*                                                                 */
     195             : /*                  SYNTACTICAL ANALYZER FOR GP                    */
     196             : /*                                                                 */
     197             : /*******************************************************************/
     198             : GEN
     199        4767 : readseq(char *t)
     200             : {
     201        4767 :   pari_sp av = avma;
     202             :   GEN x;
     203        4767 :   if (gp_meta(t,0)) return gnil;
     204        4767 :   x = pari_compile_str(t);
     205        4767 :   return gerepileupto(av, closure_evalres(x));
     206             : }
     207             : 
     208             : /* filtered readseq = remove blanks and comments */
     209             : GEN
     210           0 : gp_read_str(const char *s)
     211             : {
     212           0 :   char *t = gp_filter(s);
     213           0 :   GEN x = readseq(t);
     214           0 :   pari_free(t); return x;
     215             : }
     216             : 
     217             : GEN
     218       10738 : compile_str(const char *s)
     219             : {
     220       10738 :   char *t = gp_filter(s);
     221       10738 :   GEN x = pari_compile_str(t);
     222       10731 :   pari_free(t); return x;
     223             : }
     224             : 
     225             : static long
     226     1844670 : check_proto(const char *code)
     227             : {
     228     1844670 :   long arity = 0;
     229     1844670 :   const char *s = code, *old;
     230     1844670 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     231     9090530 :   while (*s && *s != '\n') switch (*s++)
     232             :   {
     233             :     case '&':
     234             :     case 'C':
     235             :     case 'G':
     236             :     case 'I':
     237             :     case 'J':
     238             :     case 'U':
     239             :     case 'L':
     240             :     case 'M':
     241             :     case 'P':
     242             :     case 'W':
     243             :     case 'f':
     244             :     case 'n':
     245             :     case 'p':
     246             :     case 'b':
     247             :     case 'r':
     248     3419045 :       arity++;
     249     3419045 :       break;
     250             :     case 'E':
     251             :     case 's':
     252      117420 :       if (*s == '*') s++;
     253      117420 :       arity++;
     254      117420 :       break;
     255             :     case 'D':
     256      934695 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     257      427935 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     258             :       {
     259      540750 :         if (*s != 'V') arity++;
     260      540750 :         s++; break;
     261             :       }
     262      393945 :       old = s; while (*s && *s != ',') s++;
     263      393945 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     264      393945 :       break;
     265             :     case 'V':
     266             :     case '=':
     267      930030 :     case ',': break;
     268           0 :     case '\n': break; /* Before the mnemonic */
     269             : 
     270             :     case 'm':
     271             :     case 'l':
     272             :     case 'i':
     273           0 :     case 'v': pari_err(e_SYNTAX, "this code has to come first", s-1, code);
     274           0 :     default: pari_err(e_SYNTAX, "unknown parser code", s-1, code);
     275             :   }
     276     1844670 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     277     1844670 :   return arity;
     278             : }
     279             : static void
     280           0 : check_name(const char *name)
     281             : {
     282           0 :   const char *s = name;
     283           0 :   if (isalpha((int)*s))
     284           0 :     while (is_keyword_char(*++s)) /* empty */;
     285           0 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     286           0 : }
     287             : 
     288             : entree *
     289           0 : install(void *f, const char *name, const char *code)
     290             : {
     291           0 :   long arity = check_proto(code);
     292             :   entree *ep;
     293             : 
     294           0 :   check_name(name);
     295           0 :   ep = fetch_entry(name);
     296           0 :   if (ep->valence != EpNEW)
     297             :   {
     298           0 :     if (ep->valence != EpINSTALL)
     299           0 :       pari_err(e_MISC,"[install] identifier '%s' already in use", name);
     300           0 :     pari_warn(warner, "[install] updating '%s' prototype; module not reloaded", name);
     301           0 :     if (ep->code) pari_free((void*)ep->code);
     302             :   }
     303             :   else
     304             :   {
     305           0 :     ep->value = f;
     306           0 :     ep->valence = EpINSTALL;
     307             :   }
     308           0 :   ep->code = pari_strdup(code);
     309           0 :   ep->arity = arity; return ep;
     310             : }
     311             : 
     312             : static void
     313          14 : killep(entree *ep)
     314             : {
     315          14 :   GEN p = (GEN)initial_value(ep);
     316          14 :   freeep(ep);
     317          14 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     318          14 :   ep->valence = EpNEW;
     319          14 :   ep->value   = NULL;
     320          14 :   ep->pvalue  = NULL;
     321          14 : }
     322             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     323             : void
     324          14 : kill0(const char *e)
     325             : {
     326          14 :   entree *ep = is_entry(e);
     327          14 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     328          14 :   killep(ep);
     329          14 : }
     330             : 
     331             : void
     332          42 : addhelp(const char *e, char *s)
     333             : {
     334          42 :   entree *ep = fetch_entry(e);
     335          42 :   void *f = (void *) ep->help;
     336          42 :   ep->help = pari_strdup(s);
     337          42 :   if (f && !EpSTATIC(ep)) pari_free(f);
     338          42 : }
     339             : 
     340             : GEN
     341       23520 : type0(GEN x)
     342             : {
     343       23520 :   const char *s = type_name(typ(x));
     344       23520 :   return strtoGENstr(s);
     345             : }
     346             : 
     347             : /*******************************************************************/
     348             : /*                                                                 */
     349             : /*                              PARSER                             */
     350             : /*                                                                 */
     351             : /*******************************************************************/
     352             : 
     353             : #ifdef LONG_IS_64BIT
     354             : static const long MAX_DIGITS  = 19;
     355             : #else
     356             : static const long MAX_DIGITS  = 9;
     357             : #endif
     358             : 
     359             : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     360             : static const long MAX_BDIGITS = BITS_IN_LONG;
     361             : 
     362             : static int
     363    35394043 : ishex(const char **s)
     364             : {
     365    35394043 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     366             :   {
     367          49 :     *s += 2;
     368          49 :     return 1;
     369             :   }
     370             :   else
     371    35393994 :     return 0;
     372             : }
     373             : 
     374             : static int
     375    35394092 : isbin(const char **s)
     376             : {
     377    35394092 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     378             :   {
     379          49 :     *s += 2;
     380          49 :     return 1;
     381             :   }
     382             :   else
     383    35394043 :     return 0;
     384             : }
     385             : 
     386             : static ulong
     387          38 : bin_number_len(const char *s, long n)
     388             : {
     389          38 :   ulong m = 0;
     390             :   long i;
     391        1494 :   for (i = 0; i < n; i++,s++)
     392        1456 :     m = 2*m + (*s - '0');
     393          38 :   return m;
     394             : }
     395             : 
     396             : static int
     397        1484 : pari_isbdigit(int c)
     398             : {
     399        1484 :   return c=='0' || c=='1';
     400             : }
     401             : 
     402             : static ulong
     403          54 : hex_number_len(const char *s, long n)
     404             : {
     405          54 :   ulong m = 0;
     406             :   long i;
     407         593 :   for(i = 0; i < n; i++, s++)
     408             :   {
     409             :     ulong c;
     410         539 :     if( *s >= '0' && *s <= '9')
     411         455 :       c = *s - '0';
     412          84 :     else if( *s >= 'A' && *s <= 'F')
     413          84 :       c = *s - 'A' + 10;
     414             :     else
     415           0 :       c = *s - 'a' + 10;
     416         539 :     m = 16*m + c;
     417             :   }
     418          54 :   return m;
     419             : }
     420             : 
     421             : static GEN
     422          56 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     423             : {
     424          56 :   long i, l = (n+B-1)/B;
     425             :   GEN N, Np;
     426          56 :   N = cgetipos(l+2);
     427          56 :   Np = int_LSW(N);
     428          92 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     429          36 :     uel(Np, 0) = num(s+n-i*B, B);
     430          56 :   uel(Np, 0) = num(s, n-(i-1)*B);
     431          56 :   return int_normalize(N, 0);
     432             : }
     433             : 
     434             : static GEN
     435          56 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     436             : {
     437          56 :   const char *s = *ps;
     438          56 :   while (is((int)**ps)) (*ps)++;
     439          56 :   return strtobin_len(s, *ps-s, B, num);
     440             : }
     441             : 
     442             : static GEN
     443          28 : bin_read(const char **ps)
     444             : {
     445          28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     446             : }
     447             : 
     448             : static GEN
     449          28 : hex_read(const char **ps)
     450             : {
     451          28 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     452             : }
     453             : 
     454             : static ulong
     455     3473543 : dec_number_len(const char *s, long B)
     456             : {
     457     3473543 :   ulong m = 0;
     458             :   long n;
     459    52777330 :   for (n = 0; n < B; n++,s++)
     460    49303787 :     m = 10*m + (*s - '0');
     461     3473543 :   return m;
     462             : }
     463             : 
     464             : static GEN
     465      922829 : dec_strtoi_len(const char *s, long n)
     466             : {
     467      922829 :   const long B = MAX_DIGITS;
     468      922829 :   long i, l = (n+B-1)/B;
     469      922829 :   GEN V = cgetg(l+1, t_VECSMALL);
     470     3473543 :   for (i=1; i<l; i++)
     471     2550714 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     472      922829 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     473      922829 :   return fromdigitsu(V, powuu(10, B));
     474             : }
     475             : 
     476             : static GEN
     477      922829 : dec_read_more(const char **ps)
     478             : {
     479      922829 :   pari_sp av = avma;
     480      922829 :   const char *s = *ps;
     481      922829 :   while (isdigit((int)**ps)) (*ps)++;
     482      922829 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     483             : }
     484             : 
     485             : static ulong
     486     7971075 : number(int *n, const char **s)
     487             : {
     488     7971075 :   ulong m = 0;
     489    40312526 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     490    32341451 :     m = 10*m + (**s - '0');
     491     7971075 :   return m;
     492             : }
     493             : 
     494             : static GEN
     495     7895524 : dec_read(const char **s)
     496             : {
     497             :   int nb;
     498     7895524 :   ulong y  = number(&nb, s);
     499     7895524 :   if (nb < MAX_DIGITS)
     500     6972695 :     return utoi(y);
     501      922829 :   *s -= MAX_DIGITS;
     502      922829 :   return dec_read_more(s);
     503             : }
     504             : 
     505             : static GEN
     506        1985 : real_read_more(GEN y, const char **ps)
     507             : {
     508        1985 :   pari_sp av = avma;
     509        1985 :   const char *s = *ps;
     510        1985 :   GEN z = dec_read(ps);
     511        1985 :   long e = *ps-s;
     512        1985 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     513             : }
     514             : 
     515             : static long
     516       75551 : exponent(const char **pts)
     517             : {
     518       75551 :   const char *s = *pts;
     519             :   long n;
     520             :   int nb;
     521       75551 :   switch(*++s)
     522             :   {
     523       75418 :     case '-': s++; n = -(long)number(&nb, &s); break;
     524           0 :     case '+': s++; /* Fall through */
     525         133 :     default: n = (long)number(&nb, &s);
     526             :   }
     527       75551 :   *pts = s; return n;
     528             : }
     529             : 
     530             : static GEN
     531         175 : real_0_digits(long n) {
     532         175 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     533         175 :   return real_0_bit(b);
     534             : }
     535             : 
     536             : static GEN
     537       83134 : real_read(pari_sp av, const char **s, GEN y, long prec)
     538             : {
     539       83134 :   long l, n = 0;
     540       83134 :   switch(**s)
     541             :   {
     542           0 :     default: return y; /* integer */
     543             :     case '.':
     544             :     {
     545        8801 :       const char *old = ++*s;
     546        8801 :       if (isalpha((int)**s) || **s=='.')
     547             :       {
     548        1211 :         if (**s == 'E' || **s == 'e') {
     549        1211 :           n = exponent(s);
     550        1211 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     551        1183 :           break;
     552             :         }
     553           0 :         --*s; return y; /* member */
     554             :       }
     555        7590 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     556        7590 :       n = old - *s;
     557        7590 :       if (**s != 'E' && **s != 'e')
     558             :       {
     559        7583 :         if (!signe(y)) { avma = av; return real_0(prec); }
     560        6624 :         break;
     561             :       }
     562             :     }
     563             :     /* Fall through */
     564             :     case 'E': case 'e':
     565       74340 :       n += exponent(s);
     566       74340 :       if (!signe(y)) { avma = av; return real_0_digits(n); }
     567             :   }
     568       82000 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     569       82000 :   if (l < prec) l = prec; else prec = l;
     570       82000 :   if (!n) return itor(y, prec);
     571       76647 :   incrprec(l);
     572       76647 :   y = itor(y, l);
     573       76647 :   if (n > 0)
     574          56 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     575             :   else
     576       76591 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     577       76647 :   return gerepileuptoleaf(av, rtor(y, prec));
     578             : }
     579             : 
     580             : static GEN
     581     7810461 : int_read(const char **s)
     582             : {
     583             :   GEN y;
     584     7810461 :   if (isbin(s))
     585          28 :     y = bin_read(s);
     586     7810433 :   else if (ishex(s))
     587          28 :     y = hex_read(s);
     588             :   else
     589     7810405 :     y = dec_read(s);
     590     7810461 :   return y;
     591             : }
     592             : 
     593             : GEN
     594     7810461 : strtoi(const char *s) { return int_read(&s); }
     595             : 
     596             : GEN
     597       83134 : strtor(const char *s, long prec)
     598             : {
     599       83134 :   pari_sp av = avma;
     600       83134 :   GEN y = dec_read(&s);
     601       83134 :   y = real_read(av, &s, y, prec);
     602       83134 :   if (typ(y) == t_REAL) return y;
     603           0 :   return gerepileuptoleaf(av, itor(y, prec));
     604             : }
     605             : 
     606             : static void
     607     7691222 : skipdigits(char **lex) {
     608     7691222 :   while (isdigit((int)**lex)) ++*lex;
     609     7691222 : }
     610             : 
     611             : static int
     612     7687736 : skipexponent(char **lex)
     613             : {
     614     7687736 :   char *old=*lex;
     615     7687736 :   if ((**lex=='e' || **lex=='E'))
     616             :   {
     617        1015 :     ++*lex;
     618        1015 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     619        1015 :     if (!isdigit((int)**lex))
     620             :     {
     621         469 :       *lex=old;
     622         469 :       return KINTEGER;
     623             :     }
     624         546 :     skipdigits(lex);
     625         546 :     return KREAL;
     626             :   }
     627     7686721 :   return KINTEGER;
     628             : }
     629             : 
     630             : static int
     631     7688621 : skipconstante(char **lex)
     632             : {
     633     7688621 :   skipdigits(lex);
     634     7688621 :   if (**lex=='.')
     635             :   {
     636       14126 :     char *old = ++*lex;
     637       14126 :     if (**lex == '.') { --*lex; return KINTEGER; }
     638       13241 :     if (isalpha((int)**lex))
     639             :     {
     640       11186 :       skipexponent(lex);
     641       11186 :       if (*lex == old)
     642             :       {
     643       11151 :         --*lex; /* member */
     644       11151 :         return KINTEGER;
     645             :       }
     646          35 :       return KREAL;
     647             :     }
     648        2055 :     skipdigits(lex);
     649        2055 :     skipexponent(lex);
     650        2055 :     return KREAL;
     651             :   }
     652     7674495 :   return skipexponent(lex);
     653             : }
     654             : 
     655             : static void
     656     1107963 : skipstring(char **lex)
     657             : {
     658     9005039 :   while (**lex)
     659             :   {
     660     7897076 :     while (**lex == '\\') *lex+=2;
     661     7897076 :     if (**lex == '"')
     662             :     {
     663     1107963 :       if ((*lex)[1] != '"') break;
     664           0 :       *lex += 2; continue;
     665             :     }
     666     6789113 :     (*lex)++;
     667             :   }
     668     1107963 : }
     669             : 
     670             : int
     671    29191644 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     672             : {
     673             :   (void) yylval;
     674    29191644 :   yylloc->start=*lex;
     675    29191644 :   if (!**lex)
     676             :   {
     677       94258 :     yylloc->end=*lex;
     678       94258 :     return 0;
     679             :   }
     680    29097386 :   if (isalpha((int)**lex))
     681             :   {
     682      393721 :     while (is_keyword_char(**lex)) ++*lex;
     683      393721 :     yylloc->end=*lex;
     684      393721 :     return KENTRY;
     685             :   }
     686    28703665 :   if (**lex=='"')
     687             :   {
     688     1107963 :     ++*lex;
     689     1107963 :     skipstring(lex);
     690     1107963 :     if (!**lex)
     691           0 :       compile_err("run-away string",*lex-1);
     692     1107963 :     ++*lex;
     693     1107963 :     yylloc->end=*lex;
     694     1107963 :     return KSTRING;
     695             :   }
     696    27595702 :   if (**lex == '.')
     697             :   {
     698             :     int token;
     699       12071 :     if ((*lex)[1]== '.')
     700             :     {
     701         913 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     702             :     }
     703       11158 :     token=skipconstante(lex);
     704       11158 :     if (token==KREAL)
     705             :     {
     706           7 :       yylloc->end = *lex;
     707           7 :       return token;
     708             :     }
     709       11151 :     ++*lex;
     710       11151 :     yylloc->end=*lex;
     711       11151 :     return '.';
     712             :   }
     713    27583631 :   if (isbin((const char**)lex))
     714             :   {
     715          21 :     while (**lex=='0' || **lex=='1') ++*lex;
     716          21 :     return KINTEGER;
     717             :   }
     718    27583610 :   if (ishex((const char**)lex))
     719             :   {
     720          21 :     while (isxdigit((int)**lex)) ++*lex;
     721          21 :     return KINTEGER;
     722             :   }
     723    27583589 :   if (isdigit((int)**lex))
     724             :   {
     725     7677463 :     int token=skipconstante(lex);
     726     7677463 :     yylloc->end = *lex;
     727     7677463 :     return token;
     728             :   }
     729    19906126 :   if ((*lex)[1]=='=')
     730       21256 :     switch (**lex)
     731             :     {
     732             :     case '=':
     733        8364 :       if ((*lex)[2]=='=')
     734         343 :       { *lex+=3; yylloc->end = *lex; return KID; }
     735             :       else
     736        8021 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     737             :     case '>':
     738          65 :       *lex+=2; yylloc->end = *lex; return KGE;
     739             :     case '<':
     740         163 :       *lex+=2; yylloc->end = *lex; return KLE;
     741             :     case '*':
     742         142 :       *lex+=2; yylloc->end = *lex; return KME;
     743             :     case '/':
     744          35 :       *lex+=2; yylloc->end = *lex; return KDE;
     745             :     case '%':
     746           7 :       if ((*lex)[2]=='=') break;
     747           7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     748             :     case '!':
     749        1666 :       if ((*lex)[2]=='=') break;
     750        1666 :       *lex+=2; yylloc->end = *lex; return KNE;
     751             :     case '\\':
     752           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     753             :     case '+':
     754         145 :       *lex+=2; yylloc->end = *lex; return KPE;
     755             :     case '-':
     756          49 :       *lex+=2; yylloc->end = *lex; return KSE;
     757             :     }
     758    19895483 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     759             :   {
     760        3887 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     761             :   }
     762    19891596 :   if (**lex=='-' && (*lex)[1]=='>')
     763             :   {
     764         914 :     *lex+=2; yylloc->end = *lex; return KARROW;
     765             :   }
     766    19890682 :   if (**lex=='<' && (*lex)[1]=='>')
     767             :   {
     768           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     769             :   }
     770    19890682 :   if (**lex=='\\' && (*lex)[1]=='/')
     771          35 :     switch((*lex)[2])
     772             :     {
     773             :     case '=':
     774           7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     775             :     default:
     776          28 :       *lex+=2; yylloc->end = *lex; return KDR;
     777             :     }
     778    19890647 :   if ((*lex)[1]==**lex)
     779     2117004 :     switch (**lex)
     780             :     {
     781             :     case '&':
     782         658 :       *lex+=2; yylloc->end = *lex; return KAND;
     783             :     case '|':
     784         287 :       *lex+=2; yylloc->end = *lex; return KOR;
     785             :     case '+':
     786         119 :       *lex+=2; yylloc->end = *lex; return KPP;
     787             :     case '-':
     788          14 :       *lex+=2; yylloc->end = *lex; return KSS;
     789             :     case '>':
     790          28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     791          21 :       *lex+=2; yylloc->end = *lex; return KSR;
     792             :     case '<':
     793         112 :       if ((*lex)[2]=='=')
     794           7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     795         105 :       *lex+=2; yylloc->end = *lex; return KSL;
     796             :     }
     797    19889429 :   yylloc->end = *lex+1;
     798    19889429 :   return (unsigned char) *(*lex)++;
     799             : }
     800             : 
     801             : /********************************************************************/
     802             : /**                                                                **/
     803             : /**                            STRINGS                             **/
     804             : /**                                                                **/
     805             : /********************************************************************/
     806             : 
     807             : /* return the first n0 chars of s as a GEN [s may not be 0-terminated] */
     808             : GEN
     809      463421 : strntoGENstr(const char *s, long n0)
     810             : {
     811      463421 :   long n = nchar2nlong(n0+1);
     812      463421 :   GEN x = cgetg(n+1, t_STR);
     813      463421 :   char *t = GSTR(x);
     814      463421 :   x[n] = 0;
     815      463421 :   strncpy(t, s, n0); t[n0] = 0; return x;
     816             : }
     817             : 
     818             : GEN
     819      350162 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     820             : 
     821             : GEN
     822      342045 : chartoGENstr(char c)
     823             : {
     824      342045 :   GEN x = cgetg(2, t_STR);
     825      342045 :   char *t = GSTR(x);
     826      342045 :   t[0] = c; t[1] = 0; return x;
     827             : }
     828             : 
     829             : /********************************************************************/
     830             : /*                                                                  */
     831             : /*                Formal variables management                       */
     832             : /*                                                                  */
     833             : /********************************************************************/
     834             : static THREAD long max_priority, min_priority;
     835             : static THREAD long max_avail; /* max variable not yet used */
     836             : static THREAD long nvar; /* first GP free variable */
     837             : static hashtable *h_polvar;
     838             : static struct pari_varstate global_varstate;
     839             : static long *global_varpriority;
     840             : 
     841             : void
     842      105861 : varstate_save(struct pari_varstate *s)
     843             : {
     844      105861 :   s->nvar = nvar;
     845      105861 :   s->max_avail = max_avail;
     846      105861 :   s->max_priority = max_priority;
     847      105861 :   s->min_priority = min_priority;
     848      105861 : }
     849             : 
     850             : static void
     851        8417 : varentries_set(long v, entree *ep)
     852             : {
     853        8417 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     854        8417 :   varentries[v] = ep;
     855        8417 : }
     856             : static int
     857        3143 : _given_value(void *E, hashentry *e) { return e->val == E; }
     858             : 
     859             : static void
     860       12081 : varentries_unset(long v)
     861             : {
     862       12081 :   entree *ep = varentries[v];
     863       12081 :   if (ep)
     864             :   {
     865        3143 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     866             :         _given_value);
     867        3143 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     868        3143 :     varentries[v] = NULL;
     869        3143 :     pari_free(e);
     870        3143 :     if (v <= nvar && ep == is_entry(ep->name))
     871        2905 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     872        2905 :       GEN p = (GEN)initial_value(ep);
     873        2905 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     874        2905 :       *p = 0;
     875             :     }
     876             :     else /* from name_var() or a direct pari_var_create() */
     877         238 :       pari_free(ep);
     878             :  }
     879       12081 : }
     880             : static void
     881         336 : varentries_reset(long v, entree *ep)
     882             : {
     883         336 :   varentries_unset(v);
     884         336 :   varentries_set(v, ep);
     885         336 : }
     886             : 
     887             : static void
     888      119501 : var_restore(struct pari_varstate *s)
     889             : {
     890      119501 :   nvar = s->nvar;
     891      119501 :   max_avail = s->max_avail;
     892      119501 :   max_priority = s->max_priority;
     893      119501 :   min_priority = s->min_priority;
     894      119501 : }
     895             : 
     896             : void
     897        8819 : varstate_restore(struct pari_varstate *s)
     898             : {
     899             :   long i;
     900       20550 :   for (i = nvar; i >= s->nvar; i--)
     901             :   {
     902       11731 :     varentries_unset(i);
     903       11731 :     varpriority[i] = -i;
     904             :   }
     905        8833 :   for (i = max_avail+1; i <= s->max_avail; i++)
     906             :   {
     907          14 :     varentries_unset(i);
     908          14 :     varpriority[i] = -i;
     909             :   }
     910        8819 :   var_restore(s);
     911        8819 : }
     912             : 
     913             : void
     914      110702 : pari_thread_init_varstate(void)
     915             : {
     916             :   long i;
     917      110702 :   var_restore(&global_varstate);
     918      110580 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
     919      111358 :   varpriority[-1] = 1-LONG_MAX;
     920      111358 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
     921      111358 : }
     922             : 
     923             : void
     924       11066 : pari_pthread_init_varstate(void)
     925             : {
     926       11066 :   varstate_save(&global_varstate);
     927       11066 :   global_varpriority = varpriority;
     928       11066 : }
     929             : 
     930             : void
     931        1595 : pari_var_close(void)
     932             : {
     933        1595 :   free((void*)varentries);
     934        1595 :   free((void*)(varpriority-1));
     935        1595 :   hash_destroy(h_polvar);
     936        1595 : }
     937             : 
     938             : void
     939        1545 : pari_var_init(void)
     940             : {
     941             :   long i;
     942        1545 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     943        1545 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     944        1545 :   varpriority[-1] = 1-LONG_MAX;
     945        1545 :   h_polvar = hash_create_str(100, 0);
     946        1545 :   nvar = 0; max_avail = MAXVARN;
     947        1545 :   max_priority = min_priority = 0;
     948        1545 :   (void)fetch_user_var("x");
     949        1545 :   (void)fetch_user_var("y");
     950             :   /* initialize so that people can use pol_x(i) directly */
     951        1545 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     952             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     953        1545 :   nvar = 10;
     954        1545 :   min_priority = -MAXVARN;
     955        1545 : }
     956         252 : long pari_var_next(void) { return nvar; }
     957           0 : long pari_var_next_temp(void) { return max_avail; }
     958             : long
     959       28598 : pari_var_create(entree *ep)
     960             : {
     961       28598 :   GEN p = (GEN)initial_value(ep);
     962             :   long v;
     963       28598 :   if (*p) return varn(p);
     964        8081 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     965        8081 :   v = nvar++;
     966             :   /* set p = pol_x(v) */
     967        8081 :   p[0] = evaltyp(t_POL) | _evallg(4);
     968        8081 :   p[1] = evalsigne(1) | evalvarn(v);
     969        8081 :   gel(p,2) = gen_0;
     970        8081 :   gel(p,3) = gen_1;
     971        8081 :   varentries_set(v, ep);
     972        8081 :   varpriority[v]= min_priority--;
     973        8081 :   return v;
     974             : }
     975             : 
     976             : long
     977       75454 : delete_var(void)
     978             : { /* user wants to delete one of his/her/its variables */
     979       75454 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     980       75454 :   max_avail++;
     981       75454 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     982       75454 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     983       75454 :   return max_avail+1;
     984             : }
     985             : long
     986       44095 : fetch_var(void)
     987             : {
     988       44095 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     989       44095 :   varpriority[max_avail] = min_priority--;
     990       44095 :   return max_avail--;
     991             : }
     992             : long
     993       34836 : fetch_var_higher(void)
     994             : {
     995       34836 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     996       34837 :   varpriority[max_avail] = ++max_priority;
     997       34837 :   return max_avail--;
     998             : }
     999             : 
    1000             : static int
    1001          49 : _higher(void *E, hashentry *e)
    1002          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1003             : static int
    1004          42 : _lower(void *E, hashentry *e)
    1005          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1006             : 
    1007             : static GEN
    1008          84 : var_register(long v, const char *s)
    1009             : {
    1010          84 :   varentries_reset(v, initep(s, strlen(s)));
    1011          84 :   return pol_x(v);
    1012             : }
    1013             : GEN
    1014          77 : varhigher(const char *s, long w)
    1015             : {
    1016             :   long v;
    1017          77 :   if (w >= 0)
    1018             :   {
    1019          49 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1020          49 :     if (e) return pol_x((long)e->val);
    1021             :   }
    1022             :   /* no luck: need to create */
    1023          63 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1024          63 :   v = nvar++;
    1025          63 :   varpriority[v]= ++max_priority;
    1026          63 :   return var_register(v, s);
    1027             : }
    1028             : GEN
    1029          28 : varlower(const char *s, long w)
    1030             : {
    1031             :   long v;
    1032          28 :   if (w >= 0)
    1033             :   {
    1034          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1035          21 :     if (e) return pol_x((long)e->val);
    1036             :   }
    1037             :   /* no luck: need to create */
    1038          21 :   v = fetch_var();
    1039          21 :   return var_register(v, s);
    1040             : }
    1041             : 
    1042             : long
    1043      386158 : fetch_user_var(const char *s)
    1044             : {
    1045      386158 :   entree *ep = fetch_entry(s);
    1046             :   long v;
    1047      386158 :   switch (EpVALENCE(ep))
    1048             :   {
    1049      382921 :     case EpVAR: return varn((GEN)initial_value(ep));
    1050        3237 :     case EpNEW: break;
    1051           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1052             :   }
    1053        3237 :   v = pari_var_create(ep);
    1054        3237 :   ep->valence = EpVAR;
    1055        3237 :   ep->value = initial_value(ep);
    1056        3237 :   return v;
    1057             : }
    1058             : 
    1059             : GEN
    1060           7 : fetch_var_value(long v, GEN t)
    1061             : {
    1062           7 :   entree *ep = varentries[v];
    1063           7 :   if (!ep) return NULL;
    1064           7 :   if (t)
    1065             :   {
    1066           7 :     long vn = localvars_find(t,ep);
    1067           7 :     if (vn) return get_lex(vn);
    1068             :   }
    1069           7 :   return (GEN)ep->value;
    1070             : }
    1071             : 
    1072             : void
    1073         252 : name_var(long n, const char *s)
    1074             : {
    1075             :   entree *ep;
    1076             :   char *u;
    1077             : 
    1078         252 :   if (n < pari_var_next())
    1079           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1080         252 :   if (n > (long)MAXVARN)
    1081           0 :     pari_err_OVERFLOW("variable number");
    1082             : 
    1083         252 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1084         252 :   u = (char *)initial_value(ep);
    1085         252 :   ep->valence = EpVAR;
    1086         252 :   ep->name = u; strcpy(u,s);
    1087         252 :   ep->value = gen_0; /* in case geval is called */
    1088         252 :   varentries_reset(n, ep);
    1089         252 : }
    1090             : 
    1091             : static int
    1092        5136 : cmp_by_var(void *E,GEN x, GEN y)
    1093        5136 : { (void)E; return varncmp((long)x,(long)y); }
    1094             : GEN
    1095         994 : vars_sort_inplace(GEN z)
    1096         994 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1097             : GEN
    1098         154 : vars_to_RgXV(GEN h)
    1099             : {
    1100         154 :   long i, l = lg(h);
    1101         154 :   GEN z = cgetg(l, t_VEC);
    1102         154 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1103         154 :   return z;
    1104             : }
    1105             : GEN
    1106         987 : gpolvar(GEN x)
    1107             : {
    1108             :   long v;
    1109         987 :   if (!x) {
    1110         140 :     GEN h = hash_values(h_polvar);
    1111         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1112             :   }
    1113         847 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1114         840 :   v = gvar(x);
    1115         840 :   if (v==NO_VARIABLE) return gen_0;
    1116         777 :   return pol_x(v);
    1117             : }
    1118             : 
    1119             : static void
    1120     1861665 : fill_hashtable_single(entree **table, entree *ep)
    1121             : {
    1122     1861665 :   EpSETSTATIC(ep);
    1123     1861665 :   insertep(ep, table,  hashvalue(ep->name));
    1124     1861665 :   if (ep->code) ep->arity = check_proto(ep->code);
    1125     1861665 :   ep->pvalue = NULL;
    1126     1861665 : }
    1127             : 
    1128             : void
    1129        4625 : pari_fill_hashtable(entree **table, entree *ep)
    1130             : {
    1131        4625 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1132        4625 : }
    1133             : 
    1134             : void
    1135           0 : pari_add_function(entree *ep)
    1136             : {
    1137           0 :   fill_hashtable_single(functions_hash, ep);
    1138           0 : }
    1139             : 
    1140             : /********************************************************************/
    1141             : /**                                                                **/
    1142             : /**                        SIMPLE GP FUNCTIONS                     **/
    1143             : /**                                                                **/
    1144             : /********************************************************************/
    1145             : 
    1146             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1147             : 
    1148             : entree *
    1149     6115585 : do_alias(entree *ep)
    1150             : {
    1151     6115585 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1152     6115585 :   return ep;
    1153             : }
    1154             : 
    1155             : void
    1156          28 : alias0(const char *s, const char *old)
    1157             : {
    1158             :   entree *ep, *e;
    1159             :   GEN x;
    1160             : 
    1161          28 :   ep = fetch_entry(old);
    1162          28 :   e  = fetch_entry(s);
    1163          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1164           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1165          28 :   freeep(e);
    1166          28 :   x = cgetg_block(2, t_VECSMALL); gel(x,1) = (GEN)ep;
    1167          28 :   e->value=x; e->valence=EpALIAS;
    1168          28 : }
    1169             : 
    1170             : GEN
    1171    12855413 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1172             : {
    1173    12855413 :   if (gequal0(g)) /* false */
    1174     9962354 :     return b? closure_evalgen(b): gnil;
    1175             :   else /* true */
    1176     2893059 :     return a? closure_evalgen(a): gnil;
    1177             : }
    1178             : 
    1179             : void
    1180    39975660 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1181             : {
    1182    39975660 :   if (gequal0(g)) /* false */
    1183    39270948 :   { if (b) closure_evalvoid(b); }
    1184             :   else /* true */
    1185      704712 :   { if (a) closure_evalvoid(a); }
    1186    39975639 : }
    1187             : 
    1188             : GEN
    1189       31283 : ifpari_multi(GEN g, GEN a/*closure*/)
    1190             : {
    1191       31283 :   long i, nb = lg(a)-1;
    1192       31283 :   if (!gequal0(g)) /* false */
    1193        6706 :     return closure_evalgen(gel(a,1));
    1194       42042 :   for(i=2;i<nb;i+=2)
    1195             :   {
    1196       24689 :     GEN g = closure_evalgen(gel(a,i));
    1197       24689 :     if (!g) return g;
    1198       24682 :     if (!gequal0(g))
    1199        7217 :       return closure_evalgen(gel(a,i+1));
    1200             :   }
    1201       17353 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1202             : }
    1203             : 
    1204             : GEN
    1205      268744 : andpari(GEN a, GEN b/*closure*/)
    1206             : {
    1207             :   GEN g;
    1208      268744 :   if (gequal0(a))
    1209       42714 :     return gen_0;
    1210      226030 :   g=closure_evalgen(b);
    1211      226030 :   if (!g) return g;
    1212      226030 :   return gequal0(g)?gen_0:gen_1;
    1213             : }
    1214             : 
    1215             : GEN
    1216    16420103 : orpari(GEN a, GEN b/*closure*/)
    1217             : {
    1218             :   GEN g;
    1219    16420103 :   if (!gequal0(a))
    1220      118887 :     return gen_1;
    1221    16301216 :   g=closure_evalgen(b);
    1222    16301216 :   if (!g) return g;
    1223    16301216 :   return gequal0(g)?gen_0:gen_1;
    1224             : }
    1225             : 
    1226       79933 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1227          56 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1228           7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1229           7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1230           7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1231           7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1232           7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1233     2648566 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1234    25675244 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addiu(*x,1):gaddgs(*x,1); return *x; }
    1235    15455356 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1236          14 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subiu(*x,1):gsubgs(*x,1); return *x; }
    1237             : 
    1238        1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.13