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 22307-7f6745a) Lines: 618 655 94.4 %
Date: 2018-04-22 06:16:17 Functions: 98 101 97.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             :   {
      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          36 :   }
     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     1880754 : hashvalue(const char *s)
     124             : {
     125     1880754 :   ulong n = 0, c;
     126     1880754 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     127     1880754 :   return n;
     128             : }
     129             : 
     130             : static ulong
     131     6471947 : hashvalue_raw(const char *s, long len)
     132             : {
     133     6471947 :   long n = 0, i;
     134     6471947 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     135     6471947 :   return n;
     136             : }
     137             : 
     138             : static void
     139     1907284 : insertep(entree *ep, entree **table, ulong hash)
     140             : {
     141     1907284 :   ep->hash = hash;
     142     1907284 :   hash %= functions_tblsz;
     143     1907284 :   ep->next = table[hash];
     144     1907284 :   table[hash] = ep;
     145     1907284 : }
     146             : 
     147             : static entree *
     148       26614 : initep(const char *name, long len)
     149             : {
     150       26614 :   const long add = 4*sizeof(long);
     151       26614 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     152       26614 :   entree *ep1 = initial_value(ep);
     153       26614 :   char *u = (char *) ep1 + add;
     154       26614 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     155       26614 :   ep->valence = EpNEW;
     156       26614 :   ep->value   = NULL;
     157       26614 :   ep->menu    = 0;
     158       26614 :   ep->code    = NULL;
     159       26614 :   ep->help    = NULL;
     160       26614 :   ep->pvalue  = NULL;
     161       26614 :   ep->arity   = 0;
     162       26614 :   return ep;
     163             : }
     164             : 
     165             : /* Look for s of length len in T; if 'insert', insert if missing */
     166             : static entree *
     167     6471947 : findentry(const char *s, long len, entree **T, int insert)
     168             : {
     169     6471947 :   ulong hash = hashvalue_raw(s, len);
     170             :   entree *ep;
     171    36627129 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     172    36600549 :     if (ep->hash == hash)
     173             :     {
     174     6491791 :       const char *t = ep->name;
     175     6491791 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     176             :     }
     177             :   /* not found */
     178       26580 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     179       26580 :   return ep;
     180             : }
     181             : entree *
     182        1226 : pari_is_default(const char *s)
     183        1226 : { return findentry(s, strlen(s), defaults_hash, 0); }
     184             : entree *
     185      279117 : is_entry(const char *s)
     186      279117 : { return findentry(s, strlen(s), functions_hash, 0); }
     187             : entree *
     188     6191604 : fetch_entry_raw(const char *s, long len)
     189     6191604 : { return findentry(s, len, functions_hash, 1); }
     190             : entree *
     191      385244 : 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        4709 : readseq(char *t)
     200             : {
     201        4709 :   pari_sp av = avma;
     202             :   GEN x;
     203        4709 :   if (gp_meta(t,0)) return gnil;
     204        4709 :   x = pari_compile_str(t);
     205        4709 :   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       10782 : compile_str(const char *s)
     219             : {
     220       10782 :   char *t = gp_filter(s);
     221       10782 :   GEN x = pari_compile_str(t);
     222       10775 :   pari_free(t); return x;
     223             : }
     224             : 
     225             : static long
     226     1863536 : check_proto(const char *code)
     227             : {
     228     1863536 :   long arity = 0;
     229     1863536 :   const char *s = code, *old;
     230     1863536 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     231     9139170 :   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     3446774 :       arity++;
     249     3446774 :       break;
     250             :     case 'E':
     251             :     case 's':
     252      119016 :       if (*s == '*') s++;
     253      119016 :       arity++;
     254      119016 :       break;
     255             :     case 'D':
     256      925504 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     257      422818 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     258             :       {
     259      537138 :         if (*s != 'V') arity++;
     260      537138 :         s++; break;
     261             :       }
     262      388366 :       old = s; while (*s && *s != ',') s++;
     263      388366 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     264      388366 :       break;
     265             :     case 'V':
     266             :     case '=':
     267      920804 :     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     1863536 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     277     1863536 :   return arity;
     278             : }
     279             : static void
     280           8 : check_name(const char *name)
     281             : {
     282           8 :   const char *s = name;
     283           8 :   if (isalpha((int)*s))
     284           8 :     while (is_keyword_char(*++s)) /* empty */;
     285           8 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     286           8 : }
     287             : 
     288             : entree *
     289           8 : install(void *f, const char *name, const char *code)
     290             : {
     291           8 :   long arity = check_proto(code);
     292             :   entree *ep;
     293             : 
     294           8 :   check_name(name);
     295           8 :   ep = fetch_entry(name);
     296           8 :   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           8 :     ep->value = f;
     306           8 :     ep->valence = EpINSTALL;
     307             :   }
     308           8 :   ep->code = pari_strdup(code);
     309           8 :   ep->arity = arity; return ep;
     310             : }
     311             : 
     312             : static void
     313          18 : killep(entree *ep)
     314             : {
     315          18 :   GEN p = (GEN)initial_value(ep);
     316          18 :   freeep(ep);
     317          18 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     318          18 :   ep->valence = EpNEW;
     319          18 :   ep->value   = NULL;
     320          18 :   ep->pvalue  = NULL;
     321          18 : }
     322             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     323             : void
     324          18 : kill0(const char *e)
     325             : {
     326          18 :   entree *ep = is_entry(e);
     327          18 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     328          18 :   killep(ep);
     329          18 : }
     330             : 
     331             : void
     332          50 : addhelp(const char *e, char *s)
     333             : {
     334          50 :   entree *ep = fetch_entry(e);
     335          50 :   void *f = (void *) ep->help;
     336          50 :   ep->help = pari_strdup(s);
     337          50 :   if (f && !EpSTATIC(ep)) pari_free(f);
     338          50 : }
     339             : 
     340             : GEN
     341       23479 : type0(GEN x)
     342             : {
     343       23479 :   const char *s = type_name(typ(x));
     344       23479 :   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    35405084 : ishex(const char **s)
     364             : {
     365    35405084 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     366             :   {
     367          49 :     *s += 2;
     368          49 :     return 1;
     369             :   }
     370             :   else
     371    35405035 :     return 0;
     372             : }
     373             : 
     374             : static int
     375    35405133 : isbin(const char **s)
     376             : {
     377    35405133 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     378             :   {
     379          49 :     *s += 2;
     380          49 :     return 1;
     381             :   }
     382             :   else
     383    35405084 :     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     3656875 : dec_number_len(const char *s, long B)
     456             : {
     457     3656875 :   ulong m = 0;
     458             :   long n;
     459    55492082 :   for (n = 0; n < B; n++,s++)
     460    51835207 :     m = 10*m + (*s - '0');
     461     3656875 :   return m;
     462             : }
     463             : 
     464             : static GEN
     465     1003415 : dec_strtoi_len(const char *s, long n)
     466             : {
     467     1003415 :   const long B = MAX_DIGITS;
     468     1003415 :   long i, l = (n+B-1)/B;
     469     1003415 :   GEN V = cgetg(l+1, t_VECSMALL);
     470     3656875 :   for (i=1; i<l; i++)
     471     2653460 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     472     1003415 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     473     1003415 :   return fromdigitsu(V, powuu(10, B));
     474             : }
     475             : 
     476             : static GEN
     477     1003415 : dec_read_more(const char **ps)
     478             : {
     479     1003415 :   pari_sp av = avma;
     480     1003415 :   const char *s = *ps;
     481     1003415 :   while (isdigit((int)**ps)) (*ps)++;
     482     1003415 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     483             : }
     484             : 
     485             : static ulong
     486     8038112 : number(int *n, const char **s)
     487             : {
     488     8038112 :   ulong m = 0;
     489    41893860 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     490    33855748 :     m = 10*m + (**s - '0');
     491     8038112 :   return m;
     492             : }
     493             : 
     494             : static GEN
     495     7962561 : dec_read(const char **s)
     496             : {
     497             :   int nb;
     498     7962561 :   ulong y  = number(&nb, s);
     499     7962561 :   if (nb < MAX_DIGITS)
     500     6959146 :     return utoi(y);
     501     1003415 :   *s -= MAX_DIGITS;
     502     1003415 :   return dec_read_more(s);
     503             : }
     504             : 
     505             : static GEN
     506        1964 : real_read_more(GEN y, const char **ps)
     507             : {
     508        1964 :   pari_sp av = avma;
     509        1964 :   const char *s = *ps;
     510        1964 :   GEN z = dec_read(ps);
     511        1964 :   long e = *ps-s;
     512        1964 :   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       82966 : real_read(pari_sp av, const char **s, GEN y, long prec)
     538             : {
     539       82966 :   long l, n = 0;
     540       82966 :   switch(**s)
     541             :   {
     542           0 :     default: return y; /* integer */
     543             :     case '.':
     544             :     {
     545        8633 :       const char *old = ++*s;
     546        8633 :       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        7422 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     556        7422 :       n = old - *s;
     557        7422 :       if (**s != 'E' && **s != 'e')
     558             :       {
     559        7415 :         if (!signe(y)) { avma = av; return real_0(prec); }
     560        6456 :         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       81832 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     569       81832 :   if (l < prec) l = prec; else prec = l;
     570       81832 :   if (!n) return itor(y, prec);
     571       76626 :   incrprec(l);
     572       76626 :   y = itor(y, l);
     573       76626 :   if (n > 0)
     574          56 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     575             :   else
     576       76570 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     577       76626 :   return gerepileuptoleaf(av, rtor(y, prec));
     578             : }
     579             : 
     580             : static GEN
     581     7877687 : int_read(const char **s)
     582             : {
     583             :   GEN y;
     584     7877687 :   if (isbin(s))
     585          28 :     y = bin_read(s);
     586     7877659 :   else if (ishex(s))
     587          28 :     y = hex_read(s);
     588             :   else
     589     7877631 :     y = dec_read(s);
     590     7877687 :   return y;
     591             : }
     592             : 
     593             : GEN
     594     7877687 : strtoi(const char *s) { return int_read(&s); }
     595             : 
     596             : GEN
     597       82966 : strtor(const char *s, long prec)
     598             : {
     599       82966 :   pari_sp av = avma;
     600       82966 :   GEN y = dec_read(&s);
     601       82966 :   y = real_read(av, &s, y, prec);
     602       82966 :   if (typ(y) == t_REAL) return y;
     603           0 :   return gerepileuptoleaf(av, itor(y, prec));
     604             : }
     605             : 
     606             : static void
     607     7677642 : skipdigits(char **lex) {
     608     7677642 :   while (isdigit((int)**lex)) ++*lex;
     609     7677642 : }
     610             : 
     611             : static int
     612     7674248 : skipexponent(char **lex)
     613             : {
     614     7674248 :   char *old=*lex;
     615     7674248 :   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     7673233 :   return KINTEGER;
     628             : }
     629             : 
     630             : static int
     631     7675083 : skipconstante(char **lex)
     632             : {
     633     7675083 :   skipdigits(lex);
     634     7675083 :   if (**lex=='.')
     635             :   {
     636       13950 :     char *old = ++*lex;
     637       13950 :     if (**lex == '.') { --*lex; return KINTEGER; }
     638       13115 :     if (isalpha((int)**lex))
     639             :     {
     640       11102 :       skipexponent(lex);
     641       11102 :       if (*lex == old)
     642             :       {
     643       11067 :         --*lex; /* member */
     644       11067 :         return KINTEGER;
     645             :       }
     646          35 :       return KREAL;
     647             :     }
     648        2013 :     skipdigits(lex);
     649        2013 :     skipexponent(lex);
     650        2013 :     return KREAL;
     651             :   }
     652     7661133 :   return skipexponent(lex);
     653             : }
     654             : 
     655             : static void
     656     1107711 : skipstring(char **lex)
     657             : {
     658     9001321 :   while (**lex)
     659             :   {
     660     7893610 :     while (**lex == '\\') *lex+=2;
     661     7893610 :     if (**lex == '"')
     662             :     {
     663     1107711 :       if ((*lex)[1] != '"') break;
     664           0 :       *lex += 2; continue;
     665             :     }
     666     6785899 :     (*lex)++;
     667             :   }
     668     1107711 : }
     669             : 
     670             : int
     671    29112579 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     672             : {
     673             :   (void) yylval;
     674    29112579 :   yylloc->start=*lex;
     675    29112579 :   if (!**lex)
     676             :   {
     677       90422 :     yylloc->end=*lex;
     678       90422 :     return 0;
     679             :   }
     680    29022157 :   if (isalpha((int)**lex))
     681             :   {
     682      375063 :     while (is_keyword_char(**lex)) ++*lex;
     683      375063 :     yylloc->end=*lex;
     684      375063 :     return KENTRY;
     685             :   }
     686    28647094 :   if (**lex=='"')
     687             :   {
     688     1107711 :     ++*lex;
     689     1107711 :     skipstring(lex);
     690     1107711 :     if (!**lex)
     691           0 :       compile_err("run-away string",*lex-1);
     692     1107711 :     ++*lex;
     693     1107711 :     yylloc->end=*lex;
     694     1107711 :     return KSTRING;
     695             :   }
     696    27539383 :   if (**lex == '.')
     697             :   {
     698             :     int token;
     699       11937 :     if ((*lex)[1]== '.')
     700             :     {
     701         863 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     702             :     }
     703       11074 :     token=skipconstante(lex);
     704       11074 :     if (token==KREAL)
     705             :     {
     706           7 :       yylloc->end = *lex;
     707           7 :       return token;
     708             :     }
     709       11067 :     ++*lex;
     710       11067 :     yylloc->end=*lex;
     711       11067 :     return '.';
     712             :   }
     713    27527446 :   if (isbin((const char**)lex))
     714             :   {
     715          21 :     while (**lex=='0' || **lex=='1') ++*lex;
     716          21 :     return KINTEGER;
     717             :   }
     718    27527425 :   if (ishex((const char**)lex))
     719             :   {
     720          21 :     while (isxdigit((int)**lex)) ++*lex;
     721          21 :     return KINTEGER;
     722             :   }
     723    27527404 :   if (isdigit((int)**lex))
     724             :   {
     725     7664009 :     int token=skipconstante(lex);
     726     7664009 :     yylloc->end = *lex;
     727     7664009 :     return token;
     728             :   }
     729    19863395 :   if ((*lex)[1]=='=')
     730       19214 :     switch (**lex)
     731             :     {
     732             :     case '=':
     733        7176 :       if ((*lex)[2]=='=')
     734         343 :       { *lex+=3; yylloc->end = *lex; return KID; }
     735             :       else
     736        6833 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     737             :     case '>':
     738          69 :       *lex+=2; yylloc->end = *lex; return KGE;
     739             :     case '<':
     740         167 :       *lex+=2; yylloc->end = *lex; return KLE;
     741             :     case '*':
     742         146 :       *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        1659 :       if ((*lex)[2]=='=') break;
     750        1659 :       *lex+=2; yylloc->end = *lex; return KNE;
     751             :     case '\\':
     752           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     753             :     case '+':
     754         169 :       *lex+=2; yylloc->end = *lex; return KPE;
     755             :     case '-':
     756          49 :       *lex+=2; yylloc->end = *lex; return KSE;
     757             :     }
     758    19853911 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     759             :   {
     760        3891 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     761             :   }
     762    19850020 :   if (**lex=='-' && (*lex)[1]=='>')
     763             :   {
     764         873 :     *lex+=2; yylloc->end = *lex; return KARROW;
     765             :   }
     766    19849147 :   if (**lex=='<' && (*lex)[1]=='>')
     767             :   {
     768           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     769             :   }
     770    19849147 :   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    19849112 :   if ((*lex)[1]==**lex)
     779     2115554 :     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         127 :       *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    19847886 :   yylloc->end = *lex+1;
     798    19847886 :   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      451088 : strntoGENstr(const char *s, long n0)
     810             : {
     811      451088 :   long n = nchar2nlong(n0+1);
     812      451088 :   GEN x = cgetg(n+1, t_STR);
     813      451088 :   char *t = GSTR(x);
     814      451088 :   x[n] = 0;
     815      451088 :   strncpy(t, s, n0); t[n0] = 0; return x;
     816             : }
     817             : 
     818             : GEN
     819      341685 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     820             : 
     821             : GEN
     822      342087 : chartoGENstr(char c)
     823             : {
     824      342087 :   GEN x = cgetg(2, t_STR);
     825      342087 :   char *t = GSTR(x);
     826      342087 :   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      100987 : varstate_save(struct pari_varstate *s)
     843             : {
     844      100987 :   s->nvar = nvar;
     845      100987 :   s->max_avail = max_avail;
     846      100987 :   s->max_priority = max_priority;
     847      100987 :   s->min_priority = min_priority;
     848      100987 : }
     849             : 
     850             : static void
     851        8424 : varentries_set(long v, entree *ep)
     852             : {
     853        8424 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     854        8424 :   varentries[v] = ep;
     855        8424 : }
     856             : static int
     857        3143 : _given_value(void *E, hashentry *e) { return e->val == E; }
     858             : 
     859             : static void
     860       11876 : varentries_unset(long v)
     861             : {
     862       11876 :   entree *ep = varentries[v];
     863       11876 :   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       11876 : }
     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       95058 : var_restore(struct pari_varstate *s)
     889             : {
     890       95058 :   nvar = s->nvar;
     891       95058 :   max_avail = s->max_avail;
     892       95058 :   max_priority = s->max_priority;
     893       95058 :   min_priority = s->min_priority;
     894       95058 : }
     895             : 
     896             : void
     897        8621 : varstate_restore(struct pari_varstate *s)
     898             : {
     899             :   long i;
     900       20154 :   for (i = nvar; i >= s->nvar; i--)
     901             :   {
     902       11533 :     varentries_unset(i);
     903       11533 :     varpriority[i] = -i;
     904             :   }
     905        8628 :   for (i = max_avail+1; i <= s->max_avail; i++)
     906             :   {
     907           7 :     varentries_unset(i);
     908           7 :     varpriority[i] = -i;
     909             :   }
     910        8621 :   var_restore(s);
     911        8621 : }
     912             : 
     913             : void
     914       87191 : pari_thread_init_varstate(void)
     915             : {
     916             :   long i;
     917       87191 :   var_restore(&global_varstate);
     918       85965 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
     919       89167 :   varpriority[-1] = 1-LONG_MAX;
     920       89167 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
     921       89167 : }
     922             : 
     923             : void
     924       10493 : pari_pthread_init_varstate(void)
     925             : {
     926       10493 :   varstate_save(&global_varstate);
     927       10493 :   global_varpriority = varpriority;
     928       10493 : }
     929             : 
     930             : void
     931        1564 : pari_var_close(void)
     932             : {
     933        1564 :   free((void*)varentries);
     934        1564 :   free((void*)(varpriority-1));
     935        1564 :   hash_destroy(h_polvar);
     936        1564 : }
     937             : 
     938             : void
     939        1566 : pari_var_init(void)
     940             : {
     941             :   long i;
     942        1566 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     943        1566 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     944        1566 :   varpriority[-1] = 1-LONG_MAX;
     945        1566 :   h_polvar = hash_create_str(100, 0);
     946        1566 :   nvar = 0; max_avail = MAXVARN;
     947        1566 :   max_priority = min_priority = 0;
     948        1566 :   (void)fetch_user_var("x");
     949        1566 :   (void)fetch_user_var("y");
     950             :   /* initialize so that people can use pol_x(i) directly */
     951        1566 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     952             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     953        1566 :   nvar = 10;
     954        1566 :   min_priority = -MAXVARN;
     955        1566 : }
     956         260 : long pari_var_next(void) { return nvar; }
     957           0 : long pari_var_next_temp(void) { return max_avail; }
     958             : long
     959       28175 : pari_var_create(entree *ep)
     960             : {
     961       28175 :   GEN p = (GEN)initial_value(ep);
     962             :   long v;
     963       28175 :   if (*p) return varn(p);
     964        8088 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     965        8088 :   v = nvar++;
     966             :   /* set p = pol_x(v) */
     967        8088 :   p[0] = evaltyp(t_POL) | _evallg(4);
     968        8088 :   p[1] = evalsigne(1) | evalvarn(v);
     969        8088 :   gel(p,2) = gen_0;
     970        8088 :   gel(p,3) = gen_1;
     971        8088 :   varentries_set(v, ep);
     972        8088 :   varpriority[v]= min_priority--;
     973        8088 :   return v;
     974             : }
     975             : 
     976             : long
     977       73649 : delete_var(void)
     978             : { /* user wants to delete one of his/her/its variables */
     979       73649 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     980       73649 :   max_avail++;
     981       73649 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     982       73649 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     983       73649 :   return max_avail+1;
     984             : }
     985             : long
     986       43558 : fetch_var(void)
     987             : {
     988       43558 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     989       43558 :   varpriority[max_avail] = min_priority--;
     990       43558 :   return max_avail--;
     991             : }
     992             : long
     993       33563 : fetch_var_higher(void)
     994             : {
     995       33563 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     996       33563 :   varpriority[max_avail] = ++max_priority;
     997       33563 :   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      385130 : fetch_user_var(const char *s)
    1044             : {
    1045      385130 :   entree *ep = fetch_entry(s);
    1046             :   long v;
    1047      385130 :   switch (EpVALENCE(ep))
    1048             :   {
    1049      381851 :     case EpVAR: return varn((GEN)initial_value(ep));
    1050        3279 :     case EpNEW: break;
    1051           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1052             :   }
    1053        3279 :   v = pari_var_create(ep);
    1054        3279 :   ep->valence = EpVAR;
    1055        3279 :   ep->value = initial_value(ep);
    1056        3279 :   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         868 : vars_sort_inplace(GEN z)
    1096         868 : { 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     1880754 : fill_hashtable_single(entree **table, entree *ep)
    1121             : {
    1122     1880754 :   EpSETSTATIC(ep);
    1123     1880754 :   insertep(ep, table,  hashvalue(ep->name));
    1124     1880754 :   if (ep->code) ep->arity = check_proto(ep->code);
    1125     1880754 :   ep->pvalue = NULL;
    1126     1880754 : }
    1127             : 
    1128             : void
    1129        4696 : pari_fill_hashtable(entree **table, entree *ep)
    1130             : {
    1131        4696 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1132        4696 : }
    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     6065632 : do_alias(entree *ep)
    1150             : {
    1151     6065632 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1152     6065632 :   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    12854816 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1172             : {
    1173    12854816 :   if (gequal0(g)) /* false */
    1174     9962065 :     return b? closure_evalgen(b): gnil;
    1175             :   else /* true */
    1176     2892752 :     return a? closure_evalgen(a): gnil;
    1177             : }
    1178             : 
    1179             : void
    1180    39975987 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1181             : {
    1182    39975987 :   if (gequal0(g)) /* false */
    1183    39271261 :   { if (b) closure_evalvoid(b); }
    1184             :   else /* true */
    1185      704726 :   { if (a) closure_evalvoid(a); }
    1186    39975966 : }
    1187             : 
    1188             : GEN
    1189       31276 : ifpari_multi(GEN g, GEN a/*closure*/)
    1190             : {
    1191       31276 :   long i, nb = lg(a)-1;
    1192       31276 :   if (!gequal0(g)) /* false */
    1193        6706 :     return closure_evalgen(gel(a,1));
    1194       42035 :   for(i=2;i<nb;i+=2)
    1195             :   {
    1196       24682 :     GEN g = closure_evalgen(gel(a,i));
    1197       24682 :     if (!g) return g;
    1198       24675 :     if (!gequal0(g))
    1199        7210 :       return closure_evalgen(gel(a,i+1));
    1200             :   }
    1201       17353 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1202             : }
    1203             : 
    1204             : GEN
    1205      268618 : andpari(GEN a, GEN b/*closure*/)
    1206             : {
    1207             :   GEN g;
    1208      268618 :   if (gequal0(a))
    1209       42602 :     return gen_0;
    1210      226016 :   g=closure_evalgen(b);
    1211      226016 :   if (!g) return g;
    1212      226016 :   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       80010 : 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     2648794 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1234    25675332 : 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.11