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 21947-4fc3047) Lines: 619 655 94.5 %
Date: 2018-02-24 06:16:21 Functions: 99 101 98.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : #include "anal.h"
      17             : #include "parse.h"
      18             : 
      19             : /***************************************************************************
      20             :  **                                                                       **
      21             :  **                           Mnemonic codes parser                       **
      22             :  **                                                                       **
      23             :  ***************************************************************************/
      24             : 
      25             : /* TEMPLATE is assumed to be ";"-separated list of items.  Each item
      26             :  * may have one of the following forms: id=value id==value id|value id&~value.
      27             :  * Each id consists of alphanum characters, dashes and underscores.
      28             :  * IDs are case-sensitive.
      29             : 
      30             :  * ARG consists of several IDs separated by punctuation (and optional
      31             :  * whitespace).  Each modifies the return value in a "natural" way: an
      32             :  * ID from id=value should be the first in the sequence and sets RETVAL to
      33             :  * VALUE (and cannot be negated), ID from id|value bit-ORs RETVAL with
      34             :  * VALUE (and bit-ANDs RETVAL with ~VALUE if negated), ID from
      35             :  * id&~value behaves as if it were noid|value, ID from
      36             :  * id==value behaves the same as id=value, but should come alone.
      37             : 
      38             :  * For items of the form id|value and id&~value negated forms are
      39             :  * allowed: either when arg looks like no[-_]id, or when id looks like
      40             :  * this, and arg is not-negated. */
      41             : 
      42             : 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     1853639 : hashvalue(const char *s)
     124             : {
     125     1853639 :   ulong n = 0, c;
     126     1853639 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     127     1853639 :   return n;
     128             : }
     129             : 
     130             : static ulong
     131     6292942 : hashvalue_raw(const char *s, long len)
     132             : {
     133     6292942 :   long n = 0, i;
     134     6292942 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     135     6292942 :   return n;
     136             : }
     137             : 
     138             : static void
     139     1879786 : insertep(entree *ep, entree **table, ulong hash)
     140             : {
     141     1879786 :   ep->hash = hash;
     142     1879786 :   hash %= functions_tblsz;
     143     1879786 :   ep->next = table[hash];
     144     1879786 :   table[hash] = ep;
     145     1879786 : }
     146             : 
     147             : static entree *
     148       26231 : initep(const char *name, long len)
     149             : {
     150       26231 :   const long add = 4*sizeof(long);
     151       26231 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     152       26231 :   entree *ep1 = initial_value(ep);
     153       26231 :   char *u = (char *) ep1 + add;
     154       26231 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     155       26231 :   ep->valence = EpNEW;
     156       26231 :   ep->value   = NULL;
     157       26231 :   ep->menu    = 0;
     158       26231 :   ep->code    = NULL;
     159       26231 :   ep->help    = NULL;
     160       26231 :   ep->pvalue  = NULL;
     161       26231 :   ep->arity   = 0;
     162       26231 :   return ep;
     163             : }
     164             : 
     165             : /* Look for s of length len in T; if 'insert', insert if missing */
     166             : static entree *
     167     6292942 : findentry(const char *s, long len, entree **T, int insert)
     168             : {
     169     6292942 :   ulong hash = hashvalue_raw(s, len);
     170             :   entree *ep;
     171    35555065 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     172    35528868 :     if (ep->hash == hash)
     173             :     {
     174     6312850 :       const char *t = ep->name;
     175     6312850 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     176             :     }
     177             :   /* not found */
     178       26197 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     179       26197 :   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      279199 : is_entry(const char *s)
     186      279199 : { return findentry(s, strlen(s), functions_hash, 0); }
     187             : entree *
     188     6012517 : fetch_entry_raw(const char *s, long len)
     189     6012517 : { return findentry(s, len, functions_hash, 1); }
     190             : entree *
     191      384411 : 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        4394 : readseq(char *t)
     200             : {
     201        4394 :   pari_sp av = avma;
     202             :   GEN x;
     203        4394 :   if (gp_meta(t,0)) return gnil;
     204        4394 :   x = pari_compile_str(t);
     205        4394 :   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     1836498 : check_proto(const char *code)
     227             : {
     228     1836498 :   long arity = 0;
     229     1836498 :   const char *s = code, *old;
     230     1836498 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
     231     9025045 :   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     3420454 :       arity++;
     249     3420454 :       break;
     250             :     case 'E':
     251             :     case 's':
     252      110689 :       if (*s == '*') s++;
     253      110689 :       arity++;
     254      110689 :       break;
     255             :     case 'D':
     256      907336 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
     257      420928 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
     258             :       {
     259      520706 :         if (*s != 'V') arity++;
     260      520706 :         s++; break;
     261             :       }
     262      386630 :       old = s; while (*s && *s != ',') s++;
     263      386630 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     264      386630 :       break;
     265             :     case 'V':
     266             :     case '=':
     267      913570 :     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     1836498 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     277     1836498 :   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       23472 : type0(GEN x)
     342             : {
     343       23472 :   const char *s = type_name(typ(x));
     344       23472 :   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    34723717 : ishex(const char **s)
     364             : {
     365    34723717 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     366             :   {
     367          49 :     *s += 2;
     368          49 :     return 1;
     369             :   }
     370             :   else
     371    34723668 :     return 0;
     372             : }
     373             : 
     374             : static int
     375    34723766 : isbin(const char **s)
     376             : {
     377    34723766 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     378             :   {
     379          49 :     *s += 2;
     380          49 :     return 1;
     381             :   }
     382             :   else
     383    34723717 :     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     3061052 : dec_number_len(const char *s, long B)
     456             : {
     457     3061052 :   ulong m = 0;
     458             :   long n;
     459    46154829 :   for (n = 0; n < B; n++,s++)
     460    43093777 :     m = 10*m + (*s - '0');
     461     3061052 :   return m;
     462             : }
     463             : 
     464             : static GEN
     465      868050 : dec_strtoi_len(const char *s, long n)
     466             : {
     467      868050 :   const long B = MAX_DIGITS;
     468      868050 :   long i, l = (n+B-1)/B;
     469      868050 :   GEN V = cgetg(l+1, t_VECSMALL);
     470     3061052 :   for (i=1; i<l; i++)
     471     2193002 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     472      868050 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     473      868050 :   return fromdigitsu(V, powuu(10, B));
     474             : }
     475             : 
     476             : static GEN
     477      868050 : dec_read_more(const char **ps)
     478             : {
     479      868050 :   pari_sp av = avma;
     480      868050 :   const char *s = *ps;
     481      868050 :   while (isdigit((int)**ps)) (*ps)++;
     482      868050 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     483             : }
     484             : 
     485             : static ulong
     486     7884222 : number(int *n, const char **s)
     487             : {
     488     7884222 :   ulong m = 0;
     489    39312032 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     490    31427810 :     m = 10*m + (**s - '0');
     491     7884222 :   return m;
     492             : }
     493             : 
     494             : static GEN
     495     7808678 : dec_read(const char **s)
     496             : {
     497             :   int nb;
     498     7808678 :   ulong y  = number(&nb, s);
     499     7808678 :   if (nb < MAX_DIGITS)
     500     6940628 :     return utoi(y);
     501      868050 :   *s -= MAX_DIGITS;
     502      868050 :   return dec_read_more(s);
     503             : }
     504             : 
     505             : static GEN
     506        1943 : real_read_more(GEN y, const char **ps)
     507             : {
     508        1943 :   pari_sp av = avma;
     509        1943 :   const char *s = *ps;
     510        1943 :   GEN z = dec_read(ps);
     511        1943 :   long e = *ps-s;
     512        1943 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     513             : }
     514             : 
     515             : static long
     516       75544 : exponent(const char **pts)
     517             : {
     518       75544 :   const char *s = *pts;
     519             :   long n;
     520             :   int nb;
     521       75544 :   switch(*++s)
     522             :   {
     523       75411 :     case '-': s++; n = -(long)number(&nb, &s); break;
     524           0 :     case '+': s++; /* Fall through */
     525         133 :     default: n = (long)number(&nb, &s);
     526             :   }
     527       75544 :   *pts = s; return n;
     528             : }
     529             : 
     530             : static GEN
     531         168 : real_0_digits(long n) {
     532         168 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     533         168 :   return real_0_bit(b);
     534             : }
     535             : 
     536             : static GEN
     537       82917 : real_read(pari_sp av, const char **s, GEN y, long prec)
     538             : {
     539       82917 :   long l, n = 0;
     540       82917 :   switch(**s)
     541             :   {
     542           0 :     default: return y; /* integer */
     543             :     case '.':
     544             :     {
     545        8584 :       const char *old = ++*s;
     546        8584 :       if (isalpha((int)**s) || **s=='.')
     547             :       {
     548        1204 :         if (**s == 'E' || **s == 'e') {
     549        1204 :           n = exponent(s);
     550        1204 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     551        1183 :           break;
     552             :         }
     553           0 :         --*s; return y; /* member */
     554             :       }
     555        7380 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     556        7380 :       n = old - *s;
     557        7380 :       if (**s != 'E' && **s != 'e')
     558             :       {
     559        7373 :         if (!signe(y)) { avma = av; return real_0(prec); }
     560        6421 :         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       81797 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     569       81797 :   if (l < prec) l = prec; else prec = l;
     570       81797 :   if (!n) return itor(y, prec);
     571       76605 :   incrprec(l);
     572       76605 :   y = itor(y, l);
     573       76605 :   if (n > 0)
     574          56 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     575             :   else
     576       76549 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     577       76605 :   return gerepileuptoleaf(av, rtor(y, prec));
     578             : }
     579             : 
     580             : static GEN
     581     7723874 : int_read(const char **s)
     582             : {
     583             :   GEN y;
     584     7723874 :   if (isbin(s))
     585          28 :     y = bin_read(s);
     586     7723846 :   else if (ishex(s))
     587          28 :     y = hex_read(s);
     588             :   else
     589     7723818 :     y = dec_read(s);
     590     7723874 :   return y;
     591             : }
     592             : 
     593             : GEN
     594     7723874 : strtoi(const char *s) { return int_read(&s); }
     595             : 
     596             : GEN
     597       82917 : strtor(const char *s, long prec)
     598             : {
     599       82917 :   pari_sp av = avma;
     600       82917 :   GEN y = dec_read(&s);
     601       82917 :   y = real_read(av, &s, y, prec);
     602       82917 :   if (typ(y) == t_REAL) return y;
     603           0 :   return gerepileuptoleaf(av, itor(y, prec));
     604             : }
     605             : 
     606             : static void
     607     7490387 : skipdigits(char **lex) {
     608     7490387 :   while (isdigit((int)**lex)) ++*lex;
     609     7490387 : }
     610             : 
     611             : static int
     612     7487042 : skipexponent(char **lex)
     613             : {
     614     7487042 :   char *old=*lex;
     615     7487042 :   if ((**lex=='e' || **lex=='E'))
     616             :   {
     617        1008 :     ++*lex;
     618        1008 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     619        1008 :     if (!isdigit((int)**lex))
     620             :     {
     621         469 :       *lex=old;
     622         469 :       return KINTEGER;
     623             :     }
     624         539 :     skipdigits(lex);
     625         539 :     return KREAL;
     626             :   }
     627     7486034 :   return KINTEGER;
     628             : }
     629             : 
     630             : static int
     631     7487877 : skipconstante(char **lex)
     632             : {
     633     7487877 :   skipdigits(lex);
     634     7487877 :   if (**lex=='.')
     635             :   {
     636       13866 :     char *old = ++*lex;
     637       13866 :     if (**lex == '.') { --*lex; return KINTEGER; }
     638       13031 :     if (isalpha((int)**lex))
     639             :     {
     640       11060 :       skipexponent(lex);
     641       11060 :       if (*lex == old)
     642             :       {
     643       11032 :         --*lex; /* member */
     644       11032 :         return KINTEGER;
     645             :       }
     646          28 :       return KREAL;
     647             :     }
     648        1971 :     skipdigits(lex);
     649        1971 :     skipexponent(lex);
     650        1971 :     return KREAL;
     651             :   }
     652     7474011 :   return skipexponent(lex);
     653             : }
     654             : 
     655             : static void
     656     1107281 : skipstring(char **lex)
     657             : {
     658     8999342 :   while (**lex)
     659             :   {
     660     7892061 :     while (**lex == '\\') *lex+=2;
     661     7892061 :     if (**lex == '"')
     662             :     {
     663     1107281 :       if ((*lex)[1] != '"') break;
     664           0 :       *lex += 2; continue;
     665             :     }
     666     6784780 :     (*lex)++;
     667             :   }
     668     1107281 : }
     669             : 
     670             : int
     671    28575737 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     672             : {
     673             :   (void) yylval;
     674    28575737 :   yylloc->start=*lex;
     675    28575737 :   if (!**lex)
     676             :   {
     677       88766 :     yylloc->end=*lex;
     678       88766 :     return 0;
     679             :   }
     680    28486971 :   if (isalpha((int)**lex))
     681             :   {
     682      367903 :     while (is_keyword_char(**lex)) ++*lex;
     683      367903 :     yylloc->end=*lex;
     684      367903 :     return KENTRY;
     685             :   }
     686    28119068 :   if (**lex=='"')
     687             :   {
     688     1107281 :     ++*lex;
     689     1107281 :     skipstring(lex);
     690     1107281 :     if (!**lex)
     691           0 :       compile_err("run-away string",*lex-1);
     692     1107281 :     ++*lex;
     693     1107281 :     yylloc->end=*lex;
     694     1107281 :     return KSTRING;
     695             :   }
     696    27011787 :   if (**lex == '.')
     697             :   {
     698             :     int token;
     699       11895 :     if ((*lex)[1]== '.')
     700             :     {
     701         856 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     702             :     }
     703       11039 :     token=skipconstante(lex);
     704       11039 :     if (token==KREAL)
     705             :     {
     706           7 :       yylloc->end = *lex;
     707           7 :       return token;
     708             :     }
     709       11032 :     ++*lex;
     710       11032 :     yylloc->end=*lex;
     711       11032 :     return '.';
     712             :   }
     713    26999892 :   if (isbin((const char**)lex))
     714             :   {
     715          21 :     while (**lex=='0' || **lex=='1') ++*lex;
     716          21 :     return KINTEGER;
     717             :   }
     718    26999871 :   if (ishex((const char**)lex))
     719             :   {
     720          21 :     while (isxdigit((int)**lex)) ++*lex;
     721          21 :     return KINTEGER;
     722             :   }
     723    26999850 :   if (isdigit((int)**lex))
     724             :   {
     725     7476838 :     int token=skipconstante(lex);
     726     7476838 :     yylloc->end = *lex;
     727     7476838 :     return token;
     728             :   }
     729    19523012 :   if ((*lex)[1]=='=')
     730       18983 :     switch (**lex)
     731             :     {
     732             :     case '=':
     733        7120 :       if ((*lex)[2]=='=')
     734         329 :       { *lex+=3; yylloc->end = *lex; return KID; }
     735             :       else
     736        6791 :       { *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        1645 :       if ((*lex)[2]=='=') break;
     750        1645 :       *lex+=2; yylloc->end = *lex; return KNE;
     751             :     case '\\':
     752           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     753             :     case '+':
     754         127 :       *lex+=2; yylloc->end = *lex; return KPE;
     755             :     case '-':
     756          35 :       *lex+=2; yylloc->end = *lex; return KSE;
     757             :     }
     758    19513654 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     759             :   {
     760        3891 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     761             :   }
     762    19509763 :   if (**lex=='-' && (*lex)[1]=='>')
     763             :   {
     764         866 :     *lex+=2; yylloc->end = *lex; return KARROW;
     765             :   }
     766    19508897 :   if (**lex=='<' && (*lex)[1]=='>')
     767             :   {
     768           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     769             :   }
     770    19508897 :   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    19508862 :   if ((*lex)[1]==**lex)
     779     2114340 :     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    19507644 :   yylloc->end = *lex+1;
     798    19507644 :   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      449736 : strntoGENstr(const char *s, long n0)
     810             : {
     811      449736 :   long n = nchar2nlong(n0+1);
     812      449736 :   GEN x = cgetg(n+1, t_STR);
     813      449736 :   char *t = GSTR(x);
     814      449736 :   strncpy(t, s, n0); t[n0] = 0; return x;
     815             : }
     816             : 
     817             : GEN
     818      342192 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     819             : 
     820             : GEN
     821      339280 : chartoGENstr(char c)
     822             : {
     823      339280 :   GEN x = cgetg(2, t_STR);
     824      339280 :   char *t = GSTR(x);
     825      339280 :   t[0] = c; t[1] = 0; return x;
     826             : }
     827             : 
     828             : /********************************************************************/
     829             : /*                                                                  */
     830             : /*                Formal variables management                       */
     831             : /*                                                                  */
     832             : /********************************************************************/
     833             : static THREAD long max_priority, min_priority;
     834             : static THREAD long max_avail; /* max variable not yet used */
     835             : static THREAD long nvar; /* first GP free variable */
     836             : static hashtable *h_polvar;
     837             : static struct pari_varstate global_varstate;
     838             : static long *global_varpriority;
     839             : 
     840             : void
     841       99468 : varstate_save(struct pari_varstate *s)
     842             : {
     843       99468 :   s->nvar = nvar;
     844       99468 :   s->max_avail = max_avail;
     845       99468 :   s->max_priority = max_priority;
     846       99468 :   s->min_priority = min_priority;
     847       99468 : }
     848             : 
     849             : static void
     850        8396 : varentries_set(long v, entree *ep)
     851             : {
     852        8396 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     853        8396 :   varentries[v] = ep;
     854        8396 : }
     855             : static int
     856        3143 : _given_value(void *E, hashentry *e) { return e->val == E; }
     857             : 
     858             : static void
     859       11717 : varentries_unset(long v)
     860             : {
     861       11717 :   entree *ep = varentries[v];
     862       11717 :   if (ep)
     863             :   {
     864        3143 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     865             :         _given_value);
     866        3143 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     867        3143 :     varentries[v] = NULL;
     868        3143 :     pari_free(e);
     869        3143 :     if (v <= nvar && ep == is_entry(ep->name))
     870        2905 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     871        2905 :       GEN p = (GEN)initial_value(ep);
     872        2905 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     873        2905 :       *p = 0;
     874             :     }
     875             :     else /* from name_var() or a direct pari_var_create() */
     876         238 :       pari_free(ep);
     877             :  }
     878       11717 : }
     879             : static void
     880         336 : varentries_reset(long v, entree *ep)
     881             : {
     882         336 :   varentries_unset(v);
     883         336 :   varentries_set(v, ep);
     884         336 : }
     885             : 
     886             : static void
     887       95139 : var_restore(struct pari_varstate *s)
     888             : {
     889       95139 :   nvar = s->nvar;
     890       95139 :   max_avail = s->max_avail;
     891       95139 :   max_priority = s->max_priority;
     892       95139 :   min_priority = s->min_priority;
     893       95139 : }
     894             : 
     895             : void
     896        8441 : varstate_restore(struct pari_varstate *s)
     897             : {
     898             :   long i;
     899       19794 :   for (i = nvar; i >= s->nvar; i--)
     900             :   {
     901       11353 :     varentries_unset(i);
     902       11353 :     varpriority[i] = -i;
     903             :   }
     904        8469 :   for (i = max_avail+1; i <= s->max_avail; i++)
     905             :   {
     906          28 :     varentries_unset(i);
     907          28 :     varpriority[i] = -i;
     908             :   }
     909        8441 :   var_restore(s);
     910        8441 : }
     911             : 
     912             : void
     913       87591 : pari_thread_init_varstate(void)
     914             : {
     915             :   long i;
     916       87591 :   var_restore(&global_varstate);
     917       86192 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
     918       89216 :   varpriority[-1] = 1-LONG_MAX;
     919       89216 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
     920       89216 : }
     921             : 
     922             : void
     923       10509 : pari_pthread_init_varstate(void)
     924             : {
     925       10509 :   varstate_save(&global_varstate);
     926       10509 :   global_varpriority = varpriority;
     927       10509 : }
     928             : 
     929             : void
     930        1557 : pari_var_close(void)
     931             : {
     932        1557 :   free((void*)varentries);
     933        1557 :   free((void*)(varpriority-1));
     934        1557 :   hash_destroy(h_polvar);
     935        1557 : }
     936             : 
     937             : void
     938        1559 : pari_var_init(void)
     939             : {
     940             :   long i;
     941        1559 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     942        1559 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     943        1559 :   varpriority[-1] = 1-LONG_MAX;
     944        1559 :   h_polvar = hash_create_str(100, 0);
     945        1559 :   nvar = 0; max_avail = MAXVARN;
     946        1559 :   max_priority = min_priority = 0;
     947        1559 :   (void)fetch_user_var("x");
     948        1559 :   (void)fetch_user_var("y");
     949             :   /* initialize so that people can use pol_x(i) directly */
     950        1559 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     951             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     952        1559 :   nvar = 10;
     953        1559 :   min_priority = -MAXVARN;
     954        1559 : }
     955         260 : long pari_var_next(void) { return nvar; }
     956         147 : long pari_var_next_temp(void) { return max_avail; }
     957             : long
     958       22529 : pari_var_create(entree *ep)
     959             : {
     960       22529 :   GEN p = (GEN)initial_value(ep);
     961             :   long v;
     962       22529 :   if (*p) return varn(p);
     963        8060 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     964        8060 :   v = nvar++;
     965             :   /* set p = pol_x(v) */
     966        8060 :   p[0] = evaltyp(t_POL) | _evallg(4);
     967        8060 :   p[1] = evalsigne(1) | evalvarn(v);
     968        8060 :   gel(p,2) = gen_0;
     969        8060 :   gel(p,3) = gen_1;
     970        8060 :   varentries_set(v, ep);
     971        8060 :   varpriority[v]= min_priority--;
     972        8060 :   return v;
     973             : }
     974             : 
     975             : long
     976       70551 : delete_var(void)
     977             : { /* user wants to delete one of his/her/its variables */
     978       70551 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     979       70551 :   max_avail++;
     980       70551 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     981       70551 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     982       70551 :   return max_avail+1;
     983             : }
     984             : long
     985       40251 : fetch_var(void)
     986             : {
     987       40251 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     988       40251 :   varpriority[max_avail] = min_priority--;
     989       40251 :   return max_avail--;
     990             : }
     991             : long
     992       30354 : fetch_var_higher(void)
     993             : {
     994       30354 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     995       30355 :   varpriority[max_avail] = ++max_priority;
     996       30355 :   return max_avail--;
     997             : }
     998             : 
     999             : static int
    1000          49 : _higher(void *E, hashentry *e)
    1001          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1002             : static int
    1003          42 : _lower(void *E, hashentry *e)
    1004          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1005             : 
    1006             : static GEN
    1007          84 : var_register(long v, const char *s)
    1008             : {
    1009          84 :   varentries_reset(v, initep(s, strlen(s)));
    1010          84 :   return pol_x(v);
    1011             : }
    1012             : GEN
    1013          77 : varhigher(const char *s, long w)
    1014             : {
    1015             :   long v;
    1016          77 :   if (w >= 0)
    1017             :   {
    1018          49 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1019          49 :     if (e) return pol_x((long)e->val);
    1020             :   }
    1021             :   /* no luck: need to create */
    1022          63 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1023          63 :   v = nvar++;
    1024          63 :   varpriority[v]= ++max_priority;
    1025          63 :   return var_register(v, s);
    1026             : }
    1027             : GEN
    1028          28 : varlower(const char *s, long w)
    1029             : {
    1030             :   long v;
    1031          28 :   if (w >= 0)
    1032             :   {
    1033          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1034          21 :     if (e) return pol_x((long)e->val);
    1035             :   }
    1036             :   /* no luck: need to create */
    1037          21 :   v = fetch_var();
    1038          21 :   return var_register(v, s);
    1039             : }
    1040             : 
    1041             : long
    1042      384297 : fetch_user_var(const char *s)
    1043             : {
    1044      384297 :   entree *ep = fetch_entry(s);
    1045             :   long v;
    1046      384297 :   switch (EpVALENCE(ep))
    1047             :   {
    1048      381032 :     case EpVAR: return varn((GEN)initial_value(ep));
    1049        3265 :     case EpNEW: break;
    1050           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1051             :   }
    1052        3265 :   v = pari_var_create(ep);
    1053        3265 :   ep->valence = EpVAR;
    1054        3265 :   ep->value = initial_value(ep);
    1055        3265 :   return v;
    1056             : }
    1057             : 
    1058             : GEN
    1059           7 : fetch_var_value(long v, GEN t)
    1060             : {
    1061           7 :   entree *ep = varentries[v];
    1062           7 :   if (!ep) return NULL;
    1063           7 :   if (t)
    1064             :   {
    1065           7 :     long vn = localvars_find(t,ep);
    1066           7 :     if (vn) return get_lex(vn);
    1067             :   }
    1068           7 :   return (GEN)ep->value;
    1069             : }
    1070             : 
    1071             : void
    1072         252 : name_var(long n, const char *s)
    1073             : {
    1074             :   entree *ep;
    1075             :   char *u;
    1076             : 
    1077         252 :   if (n < pari_var_next())
    1078           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1079         252 :   if (n > (long)MAXVARN)
    1080           0 :     pari_err_OVERFLOW("variable number");
    1081             : 
    1082         252 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1083         252 :   u = (char *)initial_value(ep);
    1084         252 :   ep->valence = EpVAR;
    1085         252 :   ep->name = u; strcpy(u,s);
    1086         252 :   ep->value = gen_0; /* in case geval is called */
    1087         252 :   varentries_reset(n, ep);
    1088         252 : }
    1089             : 
    1090             : static int
    1091        5129 : cmp_by_var(void *E,GEN x, GEN y)
    1092        5129 : { (void)E; return varncmp((long)x,(long)y); }
    1093             : GEN
    1094         812 : vars_sort_inplace(GEN z)
    1095         812 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1096             : GEN
    1097         154 : vars_to_RgXV(GEN h)
    1098             : {
    1099         154 :   long i, l = lg(h);
    1100         154 :   GEN z = cgetg(l, t_VEC);
    1101         154 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1102         154 :   return z;
    1103             : }
    1104             : GEN
    1105         987 : gpolvar(GEN x)
    1106             : {
    1107             :   long v;
    1108         987 :   if (!x) {
    1109         140 :     GEN h = hash_values(h_polvar);
    1110         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1111             :   }
    1112         847 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1113         840 :   v = gvar(x);
    1114         840 :   if (v==NO_VARIABLE) return gen_0;
    1115         777 :   return pol_x(v);
    1116             : }
    1117             : 
    1118             : static void
    1119     1853639 : fill_hashtable_single(entree **table, entree *ep)
    1120             : {
    1121     1853639 :   EpSETSTATIC(ep);
    1122     1853639 :   insertep(ep, table,  hashvalue(ep->name));
    1123     1853639 :   if (ep->code) ep->arity = check_proto(ep->code);
    1124     1853639 :   ep->pvalue = NULL;
    1125     1853639 : }
    1126             : 
    1127             : void
    1128        4675 : pari_fill_hashtable(entree **table, entree *ep)
    1129             : {
    1130        4675 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1131        4675 : }
    1132             : 
    1133             : void
    1134           0 : pari_add_function(entree *ep)
    1135             : {
    1136           0 :   fill_hashtable_single(functions_hash, ep);
    1137           0 : }
    1138             : 
    1139             : /********************************************************************/
    1140             : /**                                                                **/
    1141             : /**                        SIMPLE GP FUNCTIONS                     **/
    1142             : /**                                                                **/
    1143             : /********************************************************************/
    1144             : 
    1145             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1146             : 
    1147             : entree *
    1148     5886740 : do_alias(entree *ep)
    1149             : {
    1150     5886740 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1151     5886740 :   return ep;
    1152             : }
    1153             : 
    1154             : void
    1155          28 : alias0(const char *s, const char *old)
    1156             : {
    1157             :   entree *ep, *e;
    1158             :   GEN x;
    1159             : 
    1160          28 :   ep = fetch_entry(old);
    1161          28 :   e  = fetch_entry(s);
    1162          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1163           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1164          28 :   freeep(e);
    1165          28 :   x = newblock(2); x[0] = evaltyp(t_STR)|_evallg(2); /* for getheap */
    1166          28 :   gel(x,1) = (GEN)ep;
    1167          28 :   e->value=x; e->valence=EpALIAS;
    1168          28 : }
    1169             : 
    1170             : GEN
    1171    12830426 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1172             : {
    1173    12830426 :   if (gequal0(g)) /* false */
    1174     9957778 :     return b? closure_evalgen(b): gnil;
    1175             :   else /* true */
    1176     2872647 :     return a? closure_evalgen(a): gnil;
    1177             : }
    1178             : 
    1179             : void
    1180    39910882 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1181             : {
    1182    39910882 :   if (gequal0(g)) /* false */
    1183    39235507 :   { if (b) closure_evalvoid(b); }
    1184             :   else /* true */
    1185      675375 :   { if (a) closure_evalvoid(a); }
    1186    39910861 : }
    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     2373645 : 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    15171541 : 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