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.16.2 lcov report (development 29115-f22e516b23) Lines: 636 693 91.8 %
Date: 2024-04-22 08:08:03 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((unsigned char)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((unsigned char)*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((unsigned char)*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((unsigned char)*arg)) arg++;
     111          36 :     if (*arg && !ispunct((unsigned char)*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     2595863 : insertep(entree *ep, entree **table, ulong hash)
     124             : {
     125     2595863 :   ep->hash = hash;
     126     2595863 :   hash %= functions_tblsz;
     127     2595863 :   ep->next = table[hash];
     128     2595863 :   table[hash] = ep;
     129     2595863 : }
     130             : 
     131             : static entree *
     132       34034 : initep(const char *name, long len)
     133             : {
     134       34034 :   const long add = 4*sizeof(long);
     135       34034 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     136       34034 :   entree *ep1 = initial_value(ep);
     137       34034 :   char *u = (char *) ep1 + add;
     138       34034 :   ep->name    = u; memcpy(u, name,len); u[len]=0;
     139       34034 :   ep->valence = EpNEW;
     140       34034 :   ep->value   = NULL;
     141       34034 :   ep->menu    = 0;
     142       34034 :   ep->code    = NULL;
     143       34034 :   ep->help    = NULL;
     144       34034 :   ep->pvalue  = NULL;
     145       34034 :   ep->arity   = 0;
     146       34034 :   return ep;
     147             : }
     148             : 
     149             : /* Look for s of length len in T; if 'insert', insert if missing */
     150             : static entree *
     151    18151275 : findentry(const char *s, long len, entree **T, int insert)
     152             : {
     153    18151275 :   ulong hash = hash_str_len(s, len);
     154             :   entree *ep;
     155   172845025 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     156   172811062 :     if (ep->hash == hash)
     157             :     {
     158    18117437 :       const char *t = ep->name;
     159    18117437 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     160             :     }
     161             :   /* not found */
     162       33963 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     163       33973 :   return ep;
     164             : }
     165             : entree *
     166         944 : pari_is_default(const char *s)
     167         944 : { return findentry(s, strlen(s), defaults_hash, 0); }
     168             : entree *
     169     8158249 : is_entry(const char *s)
     170     8158249 : { return findentry(s, strlen(s), functions_hash, 0); }
     171             : entree *
     172     9992079 : fetch_entry_raw(const char *s, long len)
     173     9992079 : { return findentry(s, len, functions_hash, 1); }
     174             : entree *
     175      448919 : 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      803780 : readseq_i(char *t)
     184             : {
     185      803780 :   if (gp_meta(t,0)) return gnil;
     186      803780 :   return closure_evalres(pari_compile_str(t));
     187             : }
     188             : GEN
     189      803780 : readseq(char *t)
     190      803780 : { 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     2538170 : isreturn(char c)
     218     2538170 : { 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      503224 : is_long(const char *s)
     224             : {
     225      503224 :   while (isspace((unsigned char)*s)) s++;
     226      503224 :   if (*s == '+' || *s == '-') s++;
     227     1008274 :   while (isdigit((unsigned char)*s)) s++;
     228      503224 :   return *s == ',';
     229             : }
     230             : /* if is known that 2 commas follow s; base-10 unsigned integer followed
     231             :  * by comma? */
     232             : static int
     233        1842 : is_ulong(const char *s)
     234             : {
     235        1842 :   while (isspace((unsigned char)*s)) s++;
     236        1842 :   if (*s == '+') s++;
     237        3676 :   while (isdigit((unsigned char)*s)) s++;
     238        1842 :   return *s == ',';
     239             : }
     240             : static long
     241     2538170 : check_proto(const char *code)
     242             : {
     243     2538170 :   long arity = 0;
     244     2538170 :   const char *s = code;
     245     2538170 :   if (isreturn(*s)) s++;
     246     8604608 :   while (*s && *s != '\n') switch (*s++)
     247             :   {
     248     4423124 :     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     4423124 :       arity++; break;
     264      140910 :     case 'E':
     265             :     case 's':
     266      140910 :       if (*s == '*') s++;
     267      140910 :       arity++; break;
     268     1312096 :     case 'D':
     269     1312096 :       switch(*s)
     270             :       {
     271      761280 :         case 'G': case '&': case 'n': case 'I': case 'E':
     272      761280 :         case 'P': case 's': case 'r': s++; arity++; break;
     273       20130 :         case 'V': s++; break;
     274           0 :         case 0:
     275           0 :           pari_err(e_SYNTAX,"function has incomplete prototype", s,code);
     276           0 :           break;
     277      530686 :         default:
     278             :         {
     279             :           const char *p;
     280             :           long i;
     281     2686382 :           for(i = 0, p = s; *p && i < 2; p++) i += *p==','; /* skip 2 commas */
     282      530686 :           if (i < 2) pari_err(e_SYNTAX,"missing comma",s,code);
     283      530686 :           arity++;
     284      530686 :           switch(p[-2])
     285             :           {
     286      503224 :             case 'L':
     287      503224 :               if (!is_long(s)) pari_err(e_SYNTAX,"not a long",s,code);
     288      503220 :               break;
     289        1842 :             case 'U':
     290        1842 :               if (!is_ulong(s)) pari_err(e_SYNTAX,"not an ulong",s,code);
     291        1834 :               break;
     292       25620 :             case 'G': case 'r': case 's': case 'M':
     293       25620 :               break;
     294           0 :             default: pari_err(e_SYNTAX,"incorrect type",s-2,code);
     295             :           }
     296      530674 :           s = p;
     297             :         }
     298             :       }
     299     1312084 :       break;
     300      190320 :     case 'V':
     301             :     case '=':
     302      190320 :     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     2538158 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     310     2538158 :   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, 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    49028180 : ishex(const char **s)
     390             : {
     391    49028180 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
     392             :   {
     393         130 :     *s += 2;
     394         130 :     return 1;
     395             :   }
     396             :   else
     397    49028050 :     return 0;
     398             : }
     399             : 
     400             : static int
     401    49028236 : isbin(const char **s)
     402             : {
     403    49028236 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
     404             :   {
     405          56 :     *s += 2;
     406          56 :     return 1;
     407             :   }
     408             :   else
     409    49028180 :     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     3789420 : dec_number_len(const char *s, long B)
     482             : {
     483     3789420 :   ulong m = 0;
     484             :   long n;
     485    58689044 :   for (n = 0; n < B; n++,s++)
     486    54899624 :     m = 10*m + (*s - '0');
     487     3789420 :   return m;
     488             : }
     489             : 
     490             : static GEN
     491      872527 : dec_strtoi_len(const char *s, long n)
     492             : {
     493      872527 :   const long B = MAX_DIGITS;
     494      872527 :   long i, l = (n+B-1)/B;
     495      872527 :   GEN V = cgetg(l+1, t_VECSMALL);
     496     3789420 :   for (i=1; i<l; i++)
     497     2916893 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     498      872527 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     499      872527 :   return fromdigitsu(V, powuu(10, B));
     500             : }
     501             : 
     502             : static GEN
     503      872527 : dec_read_more(const char **ps)
     504             : {
     505      872527 :   pari_sp av = avma;
     506      872527 :   const char *s = *ps;
     507    55772151 :   while (isdigit((unsigned char)**ps)) (*ps)++;
     508      872527 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     509             : }
     510             : 
     511             : static ulong
     512    11901558 : number(int *n, const char **s)
     513             : {
     514    11901558 :   ulong m = 0;
     515    53805034 :   for (*n = 0; *n < MAX_DIGITS && isdigit((unsigned char)**s); (*n)++,(*s)++)
     516    41903476 :     m = 10*m + (**s - '0');
     517    11901558 :   return m;
     518             : }
     519             : 
     520             : static GEN
     521    11825958 : dec_read(const char **s)
     522             : {
     523             :   int nb;
     524    11825958 :   ulong y  = number(&nb, s);
     525    11825958 :   if (nb < MAX_DIGITS)
     526    10953431 :     return utoi(y);
     527      872527 :   *s -= MAX_DIGITS;
     528      872527 :   return dec_read_more(s);
     529             : }
     530             : 
     531             : static GEN
     532        4514 : real_read_more(GEN y, const char **ps)
     533             : {
     534        4514 :   pari_sp av = avma;
     535        4514 :   const char *s = *ps;
     536        4514 :   GEN z = dec_read(ps);
     537        4514 :   long e = *ps-s;
     538        4514 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     539             : }
     540             : 
     541             : static long
     542       75600 : exponent(const char **pts)
     543             : {
     544       75600 :   const char *s = *pts;
     545             :   long n;
     546             :   int nb;
     547       75600 :   switch(*++s)
     548             :   {
     549       75425 :     case '-': s++; n = -(long)number(&nb, &s); break;
     550           0 :     case '+': s++; /* Fall through */
     551         175 :     default: n = (long)number(&nb, &s);
     552             :   }
     553       75600 :   *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       85436 : real_read(pari_sp av, const char **s, GEN y, long prec)
     564             : {
     565       85436 :   long l, n = 0;
     566       85436 :   switch(**s)
     567             :   {
     568           0 :     default: return y; /* integer */
     569       11117 :     case '.':
     570             :     {
     571       11117 :       const char *old = ++*s;
     572       11117 :       if (isalpha((unsigned char)**s) || **s=='.')
     573             :       {
     574        1253 :         if (**s == 'E' || **s == 'e') {
     575        1253 :           n = exponent(s);
     576        1253 :           if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     577        1204 :           break;
     578             :         }
     579           0 :         --*s; return y; /* member */
     580             :       }
     581        9864 :       if (isdigit((unsigned char)**s)) y = real_read_more(y, s);
     582        9864 :       n = old - *s;
     583        9864 :       if (**s != 'E' && **s != 'e')
     584             :       {
     585        9836 :         if (!signe(y)) { set_avma(av); return real_0(prec); }
     586        8590 :         break;
     587             :       }
     588             :     }
     589             :     /* Fall through */
     590             :     case 'E': case 'e':
     591       74347 :       n += exponent(s);
     592       74347 :       if (!signe(y)) { set_avma(av); return real_0_digits(n); }
     593             :   }
     594       83994 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     595       83994 :   if (l < prec) l = prec; else prec = l;
     596       83994 :   if (!n) return itor(y, prec);
     597       79183 :   incrprec(l);
     598       79183 :   y = itor(y, l);
     599       79183 :   if (n > 0)
     600          77 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     601             :   else
     602       79106 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     603       79183 :   return gerepileuptoleaf(av, rtor(y, prec));
     604             : }
     605             : 
     606             : static GEN
     607    11736110 : int_read(const char **s)
     608             : {
     609             :   GEN y;
     610    11736110 :   if (isbin(s))
     611          28 :     y = bin_read(s);
     612    11736082 :   else if (ishex(s))
     613          74 :     y = hex_read(s);
     614             :   else
     615    11736008 :     y = dec_read(s);
     616    11736110 :   return y;
     617             : }
     618             : 
     619             : GEN
     620    11736110 : strtoi(const char *s) { return int_read(&s); }
     621             : 
     622             : GEN
     623       85436 : strtor(const char *s, long prec)
     624             : {
     625       85436 :   pari_sp av = avma;
     626       85436 :   GEN y = dec_read(&s);
     627       85436 :   y = real_read(av, &s, y, prec);
     628       85436 :   if (typ(y) == t_REAL) return y;
     629           0 :   return gerepileuptoleaf(av, itor(y, prec));
     630             : }
     631             : 
     632             : static void
     633    11744319 : skipdigits(char **lex) {
     634    93012404 :   while (isdigit((unsigned char)**lex)) ++*lex;
     635    11744319 : }
     636             : 
     637             : static int
     638    11737729 : skipexponent(char **lex)
     639             : {
     640    11737729 :   char *old=*lex;
     641    11737729 :   if ((**lex=='e' || **lex=='E'))
     642             :   {
     643        1092 :     ++*lex;
     644        1092 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     645        1092 :     if (!isdigit((unsigned char)**lex))
     646             :     {
     647         469 :       *lex=old;
     648         469 :       return KINTEGER;
     649             :     }
     650         623 :     skipdigits(lex);
     651         623 :     return KREAL;
     652             :   }
     653    11736637 :   return KINTEGER;
     654             : }
     655             : 
     656             : static int
     657    11739149 : skipconstante(char **lex)
     658             : {
     659    11739149 :   skipdigits(lex);
     660    11739149 :   if (**lex=='.')
     661             :   {
     662       18441 :     char *old = ++*lex;
     663       18441 :     if (**lex == '.') { --*lex; return KINTEGER; }
     664       17021 :     if (isalpha((unsigned char)**lex))
     665             :     {
     666       12474 :       skipexponent(lex);
     667       12474 :       if (*lex == old)
     668             :       {
     669       12397 :         --*lex; /* member */
     670       12397 :         return KINTEGER;
     671             :       }
     672          77 :       return KREAL;
     673             :     }
     674        4547 :     skipdigits(lex);
     675        4547 :     skipexponent(lex);
     676        4547 :     return KREAL;
     677             :   }
     678    11720708 :   return skipexponent(lex);
     679             : }
     680             : 
     681             : static void
     682      843673 : skipstring(char **lex)
     683             : {
     684     6719015 :   while (**lex)
     685             :   {
     686     6719663 :     while (**lex == '\\') *lex+=2;
     687     6719015 :     if (**lex == '"')
     688             :     {
     689      843673 :       if ((*lex)[1] != '"') break;
     690           0 :       *lex += 2; continue;
     691             :     }
     692     5875342 :     (*lex)++;
     693             :   }
     694      843673 : }
     695             : 
     696             : int
     697    39615887 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     698             : {
     699             :   (void) yylval;
     700    39615887 :   yylloc->start=*lex;
     701    39615887 :   if (!**lex)
     702             :   {
     703      927069 :     yylloc->end=*lex;
     704      927069 :     return 0;
     705             :   }
     706    38688818 :   if (isalpha((unsigned char)**lex))
     707             :   {
     708     2403805 :     while (is_keyword_char(**lex)) ++*lex;
     709      539153 :     yylloc->end=*lex;
     710      539153 :     return KENTRY;
     711             :   }
     712    38149665 :   if (**lex=='"')
     713             :   {
     714      843673 :     ++*lex;
     715      843673 :     skipstring(lex);
     716      843673 :     if (!**lex)
     717           0 :       compile_err("run-away string",*lex-1);
     718      843673 :     ++*lex;
     719      843673 :     yylloc->end=*lex;
     720      843673 :     return KSTRING;
     721             :   }
     722    37305992 :   if (**lex == '.')
     723             :   {
     724             :     int token;
     725       13866 :     if ((*lex)[1]== '.')
     726             :     {
     727        1448 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     728             :     }
     729       12418 :     token=skipconstante(lex);
     730       12418 :     if (token==KREAL)
     731             :     {
     732          21 :       yylloc->end = *lex;
     733          21 :       return token;
     734             :     }
     735       12397 :     ++*lex;
     736       12397 :     yylloc->end=*lex;
     737       12397 :     return '.';
     738             :   }
     739    37292126 :   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    37292098 :   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    37292042 :   if (isdigit((unsigned char)**lex))
     752             :   {
     753    11726731 :     int token=skipconstante(lex);
     754    11726731 :     yylloc->end = *lex;
     755    11726731 :     return token;
     756             :   }
     757    25565311 :   if ((*lex)[1]=='=')
     758       27448 :     switch (**lex)
     759             :     {
     760       10676 :     case '=':
     761       10676 :       if ((*lex)[2]=='=')
     762         343 :       { *lex+=3; yylloc->end = *lex; return KID; }
     763             :       else
     764       10333 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     765         111 :     case '>':
     766         111 :       *lex+=2; yylloc->end = *lex; return KGE;
     767         237 :     case '<':
     768         237 :       *lex+=2; yylloc->end = *lex; return KLE;
     769         188 :     case '*':
     770         188 :       *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        2100 :     case '!':
     777        2100 :       if ((*lex)[2]=='=') break;
     778        2100 :       *lex+=2; yylloc->end = *lex; return KNE;
     779           7 :     case '\\':
     780           7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     781         222 :     case '+':
     782         222 :       *lex+=2; yylloc->end = *lex; return KPE;
     783          63 :     case '-':
     784          63 :       *lex+=2; yylloc->end = *lex; return KSE;
     785             :     }
     786    25551665 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
     787             :   {
     788        4086 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     789             :   }
     790    25547579 :   if (**lex=='-' && (*lex)[1]=='>')
     791             :   {
     792        1276 :     *lex+=2; yylloc->end = *lex; return KARROW;
     793             :   }
     794    25546303 :   if (**lex=='<' && (*lex)[1]=='>')
     795             :   {
     796           0 :     *lex+=2; yylloc->end = *lex; return KNE;
     797             :   }
     798    25546303 :   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    25546268 :   if ((*lex)[1]==**lex)
     807     2327900 :     switch (**lex)
     808             :     {
     809         760 :     case '&':
     810         760 :       *lex+=2; yylloc->end = *lex; return KAND;
     811         399 :     case '|':
     812         399 :       *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    25544716 :   yylloc->end = *lex+1;
     826    25544716 :   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      451582 : varstate_save(struct pari_varstate *s)
     841             : {
     842      451582 :   s->nvar = nvar;
     843      451582 :   s->max_avail = max_avail;
     844      451582 :   s->max_priority = max_priority;
     845      451582 :   s->min_priority = min_priority;
     846      451582 : }
     847             : 
     848             : static void
     849        9010 : varentries_set(long v, entree *ep)
     850             : {
     851        9010 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     852        9010 :   varentries[v] = ep;
     853        9010 : }
     854             : static int
     855        2982 : _given_value(void *E, hashentry *e) { return e->val == E; }
     856             : 
     857             : static void
     858       15343 : varentries_unset(long v)
     859             : {
     860       15343 :   entree *ep = varentries[v];
     861       15343 :   if (ep)
     862             :   {
     863        2982 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     864             :         _given_value);
     865        2982 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     866        2982 :     varentries[v] = NULL;
     867        2982 :     pari_free(e);
     868        2982 :     if (v <= nvar && ep == is_entry(ep->name))
     869        2975 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     870        2975 :       GEN p = (GEN)initial_value(ep);
     871        2975 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     872        2975 :       *p = 0;
     873             :     }
     874             :     else /* from name_var() or a direct pari_var_create() */
     875           7 :       pari_free(ep);
     876             :  }
     877       15343 : }
     878             : static void
     879         111 : varentries_reset(long v, entree *ep)
     880             : {
     881         111 :   varentries_unset(v);
     882         111 :   varentries_set(v, ep);
     883         111 : }
     884             : 
     885             : static void
     886      328388 : var_restore(struct pari_varstate *s)
     887             : {
     888      328388 :   nvar = s->nvar;
     889      328388 :   max_avail = s->max_avail;
     890      328388 :   max_priority = s->max_priority;
     891      328388 :   min_priority = s->min_priority;
     892      328388 : }
     893             : 
     894             : void
     895       12229 : varstate_restore(struct pari_varstate *s)
     896             : {
     897             :   long i;
     898       27440 :   for (i = nvar; i >= s->nvar; i--)
     899             :   {
     900       15211 :     varentries_unset(i);
     901       15211 :     varpriority[i] = -i;
     902             :   }
     903       12250 :   for (i = max_avail+1; i <= s->max_avail; i++)
     904             :   {
     905          21 :     varentries_unset(i);
     906          21 :     varpriority[i] = -i;
     907             :   }
     908       12229 :   var_restore(s);
     909       12229 : }
     910             : 
     911             : void
     912      316184 : pari_set_varstate(long *vp, struct pari_varstate *vs)
     913             : {
     914      316184 :   var_restore(vs);
     915      316093 :   varpriority = (long*)newblock(MAXVARN+2) + 1;
     916      315883 :   memcpy(varpriority-1,vp-1,(MAXVARN+2)*sizeof(long));
     917      315883 : }
     918             : 
     919             : /* must come before destruction of functions_hash */
     920             : void
     921        1820 : pari_var_close(void)
     922             : {
     923        1820 :   GEN h = hash_values(h_polvar);
     924        1820 :   long i, l = lg(h);
     925        7828 :   for (i = 1; i < l; i++)
     926             :   {
     927        6008 :     long v = h[i];
     928        6008 :     entree *ep = varentries[v];
     929        6008 :     if (ep && ep != is_entry(ep->name)) pari_free(ep);
     930             :   }
     931        1820 :   free((void*)varentries);
     932        1820 :   free((void*)(varpriority-1));
     933        1820 :   hash_destroy(h_polvar);
     934        1820 : }
     935             : 
     936             : void
     937        1830 : pari_var_init(void)
     938             : {
     939             :   long i;
     940        1830 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
     941        1830 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
     942        1830 :   varpriority[-1] = 1-LONG_MAX;
     943        1830 :   h_polvar = hash_create_str(100, 0);
     944        1830 :   nvar = 0; max_avail = MAXVARN;
     945        1830 :   max_priority = min_priority = 0;
     946        1830 :   (void)fetch_user_var("x");
     947        1830 :   (void)fetch_user_var("y");
     948             :   /* initialize so that people can use pol_x(i) directly */
     949   107542746 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
     950             :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
     951        1830 :   nvar = 10;
     952        1830 :   min_priority = -MAXVARN;
     953        1830 : }
     954           8 : long pari_var_next(void) { return nvar; }
     955           0 : long pari_var_next_temp(void) { return max_avail; }
     956             : long
     957      478873 : pari_var_create(entree *ep)
     958             : {
     959      478873 :   GEN p = (GEN)initial_value(ep);
     960             :   long v;
     961      478873 :   if (*p) return varn(p);
     962        8899 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     963        8899 :   v = nvar++;
     964             :   /* set p = pol_x(v) */
     965        8899 :   p[0] = evaltyp(t_POL) | _evallg(4);
     966        8899 :   p[1] = evalsigne(1) | evalvarn(v);
     967        8899 :   gel(p,2) = gen_0;
     968        8899 :   gel(p,3) = gen_1;
     969        8899 :   varentries_set(v, ep);
     970        8899 :   varpriority[v]= min_priority--;
     971        8899 :   return v;
     972             : }
     973             : 
     974             : long
     975      383462 : delete_var(void)
     976             : { /* user wants to delete one of his/her/its variables */
     977      383462 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
     978      382832 :   max_avail++;
     979      382832 :   if      (varpriority[max_avail] == min_priority) min_priority++;
     980      382832 :   else if (varpriority[max_avail] == max_priority) max_priority--;
     981      382832 :   return max_avail+1;
     982             : }
     983             : long
     984      100784 : fetch_var(void)
     985             : {
     986      100784 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     987      100784 :   varpriority[max_avail] = min_priority--;
     988      100784 :   return max_avail--;
     989             : }
     990             : long
     991      285981 : fetch_var_higher(void)
     992             : {
     993      285981 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
     994      285981 :   varpriority[max_avail] = ++max_priority;
     995      285981 :   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         111 : var_register(long v, const char *s)
    1007             : {
    1008         111 :   varentries_reset(v, initep(s, strlen(s)));
    1009         111 :   return pol_x(v);
    1010             : }
    1011             : GEN
    1012          98 : varhigher(const char *s, long w)
    1013             : {
    1014             :   long v;
    1015          98 :   if (w >= 0)
    1016             :   {
    1017          49 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1018          49 :     if (e) return pol_x((long)e->val);
    1019             :   }
    1020             :   /* no luck: need to create */
    1021          84 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1022          84 :   v = nvar++;
    1023          84 :   varpriority[v]= ++max_priority;
    1024          84 :   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      448805 : fetch_user_var(const char *s)
    1042             : {
    1043      448805 :   entree *ep = fetch_entry(s);
    1044             :   long v;
    1045      448805 :   switch (EpVALENCE(ep))
    1046             :   {
    1047      444942 :     case EpVAR: return pari_var_create(ep);
    1048        3863 :     case EpNEW: break;
    1049           0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1050             :   }
    1051        3863 :   v = pari_var_create(ep);
    1052        3863 :   ep->valence = EpVAR;
    1053        3863 :   ep->value = initial_value(ep);
    1054        3863 :   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        1197 : vars_sort_inplace(GEN z)
    1094        1197 : { 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     2561940 : fill_hashtable_single(entree **table, entree *ep)
    1119             : {
    1120     2561940 :   EpSETSTATIC(ep);
    1121     2561940 :   insertep(ep, table, hash_str(ep->name));
    1122     2561940 :   if (ep->code) ep->arity = check_proto(ep->code);
    1123     2561940 :   ep->pvalue = NULL;
    1124     2561940 : }
    1125             : 
    1126             : void
    1127        5480 : pari_fill_hashtable(entree **table, entree *ep)
    1128             : {
    1129     2567420 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1130        5480 : }
    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     9580213 : do_alias(entree *ep)
    1155             : {
    1156     9580269 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1157     9580213 :   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    13075701 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1177             : {
    1178    13075701 :   if (gequal0(g)) /* false */
    1179    10049740 :     return b? closure_evalgen(b): gnil;
    1180             :   else /* true */
    1181     3025961 :     return a? closure_evalgen(a): gnil;
    1182             : }
    1183             : 
    1184             : void
    1185    41465702 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1186             : {
    1187    41465702 :   if (gequal0(g)) /* false */
    1188    40674213 :   { if (b) closure_evalvoid(b); }
    1189             :   else /* true */
    1190      791489 :   { if (a) closure_evalvoid(a); }
    1191    41465681 : }
    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    64280934 : andpari(GEN a, GEN b/*closure*/)
    1211             : {
    1212             :   GEN g;
    1213    64280934 :   if (gequal0(a))
    1214    53968188 :     return gen_0;
    1215    10312746 :   g=closure_evalgen(b);
    1216    10312746 :   if (!g) return g;
    1217    10312746 :   return gequal0(g)?gen_0:gen_1;
    1218             : }
    1219             : 
    1220             : GEN
    1221    16719531 : orpari(GEN a, GEN b/*closure*/)
    1222             : {
    1223             :   GEN g;
    1224    16719531 :   if (!gequal0(a))
    1225      337275 :     return gen_1;
    1226    16382256 :   g=closure_evalgen(b);
    1227    16382256 :   if (!g) return g;
    1228    16382256 :   return gequal0(g)?gen_0:gen_1;
    1229             : }
    1230             : 
    1231      178215 : 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      534445 : 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       20881 : 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.14