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 to exceed 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.14.0 lcov report (development 27783-affec94c65) Lines: 636 693 91.8 %
Date: 2022-07-07 07:34:25 Functions: 95 101 94.1 %
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; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : #include "pari.h"
      16             : #include "paripriv.h"
      17             : #include "anal.h"
      18             : #include "parse.h"
      19             : 
      20             : /***************************************************************************
      21             :  **                                                                       **
      22             :  **                           Mnemonic codes parser                       **
      23             :  **                                                                       **
      24             :  ***************************************************************************/
      25             : 
      26             : /* TEMPLATE is assumed to be ";"-separated list of items.  Each item
      27             :  * may have one of the following forms: id=value id==value id|value id&~value.
      28             :  * Each id consists of alphanum characters, dashes and underscores.
      29             :  * IDs are case-sensitive.
      30             : 
      31             :  * ARG consists of several IDs separated by punctuation (and optional
      32             :  * whitespace).  Each modifies the return value in a "natural" way: an
      33             :  * ID from id=value should be the first in the sequence and sets RETVAL to
      34             :  * VALUE (and cannot be negated), ID from id|value bit-ORs RETVAL with
      35             :  * VALUE (and bit-ANDs RETVAL with ~VALUE if negated), ID from
      36             :  * id&~value behaves as if it were noid|value, ID from
      37             :  * id==value behaves the same as id=value, but should come alone.
      38             : 
      39             :  * For items of the form id|value and id&~value negated forms are
      40             :  * allowed: either when arg looks like no[-_]id, or when id looks like
      41             :  * this, and arg is not-negated. */
      42             : 
      43             : static int
      44         380 : IS_ID(char c) { return isalnum((int)c) || c == '_'; }
      45             : long
      46          28 : eval_mnemonic(GEN str, const char *tmplate)
      47             : {
      48             :   const char *arg, *etmplate;
      49          28 :   ulong retval = 0;
      50             : 
      51          28 :   if (typ(str)==t_INT) return itos(str);
      52          28 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      53             : 
      54          28 :   arg = GSTR(str);
      55          28 :   etmplate = strchr(tmplate, '\n');
      56          28 :   if (!etmplate) etmplate = tmplate + strlen(tmplate);
      57             : 
      58             :   while (1)
      59          36 :   {
      60             :     long numarg;
      61          64 :     const char *e, *id, *negated = NULL;
      62          64 :     int negate = 0; /* Arg has 'no' prefix removed */
      63             :     ulong l;
      64             :     char *buf;
      65             :     static char b[80];
      66             : 
      67          64 :     while (isspace((int)*arg)) arg++;
      68          64 :     if (!*arg) break;
      69         364 :     e = arg; while (IS_ID(*e)) e++;
      70             :     /* Now the ID is whatever is between arg and e. */
      71          36 :     l = e - arg;
      72          36 :     if (l >= sizeof(b)) pari_err(e_MISC,"id too long in a mnemonic");
      73          36 :     if (!l) pari_err(e_MISC,"mnemonic does not start with an id");
      74          36 :     strncpy(b, arg, l); b[l] = 0;
      75          36 :     arg = e; e = buf = b;
      76          36 :     while ('0' <= *e && *e <= '9') e++;
      77          36 :     if (*e == 0) pari_err(e_MISC,"numeric id in a mnemonic");
      78          36 : FIND:
      79          36 :     id = tmplate;
      80          36 :     while ((id = strstr(id, buf)) && id < etmplate)
      81             :     {
      82          36 :       const char *s = id;
      83          36 :       id += l; if (s[l] != '|') continue; /* False positive */
      84          36 :       if (s == tmplate || !IS_ID(s[-1])) break; /* Found as is */
      85             :       /* If we found "no_ID", negate */
      86           0 :       if (!negate && s >= tmplate+3 && (s == tmplate+3 || !IS_ID(s[-4]))
      87           0 :           && s[-3] == 'n' && s[-2] == 'o' && s[-1] == '_')
      88           0 :          { negated = id; break; }
      89             :     }
      90          36 :     if (!id && !negated && !negate && l > 3
      91           0 :             && buf[0] == 'n' && buf[1] == 'o' && buf[2] == '_')
      92             :     { /* Try to find the flag without the prefix "no_". */
      93           0 :       buf += 3; l -= 3; negate = 1;
      94           0 :       if (buf[0]) goto FIND;
      95             :     }
      96             :     /* Negated and AS_IS forms, prefer AS_IS otherwise use negated form */
      97          36 :     if (!id)
      98             :     {
      99           0 :       if (!negated) pari_err(e_MISC,"Unrecognized id '%s' in mnemonic", b);
     100           0 :       id = negated; negate = 1;
     101             :     }
     102          36 :     if (*id++ != '|') pari_err(e_MISC,"Missing | in mnemonic template");
     103          36 :     e = id;
     104          88 :     while (*e >= '0' && *e <= '9') e++;
     105          36 :     while (isspace((int)*e)) e++;
     106          36 :     if (*e && *e != ';' && *e != ',')
     107           0 :       pari_err(e_MISC, "Non-numeric argument in mnemonic template");
     108          36 :     numarg = atol(id);
     109          36 :     if (negate) retval &= ~numarg; else retval |= numarg;
     110          36 :     while (isspace((int)*arg)) arg++;
     111          36 :     if (*arg && !ispunct((int)*arg++)) /* skip punctuation */
     112           0 :       pari_err(e_MISC,"Junk after id in mnemonic");
     113             :   }
     114          28 :   return retval;
     115             : }
     116             : 
     117             : /********************************************************************/
     118             : /**                                                                **/
     119             : /**                   HASH TABLE MANIPULATIONS                     **/
     120             : /**                                                                **/
     121             : /********************************************************************/
     122             : static void
     123     2514216 : insertep(entree *ep, entree **table, ulong hash)
     124             : {
     125     2514216 :   ep->hash = hash;
     126     2514216 :   hash %= functions_tblsz;
     127     2514216 :   ep->next = table[hash];
     128     2514216 :   table[hash] = ep;
     129     2514216 : }
     130             : 
     131             : static entree *
     132       33033 : initep(const char *name, long len)
     133             : {
     134       33033 :   const long add = 4*sizeof(long);
     135       33033 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     136       33033 :   entree *ep1 = initial_value(ep);
     137       33033 :   char *u = (char *) ep1 + add;
     138       33033 :   ep->name    = u; memcpy(u, name,len); u[len]=0;
     139       33033 :   ep->valence = EpNEW;
     140       33033 :   ep->value   = NULL;
     141       33033 :   ep->menu    = 0;
     142       33033 :   ep->code    = NULL;
     143       33033 :   ep->help    = NULL;
     144       33033 :   ep->pvalue  = NULL;
     145       33033 :   ep->arity   = 0;
     146       33033 :   return ep;
     147             : }
     148             : 
     149             : /* Look for s of length len in T; if 'insert', insert if missing */
     150             : static entree *
     151    60460659 : findentry(const char *s, long len, entree **T, int insert)
     152             : {
     153    60460659 :   ulong hash = hash_str_len(s, len);
     154             :   entree *ep;
     155   643352389 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     156   643319425 :     if (ep->hash == hash)
     157             :     {
     158    60427806 :       const char *t = ep->name;
     159    60427806 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     160             :     }
     161             :   /* not found */
     162       32964 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     163       32972 :   return ep;
     164             : }
     165             : entree *
     166        1651 : pari_is_default(const char *s)
     167        1651 : { return findentry(s, strlen(s), defaults_hash, 0); }
     168             : entree *
     169     5449271 : is_entry(const char *s)
     170     5449271 : { return findentry(s, strlen(s), functions_hash, 0); }
     171             : entree *
     172    55009738 : fetch_entry_raw(const char *s, long len)
     173    55009738 : { return findentry(s, len, functions_hash, 1); }
     174             : entree *
     175      463332 : fetch_entry(const char *s) { return fetch_entry_raw(s, strlen(s)); }
     176             : 
     177             : /*******************************************************************/
     178             : /*                                                                 */
     179             : /*                  SYNTACTICAL ANALYZER FOR GP                    */
     180             : /*                                                                 */
     181             : /*******************************************************************/
     182             : static GEN
     183     8994844 : readseq_i(char *t)
     184             : {
     185     8994844 :   if (gp_meta(t,0)) return gnil;
     186     8994844 :   return closure_evalres(pari_compile_str(t));
     187             : }
     188             : GEN
     189     8994844 : readseq(char *t)
     190     8994844 : { pari_sp av = avma; return gerepileupto(av, readseq_i(t)); }
     191             : 
     192             : /* filtered readseq = remove blanks and comments */
     193             : GEN
     194           0 : gp_read_str(const char *s)
     195           0 : { pari_sp av = avma; return gerepileupto(av, readseq_i(gp_filter(s))); }
     196             : 
     197             : GEN
     198       10789 : compile_str(const char *s) { return pari_compile_str(gp_filter(s)); }
     199             : 
     200             : GEN
     201           0 : gp_read_str_bitprec(const char *s, long bitprec)
     202             : {
     203             :   GEN x;
     204           0 :   push_localbitprec(bitprec);
     205           0 :   x = gp_read_str(s);
     206           0 :   pop_localprec();
     207           0 :   return x;
     208             : }
     209             : 
     210             : GEN
     211           0 : gp_read_str_prec(const char *s, long prec)
     212           0 : { return gp_read_str_bitprec(s, prec2nbits(prec)); }
     213             : 
     214             : /* valid return type */
     215             : static int
     216     2457888 : isreturn(char c)
     217     2457888 : { return c == 'l' || c == 'v' || c == 'i' || c == 'm' || c == 'u'; }
     218             : 
     219             : /* if is known that 2 commas follow s; base-10 signed integer followed
     220             :  * by comma? */
     221             : static int
     222      484712 : is_long(const char *s)
     223             : {
     224      484712 :   while (isspace(*s)) s++;
     225      484712 :   if (*s == '+' || *s == '-') s++;
     226      971222 :   while (isdigit(*s)) s++;
     227      484712 :   return *s == ',';
     228             : }
     229             : /* if is known that 2 commas follow s; base-10 unsigned integer followed
     230             :  * by comma? */
     231             : static int
     232        1814 : is_ulong(const char *s)
     233             : {
     234        1814 :   while (isspace(*s)) s++;
     235        1814 :   if (*s == '+') s++;
     236        3620 :   while (isdigit(*s)) s++;
     237        1814 :   return *s == ',';
     238             : }
     239             : static long
     240     2457888 : check_proto(const char *code)
     241             : {
     242     2457888 :   long arity = 0;
     243     2457888 :   const char *s = code;
     244     2457888 :   if (isreturn(*s)) s++;
     245     8303564 :   while (*s && *s != '\n') switch (*s++)
     246             :   {
     247     4285170 :     case '&':
     248             :     case 'C':
     249             :     case 'G':
     250             :     case 'I':
     251             :     case 'J':
     252             :     case 'U':
     253             :     case 'L':
     254             :     case 'M':
     255             :     case 'P':
     256             :     case 'W':
     257             :     case 'f':
     258             :     case 'n':
     259             :     case 'p':
     260             :     case 'b':
     261             :     case 'r':
     262     4285170 :       arity++; break;
     263      138754 :     case 'E':
     264             :     case 's':
     265      138754 :       if (*s == '*') s++;
     266      138754 :       arity++; break;
     267     1237960 :     case 'D':
     268     1237960 :       switch(*s)
     269             :       {
     270      708186 :         case 'G': case '&': case 'n': case 'I': case 'E':
     271      708186 :         case 'P': case 's': case 'r': s++; arity++; break;
     272       18020 :         case 'V': s++; break;
     273           0 :         case 0:
     274           0 :           pari_err(e_SYNTAX,"function has incomplete prototype", s,code);
     275           0 :           break;
     276      511754 :         default:
     277             :         {
     278             :           const char *p;
     279             :           long i;
     280     2591218 :           for(i = 0, p = s; *p && i < 2; p++) i += *p==','; /* skip 2 commas */
     281      511754 :           if (i < 2) pari_err(e_SYNTAX,"missing comma",s,code);
     282      511754 :           arity++;
     283      511754 :           switch(p[-2])
     284             :           {
     285      484712 :             case 'L':
     286      484712 :               if (!is_long(s)) pari_err(e_SYNTAX,"not a long",s,code);
     287      484708 :               break;
     288        1814 :             case 'U':
     289        1814 :               if (!is_ulong(s)) pari_err(e_SYNTAX,"not an ulong",s,code);
     290        1806 :               break;
     291       25228 :             case 'G': case 'r': case 's': case 'M':
     292       25228 :               break;
     293           0 :             default: pari_err(e_SYNTAX,"incorrect type",s-2,code);
     294             :           }
     295      511742 :           s = p;
     296             :         }
     297             :       }
     298     1237948 :       break;
     299      183804 :     case 'V':
     300             :     case '=':
     301      183804 :     case ',': break;
     302           0 :     case '\n': break; /* Before the mnemonic */
     303           0 :     default:
     304           0 :       if (isreturn(s[-1]))
     305           0 :         pari_err(e_SYNTAX, "this code has to come first", s-1, code);
     306           0 :       pari_err(e_SYNTAX, "unknown parser code", s-1, code);
     307             :   }
     308     2457876 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     309     2457876 :   return arity;
     310             : }
     311             : static void
     312           8 : check_name(const char *name)
     313             : {
     314           8 :   const char *s = name;
     315           8 :   if (isalpha((int)*s))
     316          40 :     while (is_keyword_char(*++s)) /* empty */;
     317           8 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     318           8 : }
     319             : 
     320             : entree *
     321          20 : install(void *f, const char *name, const char *code)
     322             : {
     323          20 :   long arity = check_proto(code);
     324             :   entree *ep;
     325             : 
     326           8 :   check_name(name);
     327           8 :   ep = fetch_entry(name);
     328           8 :   if (ep->valence != EpNEW)
     329             :   {
     330           0 :     if (ep->valence != EpINSTALL)
     331           0 :       pari_err(e_MISC,"[install] identifier '%s' already in use", name);
     332           0 :     pari_warn(warner, "[install] updating '%s' prototype; module not reloaded", name);
     333           0 :     if (ep->code) pari_free((void*)ep->code);
     334             :   }
     335             :   else
     336             :   {
     337           8 :     ep->value = f;
     338           8 :     ep->valence = EpINSTALL;
     339             :   }
     340           8 :   ep->code = pari_strdup(code);
     341           8 :   ep->arity = arity; return ep;
     342             : }
     343             : 
     344             : static void
     345          18 : killep(entree *ep)
     346             : {
     347          18 :   GEN p = (GEN)initial_value(ep);
     348          18 :   freeep(ep);
     349          18 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     350          18 :   ep->valence = EpNEW;
     351          18 :   ep->value   = NULL;
     352          18 :   ep->pvalue  = NULL;
     353          18 : }
     354             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     355             : void
     356          18 : kill0(const char *e)
     357             : {
     358          18 :   entree *ep = is_entry(e);
     359          18 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     360          18 :   killep(ep);
     361          18 : }
     362             : 
     363             : void
     364          50 : addhelp(const char *e, char *s)
     365             : {
     366          50 :   entree *ep = fetch_entry(e);
     367          50 :   void *f = (void *) ep->help;
     368          50 :   ep->help = pari_strdup(s);
     369          50 :   if (f && !EpSTATIC(ep)) pari_free(f);
     370          50 : }
     371             : 
     372             : /*******************************************************************/
     373             : /*                                                                 */
     374             : /*                              PARSER                             */
     375             : /*                                                                 */
     376             : /*******************************************************************/
     377             : 
     378             : #ifdef LONG_IS_64BIT
     379             : static const long MAX_DIGITS  = 19;
     380             : #else
     381             : static const long MAX_DIGITS  = 9;
     382             : #endif
     383             : 
     384             : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     385             : static const long MAX_BDIGITS = BITS_IN_LONG;
     386             : 
     387             : static int
     388   265966107 : ishex(const char **s)
     389             : {
     390   265966107 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     391             :   {
     392         130 :     *s += 2;
     393         130 :     return 1;
     394             :   }
     395             :   else
     396   265965977 :     return 0;
     397             : }
     398             : 
     399             : static int
     400   265966163 : isbin(const char **s)
     401             : {
     402   265966163 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     403             :   {
     404          56 :     *s += 2;
     405          56 :     return 1;
     406             :   }
     407             :   else
     408   265966107 :     return 0;
     409             : }
     410             : 
     411             : static ulong
     412          37 : bin_number_len(const char *s, long n)
     413             : {
     414          37 :   ulong m = 0;
     415             :   long i;
     416        1073 :   for (i = 0; i < n; i++,s++)
     417        1036 :     m = 2*m + (*s - '0');
     418          37 :   return m;
     419             : }
     420             : 
     421             : static int
     422        1064 : pari_isbdigit(int c)
     423             : {
     424        1064 :   return c=='0' || c=='1';
     425             : }
     426             : 
     427             : static ulong
     428         108 : hex_number_len(const char *s, long n)
     429             : {
     430         108 :   ulong m = 0;
     431             :   long i;
     432        1249 :   for(i = 0; i < n; i++, s++)
     433             :   {
     434             :     ulong c;
     435        1141 :     if( *s >= '0' && *s <= '9')
     436         566 :       c = *s - '0';
     437         575 :     else if( *s >= 'A' && *s <= 'F')
     438          42 :       c = *s - 'A' + 10;
     439             :     else
     440         533 :       c = *s - 'a' + 10;
     441        1141 :     m = 16*m + c;
     442             :   }
     443         108 :   return m;
     444             : }
     445             : 
     446             : static GEN
     447         102 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     448             : {
     449         102 :   long i, l = (n+B-1)/B;
     450             :   GEN N, Np;
     451         102 :   N = cgetipos(l+2);
     452         102 :   Np = int_LSW(N);
     453         145 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     454          43 :     uel(Np, 0) = num(s+n-i*B, B);
     455         102 :   uel(Np, 0) = num(s, n-(i-1)*B);
     456         102 :   return int_normalize(N, 0);
     457             : }
     458             : 
     459             : static GEN
     460         102 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     461             : {
     462         102 :   const char *s = *ps;
     463        2279 :   while (is((int)**ps)) (*ps)++;
     464         102 :   return strtobin_len(s, *ps-s, B, num);
     465             : }
     466             : 
     467             : static GEN
     468          28 : bin_read(const char **ps)
     469             : {
     470          28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     471             : }
     472             : 
     473             : static GEN
     474          74 : hex_read(const char **ps)
     475             : {
     476          74 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     477             : }
     478             : 
     479             : static ulong
     480     5212884 : dec_number_len(const char *s, long B)
     481             : {
     482     5212884 :   ulong m = 0;
     483             :   long n;
     484    68393099 :   for (n = 0; n < B; n++,s++)
     485    63180215 :     m = 10*m + (*s - '0');
     486     5212884 :   return m;
     487             : }
     488             : 
     489             : static GEN
     490     1654532 : dec_strtoi_len(const char *s, long n)
     491             : {
     492     1654532 :   const long B = MAX_DIGITS;
     493     1654532 :   long i, l = (n+B-1)/B;
     494     1654532 :   GEN V = cgetg(l+1, t_VECSMALL);
     495     5212884 :   for (i=1; i<l; i++)
     496     3558352 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     497     1654532 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     498     1654532 :   return fromdigitsu(V, powuu(10, B));
     499             : }
     500             : 
     501             : static GEN
     502     1654532 : dec_read_more(const char **ps)
     503             : {
     504     1654532 :   pari_sp av = avma;
     505     1654532 :   const char *s = *ps;
     506    64834747 :   while (isdigit((int)**ps)) (*ps)++;
     507     1654532 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     508             : }
     509             : 
     510             : static ulong
     511    68817827 : number(int *n, const char **s)
     512             : {
     513    68817827 :   ulong m = 0;
     514   317488169 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     515   248670342 :     m = 10*m + (**s - '0');
     516    68817827 :   return m;
     517             : }
     518             : 
     519             : static GEN
     520    68742234 : dec_read(const char **s)
     521             : {
     522             :   int nb;
     523    68742234 :   ulong y  = number(&nb, s);
     524    68742234 :   if (nb < MAX_DIGITS)
     525    67087702 :     return utoi(y);
     526     1654532 :   *s -= MAX_DIGITS;
     527     1654532 :   return dec_read_more(s);
     528             : }
     529             : 
     530             : static GEN
     531        4158 : real_read_more(GEN y, const char **ps)
     532             : {
     533        4158 :   pari_sp av = avma;
     534        4158 :   const char *s = *ps;
     535        4158 :   GEN z = dec_read(ps);
     536        4158 :   long e = *ps-s;
     537        4158 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     538             : }
     539             : 
     540             : static long
     541       75593 : exponent(const char **pts)
     542             : {
     543       75593 :   const char *s = *pts;
     544             :   long n;
     545             :   int nb;
     546       75593 :   switch(*++s)
     547             :   {
     548       75439 :     case '-': s++; n = -(long)number(&nb, &s); break;
     549           0 :     case '+': s++; /* Fall through */
     550         154 :     default: n = (long)number(&nb, &s);
     551             :   }
     552       75593 :   *pts = s; return n;
     553             : }
     554             : 
     555             : static GEN
     556         175 : real_0_digits(long n) {
     557         175 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     558         175 :   return real_0_bit(b);
     559             : }
     560             : 
     561             : static GEN
     562       83540 : real_read(pari_sp av, const char **s, GEN y, long prec)
     563             : {
     564       83540 :   long l, n = 0;
     565       83540 :   switch(**s)
     566             :   {
     567           0 :     default: return y; /* integer */
     568        9186 :     case '.':
     569             :     {
     570        9186 :       const char *old = ++*s;
     571        9186 :       if (isalpha((int)**s) || **s=='.')
     572             :       {
     573        1232 :         if (**s == 'E' || **s == 'e') {
     574        1232 :           n = exponent(s);
     575        1232 :           if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     576        1204 :           break;
     577             :         }
     578           0 :         --*s; return y; /* member */
     579             :       }
     580        7954 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     581        7954 :       n = old - *s;
     582        7954 :       if (**s != 'E' && **s != 'e')
     583             :       {
     584        7947 :         if (!signe(y)) { set_avma(av); return real_0(prec); }
     585        6820 :         break;
     586             :       }
     587             :     }
     588             :     /* Fall through */
     589             :     case 'E': case 'e':
     590       74361 :       n += exponent(s);
     591       74361 :       if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     592             :   }
     593       82238 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     594       82238 :   if (l < prec) l = prec; else prec = l;
     595       82238 :   if (!n) return itor(y, prec);
     596       78862 :   incrprec(l);
     597       78862 :   y = itor(y, l);
     598       78862 :   if (n > 0)
     599          77 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     600             :   else
     601       78785 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     602       78862 :   return gerepileuptoleaf(av, rtor(y, prec));
     603             : }
     604             : 
     605             : static GEN
     606    68654638 : int_read(const char **s)
     607             : {
     608             :   GEN y;
     609    68654638 :   if (isbin(s))
     610          28 :     y = bin_read(s);
     611    68654610 :   else if (ishex(s))
     612          74 :     y = hex_read(s);
     613             :   else
     614    68654536 :     y = dec_read(s);
     615    68654638 :   return y;
     616             : }
     617             : 
     618             : GEN
     619    68654638 : strtoi(const char *s) { return int_read(&s); }
     620             : 
     621             : GEN
     622       83540 : strtor(const char *s, long prec)
     623             : {
     624       83540 :   pari_sp av = avma;
     625       83540 :   GEN y = dec_read(&s);
     626       83540 :   y = real_read(av, &s, y, prec);
     627       83540 :   if (typ(y) == t_REAL) return y;
     628           0 :   return gerepileuptoleaf(av, itor(y, prec));
     629             : }
     630             : 
     631             : static void
     632    68565113 : skipdigits(char **lex) {
     633   356896163 :   while (isdigit((int)**lex)) ++*lex;
     634    68565113 : }
     635             : 
     636             : static int
     637    68559565 : skipexponent(char **lex)
     638             : {
     639    68559565 :   char *old=*lex;
     640    68559565 :   if ((**lex=='e' || **lex=='E'))
     641             :   {
     642        1057 :     ++*lex;
     643        1057 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     644        1057 :     if (!isdigit((int)**lex))
     645             :     {
     646         469 :       *lex=old;
     647         469 :       return KINTEGER;
     648             :     }
     649         588 :     skipdigits(lex);
     650         588 :     return KREAL;
     651             :   }
     652    68558508 :   return KINTEGER;
     653             : }
     654             : 
     655             : static int
     656    68560790 : skipconstante(char **lex)
     657             : {
     658    68560790 :   skipdigits(lex);
     659    68560790 :   if (**lex=='.')
     660             :   {
     661       16867 :     char *old = ++*lex;
     662       16867 :     if (**lex == '.') { --*lex; return KINTEGER; }
     663       15642 :     if (isalpha((int)**lex))
     664             :     {
     665       11907 :       skipexponent(lex);
     666       11907 :       if (*lex == old)
     667             :       {
     668       11851 :         --*lex; /* member */
     669       11851 :         return KINTEGER;
     670             :       }
     671          56 :       return KREAL;
     672             :     }
     673        3735 :     skipdigits(lex);
     674        3735 :     skipexponent(lex);
     675        3735 :     return KREAL;
     676             :   }
     677    68543923 :   return skipexponent(lex);
     678             : }
     679             : 
     680             : static void
     681      763670 : skipstring(char **lex)
     682             : {
     683     6195954 :   while (**lex)
     684             :   {
     685     6196511 :     while (**lex == '\\') *lex+=2;
     686     6195954 :     if (**lex == '"')
     687             :     {
     688      763670 :       if ((*lex)[1] != '"') break;
     689           0 :       *lex += 2; continue;
     690             :     }
     691     5432284 :     (*lex)++;
     692             :   }
     693      763670 : }
     694             : 
     695             : int
     696   207699951 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     697             : {
     698             :   (void) yylval;
     699   207699951 :   yylloc->start=*lex;
     700   207699951 :   if (!**lex)
     701             :   {
     702     9109884 :     yylloc->end=*lex;
     703     9109884 :     return 0;
     704             :   }
     705   198590067 :   if (isalpha((int)**lex))
     706             :   {
     707     2233588 :     while (is_keyword_char(**lex)) ++*lex;
     708      501747 :     yylloc->end=*lex;
     709      501747 :     return KENTRY;
     710             :   }
     711   198088320 :   if (**lex=='"')
     712             :   {
     713      763670 :     ++*lex;
     714      763670 :     skipstring(lex);
     715      763670 :     if (!**lex)
     716           0 :       compile_err("run-away string",*lex-1);
     717      763670 :     ++*lex;
     718      763670 :     yylloc->end=*lex;
     719      763670 :     return KSTRING;
     720             :   }
     721   197324650 :   if (**lex == '.')
     722             :   {
     723             :     int token;
     724       13125 :     if ((*lex)[1]== '.')
     725             :     {
     726        1253 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     727             :     }
     728       11872 :     token=skipconstante(lex);
     729       11872 :     if (token==KREAL)
     730             :     {
     731          21 :       yylloc->end = *lex;
     732          21 :       return token;
     733             :     }
     734       11851 :     ++*lex;
     735       11851 :     yylloc->end=*lex;
     736       11851 :     return '.';
     737             :   }
     738   197311525 :   if (isbin((const char**)lex))
     739             :   {
     740        1064 :     while (**lex=='0' || **lex=='1') ++*lex;
     741          28 :     yylloc->end = *lex;
     742          28 :     return KINTEGER;
     743             :   }
     744   197311497 :   if (ishex((const char**)lex))
     745             :   {
     746         903 :     while (isxdigit((int)**lex)) ++*lex;
     747          56 :     yylloc->end = *lex;
     748          56 :     return KINTEGER;
     749             :   }
     750   197311441 :   if (isdigit((int)**lex))
     751             :   {
     752    68548918 :     int token=skipconstante(lex);
     753    68548918 :     yylloc->end = *lex;
     754    68548918 :     return token;
     755             :   }
     756   128762523 :   if ((*lex)[1]=='=')
     757       23849 :     switch (**lex)
     758             :     {
     759        9046 :     case '=':
     760        9046 :       if ((*lex)[2]=='=')
     761         343 :       { *lex+=3; yylloc->end = *lex; return KID; }
     762             :       else
     763        8703 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     764         104 :     case '>':
     765         104 :       *lex+=2; yylloc->end = *lex; return KGE;
     766         202 :     case '<':
     767         202 :       *lex+=2; yylloc->end = *lex; return KLE;
     768         188 :     case '*':
     769         188 :       *lex+=2; yylloc->end = *lex; return KME;
     770          35 :     case '/':
     771          35 :       *lex+=2; yylloc->end = *lex; return KDE;
     772           7 :     case '%':
     773           7 :       if ((*lex)[2]=='=') break;
     774           7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     775        1967 :     case '!':
     776        1967 :       if ((*lex)[2]=='=') break;
     777        1967 :       *lex+=2; yylloc->end = *lex; return KNE;
     778           7 :     case '\\':
     779           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     780         197 :     case '+':
     781         197 :       *lex+=2; yylloc->end = *lex; return KPE;
     782          63 :     case '-':
     783          63 :       *lex+=2; yylloc->end = *lex; return KSE;
     784             :     }
     785   128750707 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     786             :   {
     787        4079 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     788             :   }
     789   128746628 :   if (**lex=='-' && (*lex)[1]=='>')
     790             :   {
     791        1186 :     *lex+=2; yylloc->end = *lex; return KARROW;
     792             :   }
     793   128745442 :   if (**lex=='<' && (*lex)[1]=='>')
     794             :   {
     795           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     796             :   }
     797   128745442 :   if (**lex=='\\' && (*lex)[1]=='/')
     798          35 :     switch((*lex)[2])
     799             :     {
     800           7 :     case '=':
     801           7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     802          28 :     default:
     803          28 :       *lex+=2; yylloc->end = *lex; return KDR;
     804             :     }
     805   128745407 :   if ((*lex)[1]==**lex)
     806    10354857 :     switch (**lex)
     807             :     {
     808         725 :     case '&':
     809         725 :       *lex+=2; yylloc->end = *lex; return KAND;
     810         392 :     case '|':
     811         392 :       *lex+=2; yylloc->end = *lex; return KOR;
     812         148 :     case '+':
     813         148 :       *lex+=2; yylloc->end = *lex; return KPP;
     814          28 :     case '-':
     815          28 :       *lex+=2; yylloc->end = *lex; return KSS;
     816          28 :     case '>':
     817          28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     818          21 :       *lex+=2; yylloc->end = *lex; return KSR;
     819         154 :     case '<':
     820         154 :       if ((*lex)[2]=='=')
     821           7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     822         147 :       *lex+=2; yylloc->end = *lex; return KSL;
     823             :     }
     824   128743932 :   yylloc->end = *lex+1;
     825   128743932 :   return (unsigned char) *(*lex)++;
     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             : 
     838             : void
     839      354735 : varstate_save(struct pari_varstate *s)
     840             : {
     841      354735 :   s->nvar = nvar;
     842      354735 :   s->max_avail = max_avail;
     843      354735 :   s->max_priority = max_priority;
     844      354735 :   s->min_priority = min_priority;
     845      354735 : }
     846             : 
     847             : static void
     848        9091 : varentries_set(long v, entree *ep)
     849             : {
     850        9091 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     851        9091 :   varentries[v] = ep;
     852        9091 : }
     853             : static int
     854        2947 : _given_value(void *E, hashentry *e) { return e->val == E; }
     855             : 
     856             : static void
     857       14187 : varentries_unset(long v)
     858             : {
     859       14187 :   entree *ep = varentries[v];
     860       14187 :   if (ep)
     861             :   {
     862        2947 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     863             :         _given_value);
     864        2947 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     865        2947 :     varentries[v] = NULL;
     866        2947 :     pari_free(e);
     867        2947 :     if (v <= nvar && ep == is_entry(ep->name))
     868        2940 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     869        2940 :       GEN p = (GEN)initial_value(ep);
     870        2940 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     871        2940 :       *p = 0;
     872             :     }
     873             :     else /* from name_var() or a direct pari_var_create() */
     874           7 :       pari_free(ep);
     875             :  }
     876       14187 : }
     877             : static void
     878         111 : varentries_reset(long v, entree *ep)
     879             : {
     880         111 :   varentries_unset(v);
     881         111 :   varentries_set(v, ep);
     882         111 : }
     883             : 
     884             : static void
     885      238172 : var_restore(struct pari_varstate *s)
     886             : {
     887      238172 :   nvar = s->nvar;
     888      238172 :   max_avail = s->max_avail;
     889      238172 :   max_priority = s->max_priority;
     890      238172 :   min_priority = s->min_priority;
     891      238172 : }
     892             : 
     893             : void
     894       11108 : varstate_restore(struct pari_varstate *s)
     895             : {
     896             :   long i;
     897       25163 :   for (i = nvar; i >= s->nvar; i--)
     898             :   {
     899       14055 :     varentries_unset(i);
     900       14055 :     varpriority[i] = -i;
     901             :   }
     902       11129 :   for (i = max_avail+1; i <= s->max_avail; i++)
     903             :   {
     904          21 :     varentries_unset(i);
     905          21 :     varpriority[i] = -i;
     906             :   }
     907       11108 :   var_restore(s);
     908       11108 : }
     909             : 
     910             : void
     911      227090 : pari_set_varstate(long *vp, struct pari_varstate *vs)
     912             : {
     913      227090 :   var_restore(vs);
     914      227021 :   varpriority = (long*)newblock(MAXVARN+2) + 1;
     915      226527 :   memcpy(varpriority-1,vp-1,(MAXVARN+2)*sizeof(long));
     916      226527 : }
     917             : 
     918             : /* must come before destruction of functions_hash */
     919             : void
     920        1792 : pari_var_close(void)
     921             : {
     922        1792 :   GEN h = hash_values(h_polvar);
     923        1792 :   long i, l = lg(h);
     924        7916 :   for (i = 1; i < l; i++)
     925             :   {
     926        6124 :     long v = h[i];
     927        6124 :     entree *ep = varentries[v];
     928        6124 :     if (ep && ep != is_entry(ep->name)) pari_free(ep);
     929             :   }
     930        1792 :   free((void*)varentries);
     931        1792 :   free((void*)(varpriority-1));
     932        1792 :   hash_destroy(h_polvar);
     933        1792 : }
     934             : 
     935             : void
     936        1802 : pari_var_init(void)
     937             : {
     938             :   long i;
     939        1802 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     940        1802 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     941        1802 :   varpriority[-1] = 1-LONG_MAX;
     942        1802 :   h_polvar = hash_create_str(100, 0);
     943        1802 :   nvar = 0; max_avail = MAXVARN;
     944        1802 :   max_priority = min_priority = 0;
     945        1802 :   (void)fetch_user_var("x");
     946        1802 :   (void)fetch_user_var("y");
     947             :   /* initialize so that people can use pol_x(i) directly */
     948   105904374 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     949             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     950        1802 :   nvar = 10;
     951        1802 :   min_priority = -MAXVARN;
     952        1802 : }
     953           8 : long pari_var_next(void) { return nvar; }
     954           0 : long pari_var_next_temp(void) { return max_avail; }
     955             : long
     956       33578 : pari_var_create(entree *ep)
     957             : {
     958       33578 :   GEN p = (GEN)initial_value(ep);
     959             :   long v;
     960       33578 :   if (*p) return varn(p);
     961        8980 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     962        8980 :   v = nvar++;
     963             :   /* set p = pol_x(v) */
     964        8980 :   p[0] = evaltyp(t_POL) | _evallg(4);
     965        8980 :   p[1] = evalsigne(1) | evalvarn(v);
     966        8980 :   gel(p,2) = gen_0;
     967        8980 :   gel(p,3) = gen_1;
     968        8980 :   varentries_set(v, ep);
     969        8980 :   varpriority[v]= min_priority--;
     970        8980 :   return v;
     971             : }
     972             : 
     973             : long
     974      357232 : delete_var(void)
     975             : { /* user wants to delete one of his/her/its variables */
     976      357232 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     977      357029 :   max_avail++;
     978      357029 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     979      357029 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     980      357029 :   return max_avail+1;
     981             : }
     982             : long
     983       96750 : fetch_var(void)
     984             : {
     985       96750 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     986       96750 :   varpriority[max_avail] = min_priority--;
     987       96750 :   return max_avail--;
     988             : }
     989             : long
     990      264158 : fetch_var_higher(void)
     991             : {
     992      264158 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     993      264158 :   varpriority[max_avail] = ++max_priority;
     994      264158 :   return max_avail--;
     995             : }
     996             : 
     997             : static int
     998          49 : _higher(void *E, hashentry *e)
     999          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1000             : static int
    1001          42 : _lower(void *E, hashentry *e)
    1002          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1003             : 
    1004             : static GEN
    1005         111 : var_register(long v, const char *s)
    1006             : {
    1007         111 :   varentries_reset(v, initep(s, strlen(s)));
    1008         111 :   return pol_x(v);
    1009             : }
    1010             : GEN
    1011          98 : varhigher(const char *s, long w)
    1012             : {
    1013             :   long v;
    1014          98 :   if (w >= 0)
    1015             :   {
    1016          49 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1017          49 :     if (e) return pol_x((long)e->val);
    1018             :   }
    1019             :   /* no luck: need to create */
    1020          84 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1021          84 :   v = nvar++;
    1022          84 :   varpriority[v]= ++max_priority;
    1023          84 :   return var_register(v, s);
    1024             : }
    1025             : GEN
    1026          34 : varlower(const char *s, long w)
    1027             : {
    1028             :   long v;
    1029          34 :   if (w >= 0)
    1030             :   {
    1031          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1032          21 :     if (e) return pol_x((long)e->val);
    1033             :   }
    1034             :   /* no luck: need to create */
    1035          27 :   v = fetch_var();
    1036          27 :   return var_register(v, s);
    1037             : }
    1038             : 
    1039             : long
    1040      463218 : fetch_user_var(const char *s)
    1041             : {
    1042      463218 :   entree *ep = fetch_entry(s);
    1043             :   long v;
    1044      463218 :   switch (EpVALENCE(ep))
    1045             :   {
    1046      459411 :     case EpVAR: return varn((GEN)initial_value(ep));
    1047        3807 :     case EpNEW: break;
    1048           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1049             :   }
    1050        3807 :   v = pari_var_create(ep);
    1051        3807 :   ep->valence = EpVAR;
    1052        3807 :   ep->value = initial_value(ep);
    1053        3807 :   return v;
    1054             : }
    1055             : 
    1056             : GEN
    1057           7 : fetch_var_value(long v, GEN t)
    1058             : {
    1059           7 :   entree *ep = varentries[v];
    1060           7 :   if (!ep) return NULL;
    1061           7 :   if (t)
    1062             :   {
    1063           7 :     long vn = localvars_find(t,ep);
    1064           7 :     if (vn) return get_lex(vn);
    1065             :   }
    1066           7 :   return (GEN)ep->value;
    1067             : }
    1068             : 
    1069             : void
    1070           0 : name_var(long n, const char *s)
    1071             : {
    1072             :   entree *ep;
    1073             :   char *u;
    1074             : 
    1075           0 :   if (n < pari_var_next())
    1076           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1077           0 :   if (n > (long)MAXVARN)
    1078           0 :     pari_err_OVERFLOW("variable number");
    1079             : 
    1080           0 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1081           0 :   u = (char *)initial_value(ep);
    1082           0 :   ep->valence = EpVAR;
    1083           0 :   ep->name = u; strcpy(u,s);
    1084           0 :   ep->value = gen_0; /* in case geval is called */
    1085           0 :   varentries_reset(n, ep);
    1086           0 : }
    1087             : 
    1088             : static int
    1089        5150 : cmp_by_var(void *E,GEN x, GEN y)
    1090        5150 : { (void)E; return varncmp((long)x,(long)y); }
    1091             : GEN
    1092        1183 : vars_sort_inplace(GEN z)
    1093        1183 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1094             : GEN
    1095         161 : vars_to_RgXV(GEN h)
    1096             : {
    1097         161 :   long i, l = lg(h);
    1098         161 :   GEN z = cgetg(l, t_VEC);
    1099        2065 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1100         161 :   return z;
    1101             : }
    1102             : GEN
    1103        1183 : gpolvar(GEN x)
    1104             : {
    1105             :   long v;
    1106        1183 :   if (!x) {
    1107         140 :     GEN h = hash_values(h_polvar);
    1108         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1109             :   }
    1110        1043 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1111        1036 :   v = gvar(x);
    1112        1036 :   if (v==NO_VARIABLE) return gen_0;
    1113         980 :   return pol_x(v);
    1114             : }
    1115             : 
    1116             : static void
    1117     2481294 : fill_hashtable_single(entree **table, entree *ep)
    1118             : {
    1119     2481294 :   EpSETSTATIC(ep);
    1120     2481294 :   insertep(ep, table, hash_str(ep->name));
    1121     2481294 :   if (ep->code) ep->arity = check_proto(ep->code);
    1122     2481294 :   ep->pvalue = NULL;
    1123     2481294 : }
    1124             : 
    1125             : void
    1126        5396 : pari_fill_hashtable(entree **table, entree *ep)
    1127             : {
    1128     2486690 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1129        5396 : }
    1130             : 
    1131             : void
    1132           0 : pari_add_function(entree *ep)
    1133             : {
    1134           0 :   fill_hashtable_single(functions_hash, ep);
    1135           0 : }
    1136             : 
    1137             : /********************************************************************/
    1138             : /**                                                                **/
    1139             : /**                        SIMPLE GP FUNCTIONS                     **/
    1140             : /**                                                                **/
    1141             : /********************************************************************/
    1142             : 
    1143             : GEN
    1144          28 : arity0(GEN C)
    1145             : {
    1146          28 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("arity", C);
    1147          28 :   return utoi(closure_arity(C));
    1148             : }
    1149             : 
    1150             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1151             : 
    1152             : entree *
    1153    54579749 : do_alias(entree *ep)
    1154             : {
    1155    54579805 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1156    54579749 :   return ep;
    1157             : }
    1158             : 
    1159             : void
    1160          28 : alias0(const char *s, const char *old)
    1161             : {
    1162             :   entree *ep, *e;
    1163             :   GEN x;
    1164             : 
    1165          28 :   ep = fetch_entry(old);
    1166          28 :   e  = fetch_entry(s);
    1167          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1168           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1169          28 :   freeep(e);
    1170          28 :   x = cgetg_block(2, t_VECSMALL); gel(x,1) = (GEN)ep;
    1171          28 :   e->value=x; e->valence=EpALIAS;
    1172          28 : }
    1173             : 
    1174             : GEN
    1175    12962839 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1176             : {
    1177    12962839 :   if (gequal0(g)) /* false */
    1178     9992989 :     return b? closure_evalgen(b): gnil;
    1179             :   else /* true */
    1180     2969850 :     return a? closure_evalgen(a): gnil;
    1181             : }
    1182             : 
    1183             : void
    1184    41027617 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1185             : {
    1186    41027617 :   if (gequal0(g)) /* false */
    1187    40237871 :   { if (b) closure_evalvoid(b); }
    1188             :   else /* true */
    1189      789746 :   { if (a) closure_evalvoid(a); }
    1190    41027596 : }
    1191             : 
    1192             : GEN
    1193       31325 : ifpari_multi(GEN g, GEN a/*closure*/)
    1194             : {
    1195       31325 :   long i, nb = lg(a)-1;
    1196       31325 :   if (!gequal0(g)) /* false */
    1197        6713 :     return closure_evalgen(gel(a,1));
    1198       42098 :   for(i=2;i<nb;i+=2)
    1199             :   {
    1200       24724 :     GEN g = closure_evalgen(gel(a,i));
    1201       24724 :     if (!g) return g;
    1202       24717 :     if (!gequal0(g))
    1203        7231 :       return closure_evalgen(gel(a,i+1));
    1204             :   }
    1205       17374 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1206             : }
    1207             : 
    1208             : GEN
    1209    53997514 : andpari(GEN a, GEN b/*closure*/)
    1210             : {
    1211             :   GEN g;
    1212    53997514 :   if (gequal0(a))
    1213    45831331 :     return gen_0;
    1214     8166183 :   g=closure_evalgen(b);
    1215     8166183 :   if (!g) return g;
    1216     8166183 :   return gequal0(g)?gen_0:gen_1;
    1217             : }
    1218             : 
    1219             : GEN
    1220    16517529 : orpari(GEN a, GEN b/*closure*/)
    1221             : {
    1222             :   GEN g;
    1223    16517529 :   if (!gequal0(a))
    1224      338828 :     return gen_1;
    1225    16178701 :   g=closure_evalgen(b);
    1226    16178701 :   if (!g) return g;
    1227    16178701 :   return gequal0(g)?gen_0:gen_1;
    1228             : }
    1229             : 
    1230      178215 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1231          56 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1232           7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1233           7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1234           7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1235           7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1236           7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1237      532827 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1238    25676788 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addiu(*x,1):gaddgs(*x,1); return *x; }
    1239    15455370 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1240       28014 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subiu(*x,1):gsubgs(*x,1); return *x; }
    1241             : 
    1242        1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.13