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.18.0 lcov report (development 29792-e7296d7d08) Lines: 636 693 91.8 %
Date: 2024-12-05 09:09:40 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         457 : IS_ID(char c) { return isalnum((unsigned char)c) || c == '_'; }
      45             : long
      46          35 : eval_mnemonic(GEN str, const char *tmplate)
      47             : {
      48             :   const char *arg, *etmplate;
      49          35 :   ulong retval = 0;
      50             : 
      51          35 :   if (typ(str)==t_INT) return itos(str);
      52          35 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      53             : 
      54          35 :   arg = GSTR(str);
      55          35 :   etmplate = strchr(tmplate, '\n');
      56          35 :   if (!etmplate) etmplate = tmplate + strlen(tmplate);
      57             : 
      58             :   while (1)
      59          43 :   {
      60             :     long numarg;
      61          78 :     const char *e, *id, *negated = NULL;
      62          78 :     int negate = 0; /* Arg has 'no' prefix removed */
      63             :     ulong l;
      64             :     char *buf;
      65             :     static char b[80];
      66             : 
      67          78 :     while (isspace((unsigned char)*arg)) arg++;
      68          78 :     if (!*arg) break;
      69         434 :     e = arg; while (IS_ID(*e)) e++;
      70             :     /* Now the ID is whatever is between arg and e. */
      71          43 :     l = e - arg;
      72          43 :     if (l >= sizeof(b)) pari_err(e_MISC,"id too long in a mnemonic");
      73          43 :     if (!l) pari_err(e_MISC,"mnemonic does not start with an id");
      74          43 :     strncpy(b, arg, l); b[l] = 0;
      75          43 :     arg = e; e = buf = b;
      76          43 :     while ('0' <= *e && *e <= '9') e++;
      77          43 :     if (*e == 0) pari_err(e_MISC,"numeric id in a mnemonic");
      78          43 : FIND:
      79          43 :     id = tmplate;
      80          43 :     while ((id = strstr(id, buf)) && id < etmplate)
      81             :     {
      82          43 :       const char *s = id;
      83          43 :       id += l; if (s[l] != '|') continue; /* False positive */
      84          43 :       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          43 :     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          43 :     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          43 :     if (*id++ != '|') pari_err(e_MISC,"Missing | in mnemonic template");
     103          43 :     e = id;
     104         102 :     while (*e >= '0' && *e <= '9') e++;
     105          43 :     while (isspace((unsigned char)*e)) e++;
     106          43 :     if (*e && *e != ';' && *e != ',')
     107           0 :       pari_err(e_MISC, "Non-numeric argument in mnemonic template");
     108          43 :     numarg = atol(id);
     109          43 :     if (negate) retval &= ~numarg; else retval |= numarg;
     110          43 :     while (isspace((unsigned char)*arg)) arg++;
     111          43 :     if (*arg && !ispunct((unsigned char)*arg++)) /* skip punctuation */
     112           0 :       pari_err(e_MISC,"Junk after id in mnemonic");
     113             :   }
     114          35 :   return retval;
     115             : }
     116             : 
     117             : /********************************************************************/
     118             : /**                                                                **/
     119             : /**                   HASH TABLE MANIPULATIONS                     **/
     120             : /**                                                                **/
     121             : /********************************************************************/
     122             : static void
     123     2682253 : insertep(entree *ep, entree **table, ulong hash)
     124             : {
     125     2682253 :   ep->hash = hash;
     126     2682253 :   hash %= functions_tblsz;
     127     2682253 :   ep->next = table[hash];
     128     2682253 :   table[hash] = ep;
     129     2682253 : }
     130             : 
     131             : static entree *
     132       35413 : initep(const char *name, long len)
     133             : {
     134       35413 :   const long add = 4*sizeof(long);
     135       35413 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     136       35413 :   entree *ep1 = initial_value(ep);
     137       35413 :   char *u = (char *) ep1 + add;
     138       35413 :   ep->name    = u; memcpy(u, name,len); u[len]=0;
     139       35413 :   ep->valence = EpNEW;
     140       35413 :   ep->value   = NULL;
     141       35413 :   ep->menu    = 0;
     142       35413 :   ep->code    = NULL;
     143       35413 :   ep->help    = NULL;
     144       35413 :   ep->pvalue  = NULL;
     145       35413 :   ep->arity   = 0;
     146       35413 :   return ep;
     147             : }
     148             : 
     149             : /* Look for s of length len in T; if 'insert', insert if missing */
     150             : static entree *
     151    18253949 : findentry(const char *s, long len, entree **T, int insert)
     152             : {
     153    18253949 :   ulong hash = hash_str_len(s, len);
     154             :   entree *ep;
     155   181775268 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     156   181739939 :     if (ep->hash == hash)
     157             :     {
     158    18218739 :       const char *t = ep->name;
     159    18218739 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     160             :     }
     161             :   /* not found */
     162       35329 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     163       35345 :   return ep;
     164             : }
     165             : entree *
     166         965 : pari_is_default(const char *s)
     167         965 : { return findentry(s, strlen(s), defaults_hash, 0); }
     168             : entree *
     169     8074118 : is_entry(const char *s)
     170     8074118 : { return findentry(s, strlen(s), functions_hash, 0); }
     171             : entree *
     172    10178867 : fetch_entry_raw(const char *s, long len)
     173    10178867 : { return findentry(s, len, functions_hash, 1); }
     174             : entree *
     175      449234 : 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      803787 : readseq_i(char *t)
     184             : {
     185      803787 :   if (gp_meta(t,0)) return gnil;
     186      803787 :   return closure_evalres(pari_compile_str(t));
     187             : }
     188             : GEN
     189      803787 : readseq(char *t)
     190      803787 : { 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       10992 : compile_str(const char *s) { return pari_compile_str(gp_filter(s)); }
     199             : 
     200             : GEN
     201           0 : gp_read_str_prec(const char *s, long prec)
     202             : {
     203             :   GEN x;
     204           0 :   push_localbitprec(prec);
     205           0 :   x = gp_read_str(s);
     206           0 :   pop_localprec();
     207           0 :   return x;
     208             : }
     209             : 
     210             : /* Deprecated, keep for backward compatibility */
     211             : GEN
     212           0 : gp_read_str_bitprec(const char *s, long bitprec)
     213           0 : { return gp_read_str_prec(s, bitprec); }
     214             : 
     215             : /* valid return type */
     216             : static int
     217     2622642 : isreturn(char c)
     218     2622642 : { return c == 'l' || c == 'v' || c == 'i' || c == 'm' || c == 'u'; }
     219             : 
     220             : /* if is known that 2 commas follow s; base-10 signed integer followed
     221             :  * by comma? */
     222             : static int
     223      520390 : is_long(const char *s)
     224             : {
     225      520390 :   while (isspace((unsigned char)*s)) s++;
     226      520390 :   if (*s == '+' || *s == '-') s++;
     227     1042648 :   while (isdigit((unsigned char)*s)) s++;
     228      520390 :   return *s == ',';
     229             : }
     230             : /* if is known that 2 commas follow s; base-10 unsigned integer followed
     231             :  * by comma? */
     232             : static int
     233        1884 : is_ulong(const char *s)
     234             : {
     235        1884 :   while (isspace((unsigned char)*s)) s++;
     236        1884 :   if (*s == '+') s++;
     237        3760 :   while (isdigit((unsigned char)*s)) s++;
     238        1884 :   return *s == ',';
     239             : }
     240             : static long
     241     2622642 : check_proto(const char *code)
     242             : {
     243     2622642 :   long arity = 0;
     244     2622642 :   const char *s = code;
     245     2622642 :   if (isreturn(*s)) s++;
     246     8884470 :   while (*s && *s != '\n') switch (*s++)
     247             :   {
     248     4571438 :     case '&':
     249             :     case 'C':
     250             :     case 'G':
     251             :     case 'I':
     252             :     case 'J':
     253             :     case 'U':
     254             :     case 'L':
     255             :     case 'M':
     256             :     case 'P':
     257             :     case 'W':
     258             :     case 'f':
     259             :     case 'n':
     260             :     case 'p':
     261             :     case 'b':
     262             :     case 'r':
     263     4571438 :       arity++; break;
     264      144144 :     case 'E':
     265             :     case 's':
     266      144144 :       if (*s == '*') s++;
     267      144144 :       arity++; break;
     268     1351570 :     case 'D':
     269     1351570 :       switch(*s)
     270             :       {
     271      786240 :         case 'G': case '&': case 'n': case 'I': case 'E':
     272      786240 :         case 'P': case 's': case 'r': s++; arity++; break;
     273       20592 :         case 'V': s++; break;
     274           0 :         case 0:
     275           0 :           pari_err(e_SYNTAX,"function has incomplete prototype", s,code);
     276           0 :           break;
     277      544738 :         default:
     278             :         {
     279             :           const char *p;
     280             :           long i;
     281     2759270 :           for(i = 0, p = s; *p && i < 2; p++) i += *p==','; /* skip 2 commas */
     282      544738 :           if (i < 2) pari_err(e_SYNTAX,"missing comma",s,code);
     283      544738 :           arity++;
     284      544738 :           switch(p[-2])
     285             :           {
     286      520390 :             case 'L':
     287      520390 :               if (!is_long(s)) pari_err(e_SYNTAX,"not a long",s,code);
     288      520386 :               break;
     289        1884 :             case 'U':
     290        1884 :               if (!is_ulong(s)) pari_err(e_SYNTAX,"not an ulong",s,code);
     291        1876 :               break;
     292       22464 :             case 'G': case 'r': case 's': case 'M':
     293       22464 :               break;
     294           0 :             default: pari_err(e_SYNTAX,"incorrect type",s-2,code);
     295             :           }
     296      544726 :           s = p;
     297             :         }
     298             :       }
     299     1351558 :       break;
     300      194688 :     case 'V':
     301             :     case '=':
     302      194688 :     case ',': break;
     303           0 :     case '\n': break; /* Before the mnemonic */
     304           0 :     default:
     305           0 :       if (isreturn(s[-1]))
     306           0 :         pari_err(e_SYNTAX, "this code has to come first", s-1, code);
     307           0 :       pari_err(e_SYNTAX, "unknown parser code", s-1, code);
     308             :   }
     309     2622630 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     310     2622630 :   return arity;
     311             : }
     312             : static void
     313           8 : check_name(const char *name)
     314             : {
     315           8 :   const char *s = name;
     316           8 :   if (isalpha((unsigned char)*s))
     317          40 :     while (is_keyword_char(*++s)) /* empty */;
     318           8 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     319           8 : }
     320             : 
     321             : entree *
     322          20 : install(void *f, const char *name, const char *code)
     323             : {
     324          20 :   long arity = check_proto(code);
     325             :   entree *ep;
     326             : 
     327           8 :   check_name(name);
     328           8 :   ep = fetch_entry(name);
     329           8 :   if (ep->valence != EpNEW)
     330             :   {
     331           0 :     if (ep->valence != EpINSTALL)
     332           0 :       pari_err(e_MISC,"[install] identifier '%s' already in use", name);
     333           0 :     pari_warn(warner, "[install] updating '%s' prototype; module not reloaded", name);
     334           0 :     if (ep->code) pari_free((void*)ep->code);
     335             :   }
     336             :   else
     337             :   {
     338           8 :     ep->value = f;
     339           8 :     ep->valence = EpINSTALL;
     340             :   }
     341           8 :   ep->code = pari_strdup(code);
     342           8 :   ep->arity = arity; return ep;
     343             : }
     344             : 
     345             : static void
     346          18 : killep(entree *ep)
     347             : {
     348          18 :   GEN p = (GEN)initial_value(ep);
     349          18 :   freeep(ep);
     350          18 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     351          18 :   ep->valence = EpNEW;
     352          18 :   ep->value   = NULL;
     353          18 :   ep->pvalue  = NULL;
     354          18 : }
     355             : /* Kill ep, i.e free all memory it references, and reset to initial value */
     356             : void
     357          18 : kill0(const char *e)
     358             : {
     359          18 :   entree *ep = is_entry(e);
     360          18 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     361          18 :   killep(ep);
     362          18 : }
     363             : 
     364             : void
     365          50 : addhelp(const char *e, const char *s)
     366             : {
     367          50 :   entree *ep = fetch_entry(e);
     368          50 :   void *f = (void *) ep->help;
     369          50 :   ep->help = pari_strdup(s);
     370          50 :   if (f && !EpSTATIC(ep)) pari_free(f);
     371          50 : }
     372             : 
     373             : /*******************************************************************/
     374             : /*                                                                 */
     375             : /*                              PARSER                             */
     376             : /*                                                                 */
     377             : /*******************************************************************/
     378             : 
     379             : #ifdef LONG_IS_64BIT
     380             : static const long MAX_DIGITS  = 19;
     381             : #else
     382             : static const long MAX_DIGITS  = 9;
     383             : #endif
     384             : 
     385             : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     386             : static const long MAX_BDIGITS = BITS_IN_LONG;
     387             : 
     388             : static int
     389    50128899 : ishex(const char **s)
     390             : {
     391    50128899 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     392             :   {
     393         130 :     *s += 2;
     394         130 :     return 1;
     395             :   }
     396             :   else
     397    50128769 :     return 0;
     398             : }
     399             : 
     400             : static int
     401    50128955 : isbin(const char **s)
     402             : {
     403    50128955 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     404             :   {
     405          56 :     *s += 2;
     406          56 :     return 1;
     407             :   }
     408             :   else
     409    50128899 :     return 0;
     410             : }
     411             : 
     412             : static ulong
     413          37 : bin_number_len(const char *s, long n)
     414             : {
     415          37 :   ulong m = 0;
     416             :   long i;
     417        1073 :   for (i = 0; i < n; i++,s++)
     418        1036 :     m = 2*m + (*s - '0');
     419          37 :   return m;
     420             : }
     421             : 
     422             : static int
     423        1064 : pari_isbdigit(int c)
     424             : {
     425        1064 :   return c=='0' || c=='1';
     426             : }
     427             : 
     428             : static ulong
     429         108 : hex_number_len(const char *s, long n)
     430             : {
     431         108 :   ulong m = 0;
     432             :   long i;
     433        1249 :   for(i = 0; i < n; i++, s++)
     434             :   {
     435             :     ulong c;
     436        1141 :     if( *s >= '0' && *s <= '9')
     437         566 :       c = *s - '0';
     438         575 :     else if( *s >= 'A' && *s <= 'F')
     439          42 :       c = *s - 'A' + 10;
     440             :     else
     441         533 :       c = *s - 'a' + 10;
     442        1141 :     m = 16*m + c;
     443             :   }
     444         108 :   return m;
     445             : }
     446             : 
     447             : static GEN
     448         102 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     449             : {
     450         102 :   long i, l = (n+B-1)/B;
     451             :   GEN N, Np;
     452         102 :   N = cgetipos(l+2);
     453         102 :   Np = int_LSW(N);
     454         145 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     455          43 :     uel(Np, 0) = num(s+n-i*B, B);
     456         102 :   uel(Np, 0) = num(s, n-(i-1)*B);
     457         102 :   return int_normalize(N, 0);
     458             : }
     459             : 
     460             : static GEN
     461         102 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     462             : {
     463         102 :   const char *s = *ps;
     464        2279 :   while (is((unsigned char)**ps)) (*ps)++;
     465         102 :   return strtobin_len(s, *ps-s, B, num);
     466             : }
     467             : 
     468             : static GEN
     469          28 : bin_read(const char **ps)
     470             : {
     471          28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     472             : }
     473             : 
     474             : static GEN
     475          74 : hex_read(const char **ps)
     476             : {
     477          74 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     478             : }
     479             : 
     480             : static ulong
     481     3789830 : dec_number_len(const char *s, long B)
     482             : {
     483     3789830 :   ulong m = 0;
     484             :   long n;
     485    58693495 :   for (n = 0; n < B; n++,s++)
     486    54903665 :     m = 10*m + (*s - '0');
     487     3789830 :   return m;
     488             : }
     489             : 
     490             : static GEN
     491      872747 : dec_strtoi_len(const char *s, long n)
     492             : {
     493      872747 :   const long B = MAX_DIGITS;
     494      872747 :   long i, l = (n+B-1)/B;
     495      872747 :   GEN V = cgetg(l+1, t_VECSMALL);
     496     3789830 :   for (i=1; i<l; i++)
     497     2917083 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     498      872747 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     499      872747 :   return fromdigitsu(V, powuu(10, B));
     500             : }
     501             : 
     502             : static GEN
     503      872747 : dec_read_more(const char **ps)
     504             : {
     505      872747 :   pari_sp av = avma;
     506      872747 :   const char *s = *ps;
     507    55776412 :   while (isdigit((unsigned char)**ps)) (*ps)++;
     508      872747 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     509             : }
     510             : 
     511             : static ulong
     512    12130280 : number(int *n, const char **s)
     513             : {
     514    12130280 :   ulong m = 0;
     515    54459199 :   for (*n = 0; *n < MAX_DIGITS && isdigit((unsigned char)**s); (*n)++,(*s)++)
     516    42328919 :     m = 10*m + (**s - '0');
     517    12130280 :   return m;
     518             : }
     519             : 
     520             : static GEN
     521    12054743 : dec_read(const char **s)
     522             : {
     523             :   int nb;
     524    12054743 :   ulong y  = number(&nb, s);
     525    12054743 :   if (nb < MAX_DIGITS)
     526    11181996 :     return utoi(y);
     527      872747 :   *s -= MAX_DIGITS;
     528      872747 :   return dec_read_more(s);
     529             : }
     530             : 
     531             : static GEN
     532        4906 : real_read_more(GEN y, const char **ps)
     533             : {
     534        4906 :   pari_sp av = avma;
     535        4906 :   const char *s = *ps;
     536        4906 :   GEN z = dec_read(ps);
     537        4906 :   long e = *ps-s;
     538        4906 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     539             : }
     540             : 
     541             : static long
     542       75537 : exponent(const char **pts)
     543             : {
     544       75537 :   const char *s = *pts;
     545             :   long n;
     546             :   int nb;
     547       75537 :   switch(*++s)
     548             :   {
     549       75355 :     case '-': s++; n = -(long)number(&nb, &s); break;
     550           0 :     case '+': s++; /* Fall through */
     551         182 :     default: n = (long)number(&nb, &s);
     552             :   }
     553       75537 :   *pts = s; return n;
     554             : }
     555             : 
     556             : static GEN
     557         196 : real_0_digits(long n) {
     558         196 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     559         196 :   return real_0_bit(b);
     560             : }
     561             : 
     562             : static GEN
     563       85793 : real_read(pari_sp av, const char **s, GEN y, long prec)
     564             : {
     565       85793 :   long l, n = 0;
     566       85793 :   switch(**s)
     567             :   {
     568           0 :     default: return y; /* integer */
     569       11614 :     case '.':
     570             :     {
     571       11614 :       const char *old = ++*s;
     572       11614 :       if (isalpha((unsigned char)**s) || **s=='.')
     573             :       {
     574        1337 :         if (**s == 'E' || **s == 'e') {
     575        1337 :           n = exponent(s);
     576        1337 :           if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     577        1288 :           break;
     578             :         }
     579           0 :         --*s; return y; /* member */
     580             :       }
     581       10277 :       if (isdigit((unsigned char)**s)) y = real_read_more(y, s);
     582       10277 :       n = old - *s;
     583       10277 :       if (**s != 'E' && **s != 'e')
     584             :       {
     585       10256 :         if (!signe(y)) { set_avma(av); return real_0(prec); }
     586        9003 :         break;
     587             :       }
     588             :     }
     589             :     /* Fall through */
     590             :     case 'E': case 'e':
     591       74200 :       n += exponent(s);
     592       74200 :       if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     593             :   }
     594       84344 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     595       84344 :   if (l < prec) l = prec; else prec = l;
     596       84344 :   if (!n) return itor(y, prec);
     597       79519 :   incrprec(l);
     598       79519 :   y = itor(y, l);
     599       79519 :   if (n > 0)
     600          84 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     601             :   else
     602       79435 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     603       79519 :   return gerepileuptoleaf(av, rtor(y, prec));
     604             : }
     605             : 
     606             : static GEN
     607    11964146 : int_read(const char **s)
     608             : {
     609             :   GEN y;
     610    11964146 :   if (isbin(s))
     611          28 :     y = bin_read(s);
     612    11964118 :   else if (ishex(s))
     613          74 :     y = hex_read(s);
     614             :   else
     615    11964044 :     y = dec_read(s);
     616    11964146 :   return y;
     617             : }
     618             : 
     619             : GEN
     620    11964146 : strtoi(const char *s) { return int_read(&s); }
     621             : 
     622             : GEN
     623       85793 : strtor(const char *s, long prec)
     624             : {
     625       85793 :   pari_sp av = avma;
     626       85793 :   GEN y = dec_read(&s);
     627       85793 :   y = real_read(av, &s, y, prec);
     628       85793 :   if (typ(y) == t_REAL) return y;
     629           0 :   return gerepileuptoleaf(av, itor(y, prec));
     630             : }
     631             : 
     632             : static void
     633    11973044 : skipdigits(char **lex) {
     634    93667457 :   while (isdigit((unsigned char)**lex)) ++*lex;
     635    11973044 : }
     636             : 
     637             : static int
     638    11965992 : skipexponent(char **lex)
     639             : {
     640    11965992 :   char *old=*lex;
     641    11965992 :   if ((**lex=='e' || **lex=='E'))
     642             :   {
     643        1127 :     ++*lex;
     644        1127 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     645        1127 :     if (!isdigit((unsigned char)**lex))
     646             :     {
     647         469 :       *lex=old;
     648         469 :       return KINTEGER;
     649             :     }
     650         658 :     skipdigits(lex);
     651         658 :     return KREAL;
     652             :   }
     653    11964865 :   return KINTEGER;
     654             : }
     655             : 
     656             : static int
     657    11967615 : skipconstante(char **lex)
     658             : {
     659    11967615 :   skipdigits(lex);
     660    11967615 :   if (**lex=='.')
     661             :   {
     662       19134 :     char *old = ++*lex;
     663       19134 :     if (**lex == '.') { --*lex; return KINTEGER; }
     664       17511 :     if (isalpha((unsigned char)**lex))
     665             :     {
     666       12740 :       skipexponent(lex);
     667       12740 :       if (*lex == old)
     668             :       {
     669       12579 :         --*lex; /* member */
     670       12579 :         return KINTEGER;
     671             :       }
     672         161 :       return KREAL;
     673             :     }
     674        4771 :     skipdigits(lex);
     675        4771 :     skipexponent(lex);
     676        4771 :     return KREAL;
     677             :   }
     678    11948481 :   return skipexponent(lex);
     679             : }
     680             : 
     681             : static void
     682      879996 : skipstring(char **lex)
     683             : {
     684     6940852 :   while (**lex)
     685             :   {
     686     6941500 :     while (**lex == '\\') *lex+=2;
     687     6940852 :     if (**lex == '"')
     688             :     {
     689      879996 :       if ((*lex)[1] != '"') break;
     690           0 :       *lex += 2; continue;
     691             :     }
     692     6060856 :     (*lex)++;
     693             :   }
     694      879996 : }
     695             : 
     696             : int
     697    40556995 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     698             : {
     699             :   (void) yylval;
     700    40556995 :   yylloc->start=*lex;
     701    40556995 :   if (!**lex)
     702             :   {
     703      932053 :     yylloc->end=*lex;
     704      932053 :     return 0;
     705             :   }
     706    39624942 :   if (isalpha((unsigned char)**lex))
     707             :   {
     708     2535048 :     while (is_keyword_char(**lex)) ++*lex;
     709      565886 :     yylloc->end=*lex;
     710      565886 :     return KENTRY;
     711             :   }
     712    39059056 :   if (**lex=='"')
     713             :   {
     714      879996 :     ++*lex;
     715      879996 :     skipstring(lex);
     716      879996 :     if (!**lex)
     717           0 :       compile_err("run-away string",*lex-1);
     718      879996 :     ++*lex;
     719      879996 :     yylloc->end=*lex;
     720      879996 :     return KSTRING;
     721             :   }
     722    38179060 :   if (**lex == '.')
     723             :   {
     724             :     int token;
     725       14251 :     if ((*lex)[1]== '.')
     726             :     {
     727        1651 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     728             :     }
     729       12600 :     token=skipconstante(lex);
     730       12600 :     if (token==KREAL)
     731             :     {
     732          21 :       yylloc->end = *lex;
     733          21 :       return token;
     734             :     }
     735       12579 :     ++*lex;
     736       12579 :     yylloc->end=*lex;
     737       12579 :     return '.';
     738             :   }
     739    38164809 :   if (isbin((const char**)lex))
     740             :   {
     741        1064 :     while (**lex=='0' || **lex=='1') ++*lex;
     742          28 :     yylloc->end = *lex;
     743          28 :     return KINTEGER;
     744             :   }
     745    38164781 :   if (ishex((const char**)lex))
     746             :   {
     747         903 :     while (isxdigit((unsigned int)**lex)) ++*lex;
     748          56 :     yylloc->end = *lex;
     749          56 :     return KINTEGER;
     750             :   }
     751    38164725 :   if (isdigit((unsigned char)**lex))
     752             :   {
     753    11955015 :     int token=skipconstante(lex);
     754    11955015 :     yylloc->end = *lex;
     755    11955015 :     return token;
     756             :   }
     757    26209710 :   if ((*lex)[1]=='=')
     758       29695 :     switch (**lex)
     759             :     {
     760       11810 :     case '=':
     761       11810 :       if ((*lex)[2]=='=')
     762         343 :       { *lex+=3; yylloc->end = *lex; return KID; }
     763             :       else
     764       11467 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     765         125 :     case '>':
     766         125 :       *lex+=2; yylloc->end = *lex; return KGE;
     767         237 :     case '<':
     768         237 :       *lex+=2; yylloc->end = *lex; return KLE;
     769         195 :     case '*':
     770         195 :       *lex+=2; yylloc->end = *lex; return KME;
     771          35 :     case '/':
     772          35 :       *lex+=2; yylloc->end = *lex; return KDE;
     773           7 :     case '%':
     774           7 :       if ((*lex)[2]=='=') break;
     775           7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     776        2149 :     case '!':
     777        2149 :       if ((*lex)[2]=='=') break;
     778        2149 :       *lex+=2; yylloc->end = *lex; return KNE;
     779           7 :     case '\\':
     780           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     781         229 :     case '+':
     782         229 :       *lex+=2; yylloc->end = *lex; return KPE;
     783          63 :     case '-':
     784          63 :       *lex+=2; yylloc->end = *lex; return KSE;
     785             :     }
     786    26194853 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     787             :   {
     788        4100 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     789             :   }
     790    26190753 :   if (**lex=='-' && (*lex)[1]=='>')
     791             :   {
     792        1332 :     *lex+=2; yylloc->end = *lex; return KARROW;
     793             :   }
     794    26189421 :   if (**lex=='<' && (*lex)[1]=='>')
     795             :   {
     796           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     797             :   }
     798    26189421 :   if (**lex=='\\' && (*lex)[1]=='/')
     799          35 :     switch((*lex)[2])
     800             :     {
     801           7 :     case '=':
     802           7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     803          28 :     default:
     804          28 :       *lex+=2; yylloc->end = *lex; return KDR;
     805             :     }
     806    26189386 :   if ((*lex)[1]==**lex)
     807     2398621 :     switch (**lex)
     808             :     {
     809         816 :     case '&':
     810         816 :       *lex+=2; yylloc->end = *lex; return KAND;
     811         413 :     case '|':
     812         413 :       *lex+=2; yylloc->end = *lex; return KOR;
     813         183 :     case '+':
     814         183 :       *lex+=2; yylloc->end = *lex; return KPP;
     815          28 :     case '-':
     816          28 :       *lex+=2; yylloc->end = *lex; return KSS;
     817          28 :     case '>':
     818          28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     819          21 :       *lex+=2; yylloc->end = *lex; return KSR;
     820         154 :     case '<':
     821         154 :       if ((*lex)[2]=='=')
     822           7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     823         147 :       *lex+=2; yylloc->end = *lex; return KSL;
     824             :     }
     825    26187764 :   yylloc->end = *lex+1;
     826    26187764 :   return (unsigned char) *(*lex)++;
     827             : }
     828             : 
     829             : /********************************************************************/
     830             : /*                                                                  */
     831             : /*                Formal variables management                       */
     832             : /*                                                                  */
     833             : /********************************************************************/
     834             : static THREAD long max_priority, min_priority;
     835             : static THREAD long max_avail; /* max variable not yet used */
     836             : static THREAD long nvar; /* first GP free variable */
     837             : static hashtable *h_polvar;
     838             : 
     839             : void
     840      465386 : varstate_save(struct pari_varstate *s)
     841             : {
     842      465386 :   s->nvar = nvar;
     843      465386 :   s->max_avail = max_avail;
     844      465386 :   s->max_priority = max_priority;
     845      465386 :   s->min_priority = min_priority;
     846      465386 : }
     847             : 
     848             : static void
     849        9287 : varentries_set(long v, entree *ep)
     850             : {
     851        9287 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     852        9287 :   varentries[v] = ep;
     853        9287 : }
     854             : static int
     855        3010 : _given_value(void *E, hashentry *e) { return e->val == E; }
     856             : 
     857             : static void
     858       15972 : varentries_unset(long v)
     859             : {
     860       15972 :   entree *ep = varentries[v];
     861       15972 :   if (ep)
     862             :   {
     863        3010 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     864             :         _given_value);
     865        3010 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     866        3010 :     varentries[v] = NULL;
     867        3010 :     pari_free(e);
     868        3010 :     if (v <= nvar && ep == is_entry(ep->name))
     869        3003 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     870        3003 :       GEN p = (GEN)initial_value(ep);
     871        3003 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     872        3003 :       *p = 0;
     873             :     }
     874             :     else /* from name_var() or a direct pari_var_create() */
     875           7 :       pari_free(ep);
     876             :  }
     877       15972 : }
     878             : static void
     879         118 : varentries_reset(long v, entree *ep)
     880             : {
     881         118 :   varentries_unset(v);
     882         118 :   varentries_set(v, ep);
     883         118 : }
     884             : 
     885             : static void
     886      337041 : var_restore(struct pari_varstate *s)
     887             : {
     888      337041 :   nvar = s->nvar;
     889      337041 :   max_avail = s->max_avail;
     890      337041 :   max_priority = s->max_priority;
     891      337041 :   min_priority = s->min_priority;
     892      337041 : }
     893             : 
     894             : void
     895       12802 : varstate_restore(struct pari_varstate *s)
     896             : {
     897             :   long i;
     898       28614 :   for (i = nvar; i >= s->nvar; i--)
     899             :   {
     900       15812 :     varentries_unset(i);
     901       15812 :     varpriority[i] = -i;
     902             :   }
     903       12844 :   for (i = max_avail+1; i <= s->max_avail; i++)
     904             :   {
     905          42 :     varentries_unset(i);
     906          42 :     varpriority[i] = -i;
     907             :   }
     908       12802 :   var_restore(s);
     909       12802 : }
     910             : 
     911             : void
     912      324251 : pari_set_varstate(long *vp, struct pari_varstate *vs)
     913             : {
     914      324251 :   var_restore(vs);
     915      324209 :   varpriority = (long*)newblock(MAXVARN+2) + 1;
     916      324109 :   memcpy(varpriority-1,vp-1,(MAXVARN+2)*sizeof(long));
     917      324109 : }
     918             : 
     919             : /* must come before destruction of functions_hash */
     920             : void
     921        1862 : pari_var_close(void)
     922             : {
     923        1862 :   GEN h = hash_values(h_polvar);
     924        1862 :   long i, l = lg(h);
     925        8119 :   for (i = 1; i < l; i++)
     926             :   {
     927        6257 :     long v = h[i];
     928        6257 :     entree *ep = varentries[v];
     929        6257 :     if (ep && ep != is_entry(ep->name)) pari_free(ep);
     930             :   }
     931        1862 :   free((void*)varentries);
     932        1862 :   free((void*)(varpriority-1));
     933        1862 :   hash_destroy(h_polvar);
     934        1862 : }
     935             : 
     936             : void
     937        1872 : pari_var_init(void)
     938             : {
     939             :   long i;
     940        1872 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     941        1872 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     942        1872 :   varpriority[-1] = 1-LONG_MAX;
     943        1872 :   h_polvar = hash_create_str(100, 0);
     944        1872 :   nvar = 0; max_avail = MAXVARN;
     945        1872 :   max_priority = min_priority = 0;
     946        1872 :   (void)fetch_user_var("x");
     947        1872 :   (void)fetch_user_var("y");
     948             :   /* initialize so that people can use pol_x(i) directly */
     949   110000304 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     950             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     951        1872 :   nvar = 10;
     952        1872 :   min_priority = -MAXVARN;
     953        1872 : }
     954           8 : long pari_var_next(void) { return nvar; }
     955           0 : long pari_var_next_temp(void) { return max_avail; }
     956             : long
     957      479563 : pari_var_create(entree *ep)
     958             : {
     959      479563 :   GEN p = (GEN)initial_value(ep);
     960             :   long v;
     961      479563 :   if (*p) return varn(p);
     962        9169 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     963        9169 :   v = nvar++;
     964             :   /* set p = pol_x(v) */
     965        9169 :   p[0] = evaltyp(t_POL) | _evallg(4);
     966        9169 :   p[1] = evalsigne(1) | evalvarn(v);
     967        9169 :   gel(p,2) = gen_0;
     968        9169 :   gel(p,3) = gen_1;
     969        9169 :   varentries_set(v, ep);
     970        9169 :   varpriority[v]= min_priority--;
     971        9169 :   return v;
     972             : }
     973             : 
     974             : long
     975     1248761 : delete_var(void)
     976             : { /* user wants to delete one of his/her/its variables */
     977     1248761 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     978     1248131 :   max_avail++;
     979     1248131 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     980     1248131 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     981     1248131 :   return max_avail+1;
     982             : }
     983             : long
     984       86893 : fetch_var(void)
     985             : {
     986       86893 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     987       86893 :   varpriority[max_avail] = min_priority--;
     988       86893 :   return max_avail--;
     989             : }
     990             : long
     991     1161848 : fetch_var_higher(void)
     992             : {
     993     1161848 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     994     1161847 :   varpriority[max_avail] = ++max_priority;
     995     1161847 :   return max_avail--;
     996             : }
     997             : 
     998             : static int
     999          49 : _higher(void *E, hashentry *e)
    1000          49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1001             : static int
    1002          42 : _lower(void *E, hashentry *e)
    1003          42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1004             : 
    1005             : static GEN
    1006         118 : var_register(long v, const char *s)
    1007             : {
    1008         118 :   varentries_reset(v, initep(s, strlen(s)));
    1009         118 :   return pol_x(v);
    1010             : }
    1011             : GEN
    1012         105 : varhigher(const char *s, long w)
    1013             : {
    1014             :   long v;
    1015         105 :   if (w >= 0)
    1016             :   {
    1017          56 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1018          56 :     if (e) return pol_x((long)e->val);
    1019             :   }
    1020             :   /* no luck: need to create */
    1021          91 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1022          91 :   v = nvar++;
    1023          91 :   varpriority[v]= ++max_priority;
    1024          91 :   return var_register(v, s);
    1025             : }
    1026             : GEN
    1027          34 : varlower(const char *s, long w)
    1028             : {
    1029             :   long v;
    1030          34 :   if (w >= 0)
    1031             :   {
    1032          21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1033          21 :     if (e) return pol_x((long)e->val);
    1034             :   }
    1035             :   /* no luck: need to create */
    1036          27 :   v = fetch_var();
    1037          27 :   return var_register(v, s);
    1038             : }
    1039             : 
    1040             : long
    1041      449120 : fetch_user_var(const char *s)
    1042             : {
    1043      449120 :   entree *ep = fetch_entry(s);
    1044             :   long v;
    1045      449120 :   switch (EpVALENCE(ep))
    1046             :   {
    1047      445173 :     case EpVAR: return pari_var_create(ep);
    1048        3947 :     case EpNEW: break;
    1049           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1050             :   }
    1051        3947 :   v = pari_var_create(ep);
    1052        3947 :   ep->valence = EpVAR;
    1053        3947 :   ep->value = initial_value(ep);
    1054        3947 :   return v;
    1055             : }
    1056             : 
    1057             : GEN
    1058           7 : fetch_var_value(long v, GEN t)
    1059             : {
    1060           7 :   entree *ep = varentries[v];
    1061           7 :   if (!ep) return NULL;
    1062           7 :   if (t)
    1063             :   {
    1064           7 :     long vn = localvars_find(t,ep);
    1065           7 :     if (vn) return get_lex(vn);
    1066             :   }
    1067           7 :   return (GEN)ep->value;
    1068             : }
    1069             : 
    1070             : void
    1071           0 : name_var(long n, const char *s)
    1072             : {
    1073             :   entree *ep;
    1074             :   char *u;
    1075             : 
    1076           0 :   if (n < pari_var_next())
    1077           0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1078           0 :   if (n > (long)MAXVARN)
    1079           0 :     pari_err_OVERFLOW("variable number");
    1080             : 
    1081           0 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1082           0 :   u = (char *)initial_value(ep);
    1083           0 :   ep->valence = EpVAR;
    1084           0 :   ep->name = u; strcpy(u,s);
    1085           0 :   ep->value = gen_0; /* in case geval is called */
    1086           0 :   varentries_reset(n, ep);
    1087           0 : }
    1088             : 
    1089             : static int
    1090        5150 : cmp_by_var(void *E,GEN x, GEN y)
    1091        5150 : { (void)E; return varncmp((long)x,(long)y); }
    1092             : GEN
    1093        1211 : vars_sort_inplace(GEN z)
    1094        1211 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1095             : GEN
    1096         175 : vars_to_RgXV(GEN h)
    1097             : {
    1098         175 :   long i, l = lg(h);
    1099         175 :   GEN z = cgetg(l, t_VEC);
    1100        2086 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1101         175 :   return z;
    1102             : }
    1103             : GEN
    1104        1183 : gpolvar(GEN x)
    1105             : {
    1106             :   long v;
    1107        1183 :   if (!x) {
    1108         140 :     GEN h = hash_values(h_polvar);
    1109         140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1110             :   }
    1111        1043 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1112        1036 :   v = gvar(x);
    1113        1036 :   if (v==NO_VARIABLE) return gen_0;
    1114         980 :   return pol_x(v);
    1115             : }
    1116             : 
    1117             : static void
    1118     2646958 : fill_hashtable_single(entree **table, entree *ep)
    1119             : {
    1120     2646958 :   EpSETSTATIC(ep);
    1121     2646958 :   insertep(ep, table, hash_str(ep->name));
    1122     2646958 :   if (ep->code) ep->arity = check_proto(ep->code);
    1123     2646958 :   ep->pvalue = NULL;
    1124     2646958 : }
    1125             : 
    1126             : void
    1127        5606 : pari_fill_hashtable(entree **table, entree *ep)
    1128             : {
    1129     2652564 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1130        5606 : }
    1131             : 
    1132             : void
    1133           0 : pari_add_function(entree *ep)
    1134             : {
    1135           0 :   fill_hashtable_single(functions_hash, ep);
    1136           0 : }
    1137             : 
    1138             : /********************************************************************/
    1139             : /**                                                                **/
    1140             : /**                        SIMPLE GP FUNCTIONS                     **/
    1141             : /**                                                                **/
    1142             : /********************************************************************/
    1143             : 
    1144             : GEN
    1145          28 : arity0(GEN C)
    1146             : {
    1147          28 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("arity", C);
    1148          28 :   return utoi(closure_arity(C));
    1149             : }
    1150             : 
    1151             : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1152             : 
    1153             : entree *
    1154     9767288 : do_alias(entree *ep)
    1155             : {
    1156     9767344 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1157     9767288 :   return ep;
    1158             : }
    1159             : 
    1160             : void
    1161          28 : alias0(const char *s, const char *old)
    1162             : {
    1163             :   entree *ep, *e;
    1164             :   GEN x;
    1165             : 
    1166          28 :   ep = fetch_entry(old);
    1167          28 :   e  = fetch_entry(s);
    1168          28 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1169           0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1170          28 :   freeep(e);
    1171          28 :   x = cgetg_block(2, t_VECSMALL); gel(x,1) = (GEN)ep;
    1172          28 :   e->value=x; e->valence=EpALIAS;
    1173          28 : }
    1174             : 
    1175             : GEN
    1176    13077647 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1177             : {
    1178    13077647 :   if (gequal0(g)) /* false */
    1179    10051120 :     return b? closure_evalgen(b): gnil;
    1180             :   else /* true */
    1181     3026527 :     return a? closure_evalgen(a): gnil;
    1182             : }
    1183             : 
    1184             : void
    1185    41473140 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1186             : {
    1187    41473140 :   if (gequal0(g)) /* false */
    1188    40680270 :   { if (b) closure_evalvoid(b); }
    1189             :   else /* true */
    1190      792870 :   { if (a) closure_evalvoid(a); }
    1191    41473119 : }
    1192             : 
    1193             : GEN
    1194       31325 : ifpari_multi(GEN g, GEN a/*closure*/)
    1195             : {
    1196       31325 :   long i, nb = lg(a)-1;
    1197       31325 :   if (!gequal0(g)) /* false */
    1198        6713 :     return closure_evalgen(gel(a,1));
    1199       42098 :   for(i=2;i<nb;i+=2)
    1200             :   {
    1201       24724 :     GEN g = closure_evalgen(gel(a,i));
    1202       24724 :     if (!g) return g;
    1203       24717 :     if (!gequal0(g))
    1204        7231 :       return closure_evalgen(gel(a,i+1));
    1205             :   }
    1206       17374 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1207             : }
    1208             : 
    1209             : GEN
    1210    64287451 : andpari(GEN a, GEN b/*closure*/)
    1211             : {
    1212             :   GEN g;
    1213    64287451 :   if (gequal0(a))
    1214    53970190 :     return gen_0;
    1215    10317261 :   g=closure_evalgen(b);
    1216    10317261 :   if (!g) return g;
    1217    10317261 :   return gequal0(g)?gen_0:gen_1;
    1218             : }
    1219             : 
    1220             : GEN
    1221    16723451 : orpari(GEN a, GEN b/*closure*/)
    1222             : {
    1223             :   GEN g;
    1224    16723451 :   if (!gequal0(a))
    1225      338407 :     return gen_1;
    1226    16385044 :   g=closure_evalgen(b);
    1227    16385044 :   if (!g) return g;
    1228    16385044 :   return gequal0(g)?gen_0:gen_1;
    1229             : }
    1230             : 
    1231      178691 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1232          56 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1233           7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1234           7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1235           7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1236           7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1237           7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1238      536517 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1239    25685195 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addiu(*x,1):gaddgs(*x,1); return *x; }
    1240    15455370 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1241       20965 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subiu(*x,1):gsubgs(*x,1); return *x; }
    1242             : 
    1243        1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }

Generated by: LCOV version 1.16