Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - language - anal.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.8.0 lcov report (development 19053-42ab05e) Lines: 661 743 89.0 %
Date: 2016-06-29 Functions: 100 102 98.0 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 394 552 71.4 %

           Branch data     Line data    Source code
       1                 :            : /* Copyright (C) 2000  The PARI group.
       2                 :            : 
       3                 :            : This file is part of the PARI/GP package.
       4                 :            : 
       5                 :            : PARI/GP is free software; you can redistribute it and/or modify it under the
       6                 :            : terms of the GNU General Public License as published by the Free Software
       7                 :            : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8                 :            : ANY WARRANTY WHATSOEVER.
       9                 :            : 
      10                 :            : Check the License for details. You should have received a copy of it, along
      11                 :            : with the package; see the file 'COPYING'. If not, write to the Free Software
      12                 :            : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13                 :            : 
      14                 :            : #include "pari.h"
      15                 :            : #include "paripriv.h"
      16                 :            : #include "anal.h"
      17                 :            : #include "parse.h"
      18                 :            : 
      19                 :            : /***************************************************************************
      20                 :            :  **                                                                       **
      21                 :            :  **                           Mnemonic codes parser                       **
      22                 :            :  **                                                                       **
      23                 :            :  ***************************************************************************/
      24                 :            : 
      25                 :            : /* TEMPLATE is assumed to be ";"-separated list of items.  Each item
      26                 :            :  * may have one of the following forms: id=value id==value id|value id&~value.
      27                 :            :  * Each id consists of alphanum characters, dashes and underscores.
      28                 :            :  * IDs are case-sensitive.
      29                 :            : 
      30                 :            :  * ARG consists of several IDs separated by punctuation (and optional
      31                 :            :  * whitespace).  Each modifies the return value in a "natural" way: an
      32                 :            :  * ID from id=value should be the first in the sequence and sets RETVAL to
      33                 :            :  * VALUE (and cannot be negated), ID from id|value bit-ORs RETVAL with
      34                 :            :  * VALUE (and bit-ANDs RETVAL with ~VALUE if negated), ID from
      35                 :            :  * id&~value behaves as if it were noid|value, ID from
      36                 :            :  * id==value behaves the same as id=value, but should come alone.
      37                 :            : 
      38                 :            :  * For items of the form id|value and id&~value negated forms are
      39                 :            :  * allowed: either when arg looks like no[-_]id, or when id looks like
      40                 :            :  * this, and arg is not-negated. */
      41                 :            : 
      42                 :            : enum { A_ACTION_ASSIGN, A_ACTION_SET, A_ACTION_UNSET };
      43                 :            : #define IS_ID(c)        (isalnum((int)c) || ((c) == '_') || ((c) == '-'))
      44                 :            : 
      45                 :            : long
      46                 :       5584 : eval_mnemonic(GEN str, const char *tmplate)
      47                 :            : {
      48                 :       5584 :   pari_sp av=avma;
      49                 :       5584 :   ulong retval = 0;
      50                 :       5584 :   const char *etmplate = NULL;
      51                 :            :   const char *arg;
      52                 :            : 
      53         [ -  + ]:       5584 :   if (typ(str)==t_INT) return itos(str);
      54         [ -  + ]:       5584 :   if (typ(str)!=t_STR) pari_err_TYPE("eval_mnemonic",str);
      55                 :            : 
      56                 :       5584 :   arg=GSTR(str);
      57                 :       5584 :   etmplate = strchr(tmplate, '\n');
      58         [ +  - ]:       5584 :   if (!etmplate)
      59                 :       5584 :     etmplate = tmplate + strlen(tmplate);
      60                 :            : 
      61                 :            :   while (1)
      62                 :            :   {
      63                 :            :     long numarg;
      64                 :            :     const char *e, *id;
      65                 :            :     const char *negated;                /* action found with 'no'-ID */
      66                 :            :     int negate;                 /* Arg has 'no' prefix removed */
      67                 :      13192 :     ulong l, action = 0, first = 1, singleton = 0;
      68                 :            :     char *buf, *inibuf;
      69                 :            :     static char b[80];
      70                 :            : 
      71         [ -  + ]:      13192 :     while (isspace((int)*arg)) arg++;
      72         [ +  + ]:      13192 :     if (!*arg)
      73                 :       5584 :       break;
      74                 :       7608 :     e = arg;
      75 [ +  + ][ -  + ]:      76112 :     while (IS_ID(*e)) e++;
                 [ -  + ]
      76                 :            :     /* Now the ID is whatever is between arg and e. */
      77                 :       7608 :     l = e - arg;
      78         [ -  + ]:       7608 :     if (l >= sizeof(b))
      79                 :          0 :       pari_err(e_MISC,"id too long in a stringified flag");
      80         [ -  + ]:       7608 :     if (!l)                             /* Garbage after whitespace? */
      81                 :          0 :       pari_err(e_MISC,"a stringified flag does not start with an id");
      82                 :       7608 :     strncpy(b, arg, l);
      83                 :       7608 :     b[l] = 0;
      84                 :       7608 :     arg = e;
      85                 :       7608 :     e = inibuf = buf = b;
      86 [ +  - ][ -  + ]:       7608 :     while (('0' <= *e) && (*e <= '9'))
      87                 :          0 :       e++;
      88         [ -  + ]:       7608 :     if (*e == 0)
      89                 :          0 :       pari_err(e_MISC,"numeric id in a stringified flag");
      90                 :       7608 :     negate = 0;
      91                 :       7608 :     negated = NULL;
      92                 :            : find:
      93                 :       7608 :     id = tmplate;
      94 [ +  - ][ +  - ]:       7608 :     while ((id = strstr(id, buf)) && id < etmplate)
      95                 :            :     {
      96 [ +  - ][ +  - ]:       7608 :       if (IS_ID(id[l])) {       /* We do not allow abbreviations yet */
                 [ -  + ]
      97                 :          0 :         id += l;                /* False positive */
      98                 :          0 :         continue;
      99                 :            :       }
     100 [ +  + ][ +  - ]:       7608 :       if ((id >= tmplate + 2) && (IS_ID(id[-1])))
         [ +  - ][ -  + ]
     101                 :            :       {
     102                 :          0 :         const char *s = id;
     103                 :            : 
     104 [ #  # ][ #  # ]:          0 :         if ( !negate && s >= tmplate+3
     105 [ #  # ][ #  # ]:          0 :             && ((id[-1] == '_') || (id[-1] == '-')) )
     106                 :          0 :           s--;
     107                 :            :         /* Check whether we are preceeded by "no" */
     108         [ #  # ]:          0 :         if ( negate             /* buf initially started with "no" */
     109 [ #  # ][ #  # ]:          0 :             || (s < tmplate+2) || (s[-1] != 'o') || (s[-2] != 'n')
                 [ #  # ]
     110 [ #  # ][ #  # ]:          0 :             || (s >= tmplate+3 && IS_ID(s[-3]))) {
         [ #  # ][ #  # ]
     111                 :          0 :           id += l;              /* False positive */
     112                 :          0 :           continue;
     113                 :            :         }
     114                 :            :         /* Found noID in the template! */
     115                 :          0 :         id += l;
     116                 :          0 :         negated = id;
     117                 :          0 :         continue;               /* Try to find without 'no'. */
     118                 :            :       }
     119                 :            :       /* Found as is */
     120                 :       7608 :       id += l;
     121                 :       7608 :       break;
     122                 :            :     }
     123 [ -  + ][ #  # ]:       7608 :     if ( !id && !negated && !negate
                 [ #  # ]
     124 [ #  # ][ #  # ]:          0 :         && (l > 2) && buf[0] == 'n' && buf[1] == 'o' ) {
                 [ #  # ]
     125                 :            :       /* Try to find the flag without the prefix "no". */
     126                 :          0 :       buf += 2; l -= 2;
     127 [ #  # ][ #  # ]:          0 :       if ((buf[0] == '_') || (buf[0] == '-')) { buf++; l--; }
     128                 :          0 :       negate = 1;
     129         [ #  # ]:          0 :       if (buf[0])
     130                 :          0 :         goto find;
     131                 :            :     }
     132 [ -  + ][ #  # ]:       7608 :     if (!id && negated) /* Negated and AS_IS forms, prefer AS_IS */
     133                 :            :     {
     134                 :          0 :       id = negated;     /* Otherwise, use negated form */
     135                 :          0 :       negate = 1;
     136                 :            :     }
     137         [ -  + ]:       7608 :     if (!id)
     138                 :          0 :       pari_err(e_MISC,"Unrecognized id '%s' in a stringified flag", inibuf);
     139 [ -  + ][ #  # ]:       7608 :     if (singleton && !first)
     140                 :          0 :       pari_err(e_MISC,"Singleton id non-single in a stringified flag");
     141         [ -  + ]:       7608 :     if (id[0] == '=') {
     142         [ #  # ]:          0 :       if (negate)
     143                 :          0 :         pari_err(e_MISC,"Cannot negate id=value in a stringified flag");
     144         [ #  # ]:          0 :       if (!first)
     145                 :          0 :         pari_err(e_MISC,"Assign action should be first in a stringified flag");
     146                 :          0 :       action = A_ACTION_ASSIGN;
     147                 :          0 :       id++;
     148         [ #  # ]:          0 :       if (id[0] == '=') {
     149                 :          0 :         singleton = 1;
     150                 :          0 :         id++;
     151                 :            :       }
     152         [ -  + ]:       7608 :     } else if (id[0] == '^') {
     153         [ #  # ]:          0 :       if (id[1] != '~')
     154                 :          0 :         pari_err(e_MISC, "Unrecognized action in a template");
     155                 :          0 :       id += 2;
     156         [ #  # ]:          0 :       if (negate)
     157                 :          0 :         action = A_ACTION_SET;
     158                 :            :       else
     159                 :          0 :         action = A_ACTION_UNSET;
     160         [ +  - ]:       7608 :     } else if (id[0] == '|') {
     161                 :       7608 :       id++;
     162         [ -  + ]:       7608 :       if (negate)
     163                 :          0 :         action = A_ACTION_UNSET;
     164                 :            :       else
     165                 :       7608 :         action = A_ACTION_SET;
     166                 :            :     }
     167                 :            : 
     168                 :       7608 :     e = id;
     169                 :            : 
     170 [ +  - ][ +  + ]:      19248 :     while ((*e >= '0' && *e <= '9')) e++;
     171         [ -  + ]:       7608 :     while (isspace((int)*e))
     172                 :          0 :       e++;
     173 [ +  - ][ -  + ]:       7608 :     if (*e && (*e != ';') && (*e != ','))
                 [ #  # ]
     174                 :          0 :       pari_err(e_MISC, "Non-numeric argument of an action in a template");
     175                 :       7608 :     numarg = atol(id);          /* Now it is safe to get it... */
     176   [ +  -  -  - ]:       7608 :     switch (action) {
     177                 :            :     case A_ACTION_SET:
     178                 :       7608 :       retval |= numarg;
     179                 :       7608 :       break;
     180                 :            :     case A_ACTION_UNSET:
     181                 :          0 :       retval &= ~numarg;
     182                 :          0 :       break;
     183                 :            :     case A_ACTION_ASSIGN:
     184                 :          0 :       retval = numarg;
     185                 :          0 :       break;
     186                 :            :     default:
     187                 :          0 :       pari_err(e_MISC,"error in parse_option_string");
     188                 :            :     }
     189                 :       7608 :     first = 0;
     190         [ -  + ]:       7608 :     while (isspace((int)*arg))
     191                 :          0 :       arg++;
     192 [ +  + ][ +  - ]:       7608 :     if (*arg && !(ispunct((int)*arg) && *arg != '-'))
                 [ -  + ]
     193                 :          0 :       pari_err(e_MISC,"Junk after an id in a stringified flag");
     194                 :            :     /* Skip punctuation */
     195         [ +  + ]:       7608 :     if (*arg)
     196                 :       2024 :       arg++;
     197                 :       7608 :   }
     198                 :       5584 :   avma=av;
     199                 :       5584 :   return retval;
     200                 :            : }
     201                 :            : 
     202                 :            : /********************************************************************/
     203                 :            : /**                                                                **/
     204                 :            : /**                   HASH TABLE MANIPULATIONS                     **/
     205                 :            : /**                                                                **/
     206                 :            : /********************************************************************/
     207                 :            : /* return hashing value for identifier s */
     208                 :            : static ulong
     209                 :    2374472 : hashvalue(const char *s)
     210                 :            : {
     211                 :    2374472 :   ulong n = 0, c;
     212         [ +  + ]:   22668824 :   while ( (c = (ulong)*s++) ) n = (n<<1) ^ c;
     213                 :    2374472 :   return n;
     214                 :            : }
     215                 :            : 
     216                 :            : static ulong
     217                 :    5775867 : hashvalue_raw(const char *s, long len)
     218                 :            : {
     219                 :    5775867 :   long n = 0, i;
     220         [ +  + ]:   21620293 :   for(i=0; i<len; i++) { n = (n<<1) ^ *s; s++; }
     221                 :    5775867 :   return n;
     222                 :            : }
     223                 :            : 
     224                 :            : static void
     225                 :    2399642 : insertep(entree *ep, entree **table, ulong hash)
     226                 :            : {
     227                 :    2399642 :   ep->hash = hash;
     228                 :    2399642 :   hash %= functions_tblsz;
     229                 :    2399642 :   ep->next = table[hash];
     230                 :    2399642 :   table[hash] = ep;
     231                 :    2399642 : }
     232                 :            : 
     233                 :            : static entree *
     234                 :      25233 : initep(const char *name, long len)
     235                 :            : {
     236                 :      25233 :   const long add = 4*sizeof(long);
     237                 :      25233 :   entree *ep = (entree *) pari_calloc(sizeof(entree) + add + len+1);
     238                 :      25233 :   entree *ep1 = initial_value(ep);
     239                 :      25233 :   char *u = (char *) ep1 + add;
     240                 :      25233 :   ep->name    = u; strncpy(u, name,len); u[len]=0;
     241                 :      25233 :   ep->valence = EpNEW;
     242                 :      25233 :   ep->value   = NULL;
     243                 :      25233 :   ep->menu    = 0;
     244                 :      25233 :   ep->code    = NULL;
     245                 :      25233 :   ep->help    = NULL;
     246                 :      25233 :   ep->pvalue  = NULL;
     247                 :      25233 :   ep->arity   = 0;
     248                 :      25233 :   return ep;
     249                 :            : }
     250                 :            : 
     251                 :            : /* Look for s of length len in T; if 'insert', insert if missing */
     252                 :            : static entree *
     253                 :    5775867 : findentry(const char *s, long len, entree **T, int insert)
     254                 :            : {
     255                 :    5775867 :   ulong hash = hashvalue_raw(s, len);
     256                 :            :   entree *ep;
     257         [ +  + ]:   32595982 :   for (ep = T[hash % functions_tblsz]; ep; ep = ep->next)
     258         [ +  + ]:   32570763 :     if (ep->hash == hash)
     259                 :            :     {
     260                 :    5815863 :       const char *t = ep->name;
     261 [ +  + ][ +  - ]:    5815863 :       if (!strncmp(t, s, len) && !t[len]) return ep;
     262                 :            :     }
     263                 :            :   /* not found */
     264         [ +  + ]:      25219 :   if (insert) { ep = initep(s,len); insertep(ep, T, hash); }
     265                 :    5775867 :   return ep;
     266                 :            : }
     267                 :            : entree *
     268                 :        901 : pari_is_default(const char *s)
     269                 :        901 : { return findentry(s, strlen(s), defaults_hash, 0); }
     270                 :            : entree *
     271                 :     152597 : is_entry(const char *s)
     272                 :     152597 : { return findentry(s, strlen(s), functions_hash, 0); }
     273                 :            : entree *
     274                 :    5622369 : fetch_entry_raw(const char *s, long len)
     275                 :    5622369 : { return findentry(s, len, functions_hash, 1); }
     276                 :            : entree *
     277                 :       4814 : fetch_entry(const char *s) { return fetch_entry_raw(s, strlen(s)); }
     278                 :            : 
     279                 :            : /*******************************************************************/
     280                 :            : /*                                                                 */
     281                 :            : /*                  SYNTACTICAL ANALYZER FOR GP                    */
     282                 :            : /*                                                                 */
     283                 :            : /*******************************************************************/
     284                 :            : GEN
     285                 :       3353 : readseq(char *t)
     286                 :            : {
     287                 :       3353 :   pari_sp av = avma;
     288                 :            :   GEN x;
     289         [ -  + ]:       3353 :   if (gp_meta(t,0)) return gnil;
     290                 :       3353 :   x = pari_compile_str(t);
     291                 :       3353 :   return gerepileupto(av, closure_evalres(x));
     292                 :            : }
     293                 :            : 
     294                 :            : /* filtered readseq = remove blanks and comments */
     295                 :            : GEN
     296                 :          0 : gp_read_str(const char *s)
     297                 :            : {
     298                 :          0 :   char *t = gp_filter(s);
     299                 :          0 :   GEN x = readseq(t);
     300                 :          0 :   pari_free(t); return x;
     301                 :            : }
     302                 :            : 
     303                 :            : GEN
     304                 :      10108 : compile_str(const char *s)
     305                 :            : {
     306                 :      10108 :   char *t = gp_filter(s);
     307                 :      10108 :   GEN x = pari_compile_str(t);
     308                 :      10101 :   pari_free(t); return x;
     309                 :            : }
     310                 :            : 
     311                 :            : static long
     312                 :    2358071 : check_proto(const char *code)
     313                 :            : {
     314                 :    2358071 :   long arity = 0;
     315                 :    2358071 :   const char *s = code, *old;
     316 [ +  + ][ +  + ]:    2358071 :   if (*s == 'l' || *s == 'v' || *s == 'i' || *s == 'm' || *s == 'u') s++;
         [ +  + ][ +  + ]
                 [ -  + ]
     317   [ +  +  +  +  :    8986917 :   while (*s && *s != '\n') switch (*s++)
                -  -  - ]
         [ +  + ][ +  + ]
     318                 :            :   {
     319                 :            :     case '&':
     320                 :            :     case 'C':
     321                 :            :     case 'G':
     322                 :            :     case 'I':
     323                 :            :     case 'J':
     324                 :            :     case 'U':
     325                 :            :     case 'L':
     326                 :            :     case 'M':
     327                 :            :     case 'P':
     328                 :            :     case 'W':
     329                 :            :     case 'f':
     330                 :            :     case 'n':
     331                 :            :     case 'p':
     332                 :            :     case 'b':
     333                 :            :     case 'r':
     334                 :    4221558 :       arity++;
     335                 :    4221558 :       break;
     336                 :            :     case 'E':
     337                 :            :     case 's':
     338         [ +  + ]:     157048 :       if (*s == '*') s++;
     339                 :     157048 :       arity++;
     340                 :     157048 :       break;
     341                 :            :     case 'D':
     342 [ +  + ][ +  + ]:    1132152 :       if (*s == 'G' || *s == '&' || *s == 'n' || *s == 'I' || *s == 'E'
         [ +  + ][ +  + ]
                 [ +  + ]
     343 [ +  + ][ +  + ]:     520368 :                     || *s == 'V' || *s == 'P' || *s == 's' || *s == 'r')
         [ +  + ][ +  + ]
     344                 :            :       {
     345         [ +  + ]:     661008 :         if (*s != 'V') arity++;
     346                 :     661008 :         s++; break;
     347                 :            :       }
     348 [ +  - ][ +  + ]:     972760 :       old = s; while (*s && *s != ',') s++;
     349         [ -  + ]:     471144 :       if (*s != ',') pari_err(e_SYNTAX, "missing comma", old, code);
     350                 :     471144 :       break;
     351                 :            :     case 'V':
     352                 :            :     case '=':
     353                 :    1118088 :     case ',': break;
     354                 :          0 :     case '\n': break; /* Before the mnemonic */
     355                 :            : 
     356                 :            :     case 'm':
     357                 :            :     case 'l':
     358                 :            :     case 'i':
     359                 :          0 :     case 'v': pari_err(e_SYNTAX, "this code has to come first", s-1, code);
     360                 :          0 :     default: pari_err(e_SYNTAX, "unknown parser code", s-1, code);
     361                 :            :   }
     362         [ -  + ]:    2358071 :   if (arity > 20) pari_err_IMPL("functions with more than 20 parameters");
     363                 :    2358071 :   return arity;
     364                 :            : }
     365                 :            : static void
     366                 :          7 : check_name(const char *name)
     367                 :            : {
     368                 :          7 :   const char *s = name;
     369         [ +  - ]:          7 :   if (isalpha((int)*s))
     370         [ +  + ]:         35 :     while (is_keyword_char(*++s)) /* empty */;
     371         [ -  + ]:          7 :   if (*s) pari_err(e_SYNTAX,"not a valid identifier", s, name);
     372                 :          7 : }
     373                 :            : 
     374                 :            : entree *
     375                 :          7 : install(void *f, const char *name, const char *code)
     376                 :            : {
     377                 :          7 :   long arity = check_proto(code);
     378                 :            :   entree *ep;
     379                 :            : 
     380                 :          7 :   check_name(name);
     381                 :          7 :   ep = fetch_entry(name);
     382         [ -  + ]:          7 :   if (ep->valence != EpNEW)
     383                 :            :   {
     384         [ #  # ]:          0 :     if (ep->valence != EpINSTALL)
     385                 :          0 :       pari_err(e_MISC,"[install] identifier '%s' already in use", name);
     386                 :          0 :     pari_warn(warner, "[install] updating '%s' prototype; module not reloaded", name);
     387         [ #  # ]:          0 :     if (ep->code) pari_free((void*)ep->code);
     388                 :            :   }
     389                 :            :   else
     390                 :            :   {
     391                 :          7 :     ep->value = f;
     392                 :          7 :     ep->valence = EpINSTALL;
     393                 :            :   }
     394                 :          7 :   ep->code = pari_strdup(code);
     395                 :          7 :   ep->arity = arity; return ep;
     396                 :            : }
     397                 :            : 
     398                 :            : static void
     399                 :         21 : killep(entree *ep)
     400                 :            : {
     401                 :         21 :   GEN p = (GEN)initial_value(ep);
     402                 :         21 :   freeep(ep);
     403                 :         21 :   *p = 0; /* otherwise pari_var_create won't regenerate it */
     404                 :         21 :   ep->valence = EpNEW;
     405                 :         21 :   ep->value   = NULL;
     406                 :         21 :   ep->pvalue  = NULL;
     407                 :         21 : }
     408                 :            : /* Kill ep, i.e free all memory it references, and reset to initial value */
     409                 :            : void
     410                 :         21 : kill0(const char *e)
     411                 :            : {
     412                 :         21 :   entree *ep = is_entry(e);
     413 [ +  - ][ -  + ]:         21 :   if (!ep || EpSTATIC(ep)) pari_err(e_MISC,"can't kill that");
     414                 :         21 :   killep(ep);
     415                 :         21 : }
     416                 :            : 
     417                 :            : void
     418                 :         49 : addhelp(const char *e, char *s)
     419                 :            : {
     420                 :         49 :   entree *ep = fetch_entry(e);
     421 [ +  + ][ -  + ]:         49 :   if (ep->help && !EpSTATIC(ep)) pari_free((void*)ep->help);
     422                 :         49 :   ep->help = pari_strdup(s);
     423                 :         49 : }
     424                 :            : 
     425                 :            : GEN
     426                 :      22765 : type0(GEN x)
     427                 :            : {
     428                 :      22765 :   const char *s = type_name(typ(x));
     429                 :      22765 :   return strtoGENstr(s);
     430                 :            : }
     431                 :            : 
     432                 :            : /*******************************************************************/
     433                 :            : /*                                                                 */
     434                 :            : /*                              PARSER                             */
     435                 :            : /*                                                                 */
     436                 :            : /*******************************************************************/
     437                 :            : 
     438                 :            : #ifdef LONG_IS_64BIT
     439                 :            : static const long MAX_DIGITS  = 19;
     440                 :            : #else
     441                 :            : static const long MAX_DIGITS  = 9;
     442                 :            : #endif
     443                 :            : 
     444                 :            : static const long MAX_XDIGITS = BITS_IN_LONG>>2;
     445                 :            : static const long MAX_BDIGITS = BITS_IN_LONG;
     446                 :            : 
     447                 :            : static int
     448                 :   34337656 : ishex(const char **s)
     449                 :            : {
     450 [ +  + ][ +  + ]:   34337656 :   if (**s == '0' && ((*s)[1] == 'x' || (*s)[1] == 'X' ))
                 [ -  + ]
     451                 :            :   {
     452                 :         49 :     *s += 2;
     453                 :         49 :     return 1;
     454                 :            :   }
     455                 :            :   else
     456                 :   34337656 :     return 0;
     457                 :            : }
     458                 :            : 
     459                 :            : static int
     460                 :   34337705 : isbin(const char **s)
     461                 :            : {
     462 [ +  + ][ +  + ]:   34337705 :   if (**s == '0' && ((*s)[1] == 'b' || (*s)[1] == 'B' ))
                 [ -  + ]
     463                 :            :   {
     464                 :         49 :     *s += 2;
     465                 :         49 :     return 1;
     466                 :            :   }
     467                 :            :   else
     468                 :   34337705 :     return 0;
     469                 :            : }
     470                 :            : 
     471                 :            : static ulong
     472                 :         38 : bin_number_len(const char *s, long n)
     473                 :            : {
     474                 :         38 :   ulong m = 0;
     475                 :            :   long i;
     476         [ +  + ]:       1494 :   for (i = 0; i < n; i++,s++)
     477                 :       1456 :     m = 2*m + (*s - '0');
     478                 :         38 :   return m;
     479                 :            : }
     480                 :            : 
     481                 :            : static int
     482                 :       1484 : pari_isbdigit(int c)
     483                 :            : {
     484 [ +  + ][ +  + ]:       1484 :   return c=='0' || c=='1';
     485                 :            : }
     486                 :            : 
     487                 :            : static ulong
     488                 :         54 : hex_number_len(const char *s, long n)
     489                 :            : {
     490                 :         54 :   ulong m = 0;
     491                 :            :   long i;
     492         [ +  + ]:        593 :   for(i = 0; i < n; i++, s++)
     493                 :            :   {
     494                 :            :     ulong c;
     495 [ +  - ][ +  + ]:        539 :     if( *s >= '0' && *s <= '9')
     496                 :        455 :       c = *s - '0';
     497 [ +  - ][ +  - ]:         84 :     else if( *s >= 'A' && *s <= 'F')
     498                 :         84 :       c = *s - 'A' + 10;
     499                 :            :     else
     500                 :          0 :       c = *s - 'a' + 10;
     501                 :        539 :     m = 16*m + c;
     502                 :            :   }
     503                 :         54 :   return m;
     504                 :            : }
     505                 :            : 
     506                 :            : static GEN
     507                 :         56 : strtobin_len(const char *s, long n, long B, ulong num(const char *s, long n))
     508                 :            : {
     509                 :         56 :   long i, l = (n+B-1)/B;
     510                 :            :   GEN N, Np;
     511                 :         56 :   N = cgetipos(l+2);
     512                 :         56 :   Np = int_LSW(N);
     513         [ +  + ]:         92 :   for (i=1; i<l; i++, Np = int_nextW(Np))
     514                 :         36 :     uel(Np, 0) = num(s+n-i*B, B);
     515                 :         56 :   uel(Np, 0) = num(s, n-(i-1)*B);
     516                 :         56 :   return int_normalize(N, 0);
     517                 :            : }
     518                 :            : 
     519                 :            : static GEN
     520                 :         56 : binary_read(const char **ps, long B, int is(int), ulong num(const char *s, long n))
     521                 :            : {
     522                 :         56 :   const char *s = *ps;
     523         [ +  + ]:       2051 :   while (is((int)**ps)) (*ps)++;
     524                 :         56 :   return strtobin_len(s, *ps-s, B, num);
     525                 :            : }
     526                 :            : 
     527                 :            : static GEN
     528                 :         28 : bin_read(const char **ps)
     529                 :            : {
     530                 :         28 :   return binary_read(ps, MAX_BDIGITS, pari_isbdigit, bin_number_len);
     531                 :            : }
     532                 :            : 
     533                 :            : static GEN
     534                 :         28 : hex_read(const char **ps)
     535                 :            : {
     536                 :         28 :   return binary_read(ps, MAX_XDIGITS, isxdigit, hex_number_len);
     537                 :            : }
     538                 :            : 
     539                 :            : static ulong
     540                 :    2164572 : dec_number_len(const char *s, long B)
     541                 :            : {
     542                 :    2164572 :   ulong m = 0;
     543                 :            :   long n;
     544         [ +  + ]:   32672552 :   for (n = 0; n < B; n++,s++)
     545                 :   30507980 :     m = 10*m + (*s - '0');
     546                 :    2164572 :   return m;
     547                 :            : }
     548                 :            : 
     549                 :            : static GEN
     550                 :     589885 : dec_strtoi_len(const char *s, long n)
     551                 :            : {
     552                 :     589885 :   const long B = MAX_DIGITS;
     553                 :     589885 :   long i, l = (n+B-1)/B;
     554                 :     589885 :   GEN V = cgetg(l+1, t_VECSMALL);
     555         [ +  + ]:    2164572 :   for (i=1; i<l; i++)
     556                 :    1574687 :     uel(V,i) = dec_number_len(s+n-i*B, B);
     557                 :     589885 :   uel(V, i) = dec_number_len(s, n-(i-1)*B);
     558                 :     589885 :   return fromdigitsu(V, powuu(10, B));
     559                 :            : }
     560                 :            : 
     561                 :            : static GEN
     562                 :     589885 : dec_read_more(const char **ps)
     563                 :            : {
     564                 :     589885 :   pari_sp av = avma;
     565                 :     589885 :   const char *s = *ps;
     566         [ +  + ]:   31097865 :   while (isdigit((int)**ps)) (*ps)++;
     567                 :     589885 :   return gerepileuptoint(av, dec_strtoi_len(s, *ps-s));
     568                 :            : }
     569                 :            : 
     570                 :            : static ulong
     571                 :    7811980 : number(int *n, const char **s)
     572                 :            : {
     573                 :    7811980 :   ulong m = 0;
     574 [ +  + ][ +  + ]:   34286944 :   for (*n = 0; *n < MAX_DIGITS && isdigit((int)**s); (*n)++,(*s)++)
     575                 :   26474964 :     m = 10*m + (**s - '0');
     576                 :    7811980 :   return m;
     577                 :            : }
     578                 :            : 
     579                 :            : static GEN
     580                 :    7736688 : dec_read(const char **s)
     581                 :            : {
     582                 :            :   int nb;
     583                 :    7736688 :   ulong y  = number(&nb, s);
     584         [ +  + ]:    7736688 :   if (nb < MAX_DIGITS)
     585                 :    7146803 :     return utoi(y);
     586                 :     589885 :   *s -= MAX_DIGITS;
     587                 :    7736688 :   return dec_read_more(s);
     588                 :            : }
     589                 :            : 
     590                 :            : static GEN
     591                 :      66550 : real_read_more(GEN y, const char **ps)
     592                 :            : {
     593                 :      66550 :   pari_sp av = avma;
     594                 :      66550 :   const char *s = *ps;
     595                 :      66550 :   GEN z = dec_read(ps);
     596                 :      66550 :   long e = *ps-s;
     597                 :      66550 :   return gerepileuptoint(av, addmulii(z, powuu(10, e), y));
     598                 :            : }
     599                 :            : 
     600                 :            : static long
     601                 :      75292 : exponent(const char **pts)
     602                 :            : {
     603                 :      75292 :   const char *s = *pts;
     604                 :            :   long n;
     605                 :            :   int nb;
     606      [ +  -  + ]:      75292 :   switch(*++s)
     607                 :            :   {
     608                 :      75201 :     case '-': s++; n = -(long)number(&nb, &s); break;
     609                 :          0 :     case '+': s++; /* Fall through */
     610                 :         91 :     default: n = (long)number(&nb, &s);
     611                 :            :   }
     612                 :      75292 :   *pts = s; return n;
     613                 :            : }
     614                 :            : 
     615                 :            : static GEN
     616                 :        168 : real_0_digits(long n) {
     617         [ +  + ]:        168 :   long b = (n > 0)? (long)(n/LOG10_2): (long)-((-n)/LOG10_2 + 1);
     618                 :        168 :   return real_0_bit(b);
     619                 :            : }
     620                 :            : 
     621                 :            : static GEN
     622                 :     146957 : real_read(pari_sp av, const char **s, GEN y, long prec)
     623                 :            : {
     624                 :     146957 :   long l, n = 0;
     625      [ -  +  + ]:     146957 :   switch(**s)
     626                 :            :   {
     627                 :          0 :     default: return y; /* integer */
     628                 :            :     case '.':
     629                 :            :     {
     630                 :      72876 :       const char *old = ++*s;
     631 [ +  + ][ -  + ]:      72876 :       if (isalpha((int)**s) || **s=='.')
     632                 :            :       {
     633 [ +  + ][ +  - ]:       1204 :         if (**s == 'E' || **s == 'e') {
     634                 :       1204 :           n = exponent(s);
     635         [ +  + ]:       1204 :           if (!signe(y)) { avma = av; return real_0_digits(n); }
     636                 :       1183 :           break;
     637                 :            :         }
     638                 :          0 :         --*s; return y; /* member */
     639                 :            :       }
     640         [ +  + ]:      71672 :       if (isdigit((int)**s)) y = real_read_more(y, s);
     641                 :      71672 :       n = old - *s;
     642 [ +  - ][ +  + ]:      71672 :       if (**s != 'E' && **s != 'e')
     643                 :            :       {
     644         [ +  + ]:      71665 :         if (!signe(y)) { avma = av; return real_0(prec); }
     645                 :      70748 :         break;
     646                 :            :       }
     647                 :            :     }
     648                 :            :     /* Fall through */
     649                 :            :     case 'E': case 'e':
     650                 :      74088 :       n += exponent(s);
     651         [ +  + ]:      74088 :       if (!signe(y)) { avma = av; return real_0_digits(n); }
     652                 :            :   }
     653                 :     145872 :   l = nbits2prec(bit_accuracy(lgefint(y)));
     654         [ +  + ]:     145872 :   if (l < prec) l = prec; else prec = l;
     655         [ +  + ]:     145872 :   if (!n) return itor(y, prec);
     656                 :     140960 :   incrprec(l);
     657                 :     140960 :   y = itor(y, l);
     658         [ +  + ]:     140960 :   if (n > 0)
     659                 :         14 :     y = mulrr(y, rpowuu(10UL, (ulong)n, l));
     660                 :            :   else
     661                 :     140946 :     y = divrr(y, rpowuu(10UL, (ulong)-n, l));
     662                 :     146957 :   return gerepileuptoleaf(av, rtor(y, prec));
     663                 :            : }
     664                 :            : 
     665                 :            : static GEN
     666                 :    7523237 : int_read(const char **s)
     667                 :            : {
     668                 :            :   GEN y;
     669         [ +  + ]:    7523237 :   if (isbin(s))
     670                 :         28 :     y = bin_read(s);
     671         [ +  + ]:    7523209 :   else if (ishex(s))
     672                 :         28 :     y = hex_read(s);
     673                 :            :   else
     674                 :    7523181 :     y = dec_read(s);
     675                 :    7523237 :   return y;
     676                 :            : }
     677                 :            : 
     678                 :            : GEN
     679                 :    7523237 : strtoi(const char *s) { return int_read(&s); }
     680                 :            : 
     681                 :            : GEN
     682                 :     146957 : strtor(const char *s, long prec)
     683                 :            : {
     684                 :     146957 :   pari_sp av = avma;
     685                 :     146957 :   GEN y = dec_read(&s);
     686                 :     146957 :   y = real_read(av, &s, y, prec);
     687         [ +  - ]:     146957 :   if (typ(y) == t_REAL) return y;
     688                 :     146957 :   return gerepileuptoleaf(av, itor(y, prec));
     689                 :            : }
     690                 :            : 
     691                 :            : static void
     692                 :    7412348 : skipdigits(char **lex) {
     693         [ +  + ]:   51081406 :   while (isdigit((int)**lex)) ++*lex;
     694                 :    7412348 : }
     695                 :            : 
     696                 :            : static int
     697                 :    7408557 : skipexponent(char **lex)
     698                 :            : {
     699                 :    7408557 :   char *old=*lex;
     700 [ +  + ][ +  + ]:    7408557 :   if ((**lex=='e' || **lex=='E'))
     701                 :            :   {
     702                 :        798 :     ++*lex;
     703 [ +  - ][ +  + ]:        798 :     if ( **lex=='+' || **lex=='-' ) ++*lex;
     704         [ +  + ]:        798 :     if (!isdigit((int)**lex))
     705                 :            :     {
     706                 :        413 :       *lex=old;
     707                 :        413 :       return KINTEGER;
     708                 :            :     }
     709                 :        385 :     skipdigits(lex);
     710                 :        385 :     return KREAL;
     711                 :            :   }
     712                 :    7408557 :   return KINTEGER;
     713                 :            : }
     714                 :            : 
     715                 :            : static int
     716                 :    7409141 : skipconstante(char **lex)
     717                 :            : {
     718                 :    7409141 :   skipdigits(lex);
     719         [ +  + ]:    7409141 :   if (**lex=='.')
     720                 :            :   {
     721                 :      13374 :     char *old = ++*lex;
     722         [ +  + ]:      13374 :     if (**lex == '.') { --*lex; return KINTEGER; }
     723         [ +  + ]:      12790 :     if (isalpha((int)**lex))
     724                 :            :     {
     725                 :       9968 :       skipexponent(lex);
     726         [ +  + ]:       9968 :       if (*lex == old)
     727                 :            :       {
     728                 :       9940 :         --*lex; /* member */
     729                 :       9940 :         return KINTEGER;
     730                 :            :       }
     731                 :         28 :       return KREAL;
     732                 :            :     }
     733                 :       2822 :     skipdigits(lex);
     734                 :       2822 :     skipexponent(lex);
     735                 :       2822 :     return KREAL;
     736                 :            :   }
     737                 :    7409141 :   return skipexponent(lex);
     738                 :            : }
     739                 :            : 
     740                 :            : static void
     741                 :    1112483 : skipstring(char **lex)
     742                 :            : {
     743         [ +  - ]:    7968946 :   while (**lex)
     744                 :            :   {
     745         [ +  + ]:    7969450 :     while (**lex == '\\') *lex+=2;
     746         [ +  + ]:    7968946 :     if (**lex == '"')
     747                 :            :     {
     748         [ +  - ]:    1112483 :       if ((*lex)[1] != '"') break;
     749                 :          0 :       *lex += 2; continue;
     750                 :            :     }
     751                 :    6856463 :     (*lex)++;
     752                 :            :   }
     753                 :    1112483 : }
     754                 :            : 
     755                 :            : int
     756                 :   28521979 : pari_lex(union token_value *yylval, struct node_loc *yylloc, char **lex)
     757                 :            : {
     758                 :            :   (void) yylval;
     759                 :   28521979 :   yylloc->start=*lex;
     760         [ +  + ]:   28521979 :   if (!**lex)
     761                 :            :   {
     762                 :     135434 :     yylloc->end=*lex;
     763                 :     135434 :     return 0;
     764                 :            :   }
     765         [ +  + ]:   28386545 :   if (isalpha((int)**lex))
     766                 :            :   {
     767         [ +  + ]:    2140692 :     while (is_keyword_char(**lex)) ++*lex;
     768                 :     449042 :     yylloc->end=*lex;
     769                 :     449042 :     return KENTRY;
     770                 :            :   }
     771         [ +  + ]:   27937503 :   if (**lex=='"')
     772                 :            :   {
     773                 :    1112483 :     ++*lex;
     774                 :    1112483 :     skipstring(lex);
     775         [ -  + ]:    1112483 :     if (!**lex)
     776                 :          0 :       compile_err("run-away string",*lex-1);
     777                 :    1112483 :     ++*lex;
     778                 :    1112483 :     yylloc->end=*lex;
     779                 :    1112483 :     return KSTRING;
     780                 :            :   }
     781         [ +  + ]:   26825020 :   if (**lex == '.')
     782                 :            :   {
     783                 :            :     int token;
     784         [ +  + ]:      10552 :     if ((*lex)[1]== '.')
     785                 :            :     {
     786                 :        605 :       *lex+=2; yylloc->end = *lex; return KDOTDOT;
     787                 :            :     }
     788                 :       9947 :     token=skipconstante(lex);
     789         [ +  + ]:       9947 :     if (token==KREAL)
     790                 :            :     {
     791                 :          7 :       yylloc->end = *lex;
     792                 :          7 :       return token;
     793                 :            :     }
     794                 :       9940 :     ++*lex;
     795                 :       9940 :     yylloc->end=*lex;
     796                 :       9940 :     return '.';
     797                 :            :   }
     798         [ +  + ]:   26814468 :   if (isbin((const char**)lex))
     799                 :            :   {
     800 [ +  + ][ +  + ]:       1029 :     while (**lex=='0' || **lex=='1') ++*lex;
     801                 :         21 :     return KINTEGER;
     802                 :            :   }
     803         [ +  + ]:   26814447 :   if (ishex((const char**)lex))
     804                 :            :   {
     805         [ +  + ]:        385 :     while (isxdigit((int)**lex)) ++*lex;
     806                 :         21 :     return KINTEGER;
     807                 :            :   }
     808         [ +  + ]:   26814426 :   if (isdigit((int)**lex))
     809                 :            :   {
     810                 :    7399194 :     int token=skipconstante(lex);
     811                 :    7399194 :     yylloc->end = *lex;
     812                 :    7399194 :     return token;
     813                 :            :   }
     814         [ +  + ]:   19415232 :   if ((*lex)[1]=='=')
     815   [ +  +  +  +  :      16307 :     switch (**lex)
          +  +  +  +  +  
                   +  + ]
     816                 :            :     {
     817                 :            :     case '=':
     818         [ +  + ]:       6551 :       if ((*lex)[2]=='=')
     819                 :        329 :       { *lex+=3; yylloc->end = *lex; return KID; }
     820                 :            :       else
     821                 :       6222 :       { *lex+=2; yylloc->end = *lex; return KEQ; }
     822                 :            :     case '>':
     823                 :         58 :       *lex+=2; yylloc->end = *lex; return KGE;
     824                 :            :     case '<':
     825                 :        170 :       *lex+=2; yylloc->end = *lex; return KLE;
     826                 :            :     case '*':
     827                 :        156 :       *lex+=2; yylloc->end = *lex; return KME;
     828                 :            :     case '/':
     829                 :          7 :       *lex+=2; yylloc->end = *lex; return KDE;
     830                 :            :     case '%':
     831         [ -  + ]:          7 :       if ((*lex)[2]=='=') break;
     832                 :          7 :       *lex+=2; yylloc->end = *lex; return KMODE;
     833                 :            :     case '!':
     834         [ -  + ]:        966 :       if ((*lex)[2]=='=') break;
     835                 :        966 :       *lex+=2; yylloc->end = *lex; return KNE;
     836                 :            :     case '\\':
     837                 :          7 :       *lex+=2; yylloc->end = *lex; return KEUCE;
     838                 :            :     case '+':
     839                 :        103 :       *lex+=2; yylloc->end = *lex; return KPE;
     840                 :            :     case '-':
     841                 :         35 :       *lex+=2; yylloc->end = *lex; return KSE;
     842                 :            :     }
     843 [ +  + ][ +  + ]:   19407172 :   if (**lex==')' && (*lex)[1]=='-' && (*lex)[2]=='>')
                 [ +  + ]
     844                 :            :   {
     845                 :       3859 :     *lex+=3; yylloc->end = *lex; return KPARROW;
     846                 :            :   }
     847 [ +  + ][ +  + ]:   19403313 :   if (**lex=='-' && (*lex)[1]=='>')
     848                 :            :   {
     849                 :        655 :     *lex+=2; yylloc->end = *lex; return KARROW;
     850                 :            :   }
     851 [ +  + ][ -  + ]:   19402658 :   if (**lex=='<' && (*lex)[1]=='>')
     852                 :            :   {
     853                 :          0 :     *lex+=2; yylloc->end = *lex; return KNE;
     854                 :            :   }
     855 [ +  + ][ +  + ]:   19402658 :   if (**lex=='\\' && (*lex)[1]=='/')
     856         [ +  + ]:         35 :     switch((*lex)[2])
     857                 :            :     {
     858                 :            :     case '=':
     859                 :          7 :       *lex+=3; yylloc->end = *lex; return KDRE;
     860                 :            :     default:
     861                 :         28 :       *lex+=2; yylloc->end = *lex; return KDR;
     862                 :            :     }
     863         [ +  + ]:   19402623 :   if ((*lex)[1]==**lex)
     864   [ +  +  +  +  :    2115174 :     switch (**lex)
                +  +  + ]
     865                 :            :     {
     866                 :            :     case '&':
     867                 :        616 :       *lex+=2; yylloc->end = *lex; return KAND;
     868                 :            :     case '|':
     869                 :        259 :       *lex+=2; yylloc->end = *lex; return KOR;
     870                 :            :     case '+':
     871                 :         70 :       *lex+=2; yylloc->end = *lex; return KPP;
     872                 :            :     case '-':
     873                 :         14 :       *lex+=2; yylloc->end = *lex; return KSS;
     874                 :            :     case '>':
     875         [ +  + ]:         28 :       if ((*lex)[2]=='=') { *lex+=3; yylloc->end = *lex; return KSRE;}
     876                 :         21 :       *lex+=2; yylloc->end = *lex; return KSR;
     877                 :            :     case '<':
     878         [ +  + ]:        112 :       if ((*lex)[2]=='=')
     879                 :          7 :       { *lex+=3; yylloc->end = *lex; return KSLE; }
     880                 :        105 :       *lex+=2; yylloc->end = *lex; return KSL;
     881                 :            :     }
     882                 :   19401524 :   yylloc->end = *lex+1;
     883                 :   28521979 :   return (unsigned char) *(*lex)++;
     884                 :            : }
     885                 :            : 
     886                 :            : /********************************************************************/
     887                 :            : /**                                                                **/
     888                 :            : /**                            STRINGS                             **/
     889                 :            : /**                                                                **/
     890                 :            : /********************************************************************/
     891                 :            : 
     892                 :            : /* return the first n0 chars of s as a GEN [s may not be 0-terminated] */
     893                 :            : GEN
     894                 :     384130 : strntoGENstr(const char *s, long n0)
     895                 :            : {
     896                 :     384130 :   long n = nchar2nlong(n0+1);
     897                 :     384130 :   GEN x = cgetg(n+1, t_STR);
     898                 :     384130 :   char *t = GSTR(x);
     899                 :     384130 :   strncpy(t, s, n0); t[n0] = 0; return x;
     900                 :            : }
     901                 :            : 
     902                 :            : GEN
     903                 :     231286 : strtoGENstr(const char *s) { return strntoGENstr(s, strlen(s)); }
     904                 :            : 
     905                 :            : GEN
     906                 :         56 : chartoGENstr(char c)
     907                 :            : {
     908                 :         56 :   GEN x = cgetg(2, t_STR);
     909                 :         56 :   char *t = GSTR(x);
     910                 :         56 :   t[0] = c; t[1] = 0; return x;
     911                 :            : }
     912                 :            : 
     913                 :            : /********************************************************************/
     914                 :            : /*                                                                  */
     915                 :            : /*                Formal variables management                       */
     916                 :            : /*                                                                  */
     917                 :            : /********************************************************************/
     918                 :            : static THREAD long max_priority, min_priority;
     919                 :            : static THREAD long max_avail; /* max variable not yet used */
     920                 :            : static long nvar; /* first GP free variable */
     921                 :            : static hashtable *h_polvar;
     922                 :            : static struct pari_varstate global_varstate;
     923                 :            : static long *global_varpriority;
     924                 :            : 
     925                 :            : void
     926                 :     152884 : varstate_save(struct pari_varstate *s)
     927                 :            : {
     928                 :     152884 :   s->nvar = nvar;
     929                 :     152884 :   s->max_avail = max_avail;
     930                 :     152884 :   s->max_priority = max_priority;
     931                 :     152884 :   s->min_priority = min_priority;
     932                 :     152884 : }
     933                 :            : 
     934                 :            : static void
     935                 :      10405 : varentries_set(long v, entree *ep)
     936                 :            : {
     937                 :      10405 :   hash_insert(h_polvar, (void*)ep->name, (void*)v);
     938                 :      10405 :   varentries[v] = ep;
     939                 :      10405 : }
     940                 :            : static int
     941                 :       4044 : _given_value(void *E, hashentry *e) { return e->val == E; }
     942                 :            : 
     943                 :            : static void
     944                 :      62192 : varentries_unset(long v)
     945                 :            : {
     946                 :      62192 :   entree *ep = varentries[v];
     947         [ +  + ]:      62192 :   if (ep)
     948                 :            :   {
     949                 :       4044 :     hashentry *e = hash_remove_select(h_polvar, (void*)ep->name, (void*)v,
     950                 :            :         _given_value);
     951         [ -  + ]:       4044 :     if (!e) pari_err_BUG("varentries_unset [unknown var]");
     952                 :       4044 :     varentries[v] = NULL;
     953                 :       4044 :     pari_free(e);
     954 [ +  + ][ +  + ]:       4044 :     if (v <= nvar && ep == is_entry(ep->name))
     955                 :       3827 :     { /* known to the GP interpreter; entree in functions_hash is permanent */
     956                 :       3827 :       GEN p = (GEN)initial_value(ep);
     957         [ +  + ]:       3827 :       if (ep->value == p) { ep->value = NULL; ep->valence = EpNEW; }
     958                 :       3827 :       *p = 0;
     959                 :            :     }
     960                 :            :     else /* from name_var() or a direct pari_var_create() */
     961                 :        217 :       pari_free(ep);
     962                 :            :  }
     963                 :      62192 : }
     964                 :            : static void
     965                 :        287 : varentries_reset(long v, entree *ep)
     966                 :            : {
     967                 :        287 :   varentries_unset(v);
     968                 :        287 :   varentries_set(v, ep);
     969                 :        287 : }
     970                 :            : 
     971                 :            : static void
     972                 :     244308 : var_restore(struct pari_varstate *s)
     973                 :            : {
     974                 :     244308 :   nvar = s->nvar;
     975                 :     244308 :   max_avail = s->max_avail;
     976                 :     244308 :   max_priority = s->max_priority;
     977                 :     244308 :   min_priority = s->min_priority;
     978                 :     244308 : }
     979                 :            : 
     980                 :            : void
     981                 :      58036 : varstate_restore(struct pari_varstate *s)
     982                 :            : {
     983                 :            :   long i;
     984         [ +  + ]:     119906 :   for (i = nvar; i >= s->nvar; i--)
     985                 :            :   {
     986                 :      61870 :     varentries_unset(i);
     987                 :      61870 :     varpriority[i] = -i;
     988                 :            :   }
     989         [ +  + ]:      58071 :   for (i = max_avail; i < s->max_avail; i++)
     990                 :            :   {
     991                 :         35 :     varentries_unset(i);
     992                 :         35 :     varpriority[i] = -i;
     993                 :            :   }
     994                 :      58036 :   var_restore(s);
     995                 :      58036 : }
     996                 :            : 
     997                 :            : void
     998                 :     186502 : pari_thread_init_varstate(void)
     999                 :            : {
    1000                 :            :   long i;
    1001                 :     186502 :   var_restore(&global_varstate);
    1002                 :     183540 :   varpriority = (long*)newblock((MAXVARN+2)) + 1;
    1003                 :     193775 :   varpriority[-1] = 1-LONG_MAX;
    1004         [ +  + ]: 2806693926 :   for (i = 0; i < max_avail; i++) varpriority[i] = global_varpriority[i];
    1005                 :     193775 : }
    1006                 :            : 
    1007                 :            : void
    1008                 :      12119 : pari_pthread_init_varstate(void)
    1009                 :            : {
    1010                 :      12119 :   varstate_save(&global_varstate);
    1011                 :      12119 :   global_varpriority = varpriority;
    1012                 :      12119 : }
    1013                 :            : 
    1014                 :            : void
    1015                 :       1836 : pari_var_close(void)
    1016                 :            : {
    1017                 :       1836 :   free((void*)varentries);
    1018                 :       1836 :   free((void*)(varpriority-1));
    1019                 :       1836 :   hash_destroy(h_polvar);
    1020                 :       1836 : }
    1021                 :            : 
    1022                 :            : void
    1023                 :       2344 : pari_var_init(void)
    1024                 :            : {
    1025                 :            :   long i;
    1026                 :       2344 :   varentries = (entree**) pari_calloc((MAXVARN+1)*sizeof(entree*));
    1027                 :       2344 :   varpriority = (long*)pari_malloc((MAXVARN+2)*sizeof(long)) + 1;
    1028                 :       2344 :   varpriority[-1] = 1-LONG_MAX;
    1029                 :       2344 :   h_polvar = hash_create_str(100, 0);
    1030                 :       2344 :   nvar = 0; max_avail = MAXVARN;
    1031                 :       2344 :   max_priority = min_priority = 0;
    1032                 :       2344 :   (void)fetch_user_var("x");
    1033                 :       2344 :   (void)fetch_user_var("y");
    1034                 :            :   /* initialize so that people can use pol_x(i) directly */
    1035         [ +  + ]:  144373464 :   for (i = 2; i <= (long)MAXVARN; i++) varpriority[i] = -i;
    1036                 :            :   /* reserve varnum 1..9 for static temps with predictable priority wrt x */
    1037                 :       2344 :   nvar = 10;
    1038                 :       2344 :   min_priority = -MAXVARN;
    1039                 :       2344 : }
    1040                 :        224 : long pari_var_next(void) { return nvar; }
    1041                 :        126 : long pari_var_next_temp(void) { return max_avail; }
    1042                 :            : long
    1043                 :      21864 : pari_var_create(entree *ep)
    1044                 :            : {
    1045                 :      21864 :   GEN p = (GEN)initial_value(ep);
    1046                 :            :   long v;
    1047         [ +  + ]:      21864 :   if (*p) return varn(p);
    1048         [ -  + ]:      10118 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1049                 :      10118 :   v = nvar++;
    1050                 :            :   /* set p = pol_x(v) */
    1051                 :      10118 :   p[0] = evaltyp(t_POL) | _evallg(4);
    1052                 :      10118 :   p[1] = evalsigne(1) | evalvarn(v);
    1053                 :      10118 :   gel(p,2) = gen_0;
    1054                 :      10118 :   gel(p,3) = gen_1;
    1055                 :      10118 :   varentries_set(v, ep);
    1056                 :      10118 :   varpriority[v]= min_priority--;
    1057                 :      21864 :   return v;
    1058                 :            : }
    1059                 :            : 
    1060                 :            : long
    1061                 :     109690 : delete_var(void)
    1062                 :            : { /* user wants to delete one of his/her/its variables */
    1063         [ -  + ]:     109690 :   if (max_avail == MAXVARN) return 0; /* nothing to delete */
    1064                 :     109690 :   max_avail++;
    1065         [ -  + ]:     109690 :   if      (varpriority[max_avail] == min_priority) min_priority++;
    1066         [ +  + ]:     109690 :   else if (varpriority[max_avail] == max_priority) max_priority--;
    1067                 :     109690 :   return max_avail+1;
    1068                 :            : }
    1069                 :            : long
    1070                 :      41474 : fetch_var(void)
    1071                 :            : {
    1072         [ -  + ]:      41474 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1073                 :      41474 :   varpriority[max_avail] = min_priority--;
    1074                 :      41474 :   return max_avail--;
    1075                 :            : }
    1076                 :            : long
    1077                 :      68321 : fetch_var_higher(void)
    1078                 :            : {
    1079         [ -  + ]:      68321 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1080                 :      68321 :   varpriority[max_avail] = ++max_priority;
    1081                 :      68321 :   return max_avail--;
    1082                 :            : }
    1083                 :            : 
    1084                 :            : static int
    1085                 :         49 : _higher(void *E, hashentry *e)
    1086                 :         49 : { long v = (long)e->val; return (varncmp(v, (long)E) < 0); }
    1087                 :            : static int
    1088                 :         42 : _lower(void *E, hashentry *e)
    1089                 :         42 : { long v = (long)e->val; return (varncmp(v, (long)E) > 0); }
    1090                 :            : 
    1091                 :            : static GEN
    1092                 :         63 : var_register(long v, const char *s)
    1093                 :            : {
    1094                 :         63 :   varentries_reset(v, initep(s, strlen(s)));
    1095                 :         63 :   return pol_x(v);
    1096                 :            : }
    1097                 :            : GEN
    1098                 :         56 : varhigher(const char *s, long w)
    1099                 :            : {
    1100                 :            :   long v;
    1101         [ +  + ]:         56 :   if (w >= 0)
    1102                 :            :   {
    1103                 :         35 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _higher);
    1104         [ +  + ]:         35 :     if (e) return pol_x((long)e->val);
    1105                 :            :   }
    1106                 :            :   /* no luck: need to create */
    1107         [ -  + ]:         42 :   if (nvar == max_avail) pari_err(e_MISC,"no more variables available");
    1108                 :         42 :   v = nvar++;
    1109                 :         42 :   varpriority[v]= ++max_priority;
    1110                 :         56 :   return var_register(v, s);
    1111                 :            : }
    1112                 :            : GEN
    1113                 :         28 : varlower(const char *s, long w)
    1114                 :            : {
    1115                 :            :   long v;
    1116         [ +  + ]:         28 :   if (w >= 0)
    1117                 :            :   {
    1118                 :         21 :     hashentry *e = hash_select(h_polvar, (void*)s, (void*)w, _lower);
    1119         [ +  + ]:         21 :     if (e) return pol_x((long)e->val);
    1120                 :            :   }
    1121                 :            :   /* no luck: need to create */
    1122                 :         21 :   v = fetch_var();
    1123                 :         28 :   return var_register(v, s);
    1124                 :            : }
    1125                 :            : 
    1126                 :            : long
    1127                 :       4688 : fetch_user_var(const char *s)
    1128                 :            : {
    1129                 :       4688 :   entree *ep = fetch_entry(s);
    1130                 :            :   long v;
    1131      [ -  +  - ]:       4688 :   switch (EpVALENCE(ep))
    1132                 :            :   {
    1133                 :          0 :     case EpVAR: return varn((GEN)initial_value(ep));
    1134                 :       4688 :     case EpNEW: break;
    1135                 :          0 :     default: pari_err(e_MISC, "%s already exists with incompatible valence", s);
    1136                 :            :   }
    1137                 :       4688 :   v = pari_var_create(ep);
    1138                 :       4688 :   ep->valence = EpVAR;
    1139                 :       4688 :   ep->value = initial_value(ep);
    1140                 :       4688 :   return v;
    1141                 :            : }
    1142                 :            : 
    1143                 :            : GEN
    1144                 :          7 : fetch_var_value(long v, GEN t)
    1145                 :            : {
    1146                 :          7 :   entree *ep = varentries[v];
    1147         [ -  + ]:          7 :   if (!ep) return NULL;
    1148         [ +  - ]:          7 :   if (t)
    1149                 :            :   {
    1150                 :          7 :     long vn = localvars_find(t,ep);
    1151         [ -  + ]:          7 :     if (vn) return get_lex(vn);
    1152                 :            :   }
    1153                 :          7 :   return (GEN)ep->value;
    1154                 :            : }
    1155                 :            : 
    1156                 :            : void
    1157                 :        224 : name_var(long n, const char *s)
    1158                 :            : {
    1159                 :            :   entree *ep;
    1160                 :            :   char *u;
    1161                 :            : 
    1162         [ -  + ]:        224 :   if (n < pari_var_next())
    1163                 :          0 :     pari_err(e_MISC, "renaming a GP variable is forbidden");
    1164         [ -  + ]:        224 :   if (n > (long)MAXVARN)
    1165                 :          0 :     pari_err_OVERFLOW("variable number");
    1166                 :            : 
    1167                 :        224 :   ep = (entree*)pari_malloc(sizeof(entree) + strlen(s) + 1);
    1168                 :        224 :   u = (char *)initial_value(ep);
    1169                 :        224 :   ep->valence = EpVAR;
    1170                 :        224 :   ep->name = u; strcpy(u,s);
    1171                 :        224 :   ep->value = gen_0; /* in case geval is called */
    1172                 :        224 :   varentries_reset(n, ep);
    1173                 :        224 : }
    1174                 :            : 
    1175                 :            : static int
    1176                 :       5059 : cmp_by_var(void *E,GEN x, GEN y)
    1177                 :       5059 : { (void)E; return varncmp((long)x,(long)y); }
    1178                 :            : GEN
    1179                 :        147 : vars_sort_inplace(GEN z)
    1180                 :        147 : { gen_sort_inplace(z,NULL,cmp_by_var,NULL); return z; }
    1181                 :            : GEN
    1182                 :        147 : vars_to_RgXV(GEN h)
    1183                 :            : {
    1184                 :        147 :   long i, l = lg(h);
    1185                 :        147 :   GEN z = cgetg(l, t_VEC);
    1186         [ +  + ]:       2037 :   for (i = 1; i < l; i++) gel(z,i) = pol_x(h[i]);
    1187                 :        147 :   return z;
    1188                 :            : }
    1189                 :            : GEN
    1190                 :        518 : gpolvar(GEN x)
    1191                 :            : {
    1192                 :            :   long v;
    1193         [ +  + ]:        518 :   if (!x) {
    1194                 :        140 :     GEN h = hash_values(h_polvar);
    1195                 :        140 :     return vars_to_RgXV(vars_sort_inplace(h));
    1196                 :            :   }
    1197         [ +  + ]:        378 :   if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
    1198                 :        371 :   v = gvar(x);
    1199         [ +  + ]:        371 :   if (v==NO_VARIABLE) return gen_0;
    1200                 :        518 :   return pol_x(v);
    1201                 :            : }
    1202                 :            : 
    1203                 :            : static void
    1204                 :    2374472 : fill_hashtable_single(entree **table, entree *ep)
    1205                 :            : {
    1206                 :    2374472 :   EpSETSTATIC(ep);
    1207                 :    2374472 :   insertep(ep, table,  hashvalue(ep->name));
    1208         [ +  + ]:    2374472 :   if (ep->code) ep->arity = check_proto(ep->code);
    1209                 :    2374472 :   ep->pvalue = NULL;
    1210                 :    2374472 : }
    1211                 :            : 
    1212                 :            : void
    1213                 :       9376 : pari_fill_hashtable(entree **table, entree *ep)
    1214                 :            : {
    1215         [ +  + ]:    2383848 :   for ( ; ep->name; ep++) fill_hashtable_single(table, ep);
    1216                 :       9376 : }
    1217                 :            : 
    1218                 :            : void
    1219                 :          0 : pari_add_function(entree *ep)
    1220                 :            : {
    1221                 :          0 :   fill_hashtable_single(functions_hash, ep);
    1222                 :          0 : }
    1223                 :            : 
    1224                 :            : /********************************************************************/
    1225                 :            : /**                                                                **/
    1226                 :            : /**                        SIMPLE GP FUNCTIONS                     **/
    1227                 :            : /**                                                                **/
    1228                 :            : /********************************************************************/
    1229                 :            : 
    1230                 :            : #define ALIAS(ep) (entree *) ((GEN)ep->value)[1]
    1231                 :            : 
    1232                 :            : entree *
    1233                 :    5792635 : do_alias(entree *ep)
    1234                 :            : {
    1235         [ +  + ]:    5792747 :   while (ep->valence == EpALIAS) ep = ALIAS(ep);
    1236                 :    5792635 :   return ep;
    1237                 :            : }
    1238                 :            : 
    1239                 :            : void
    1240                 :         35 : alias0(const char *s, const char *old)
    1241                 :            : {
    1242                 :            :   entree *ep, *e;
    1243                 :            :   GEN x;
    1244                 :            : 
    1245                 :         35 :   ep = fetch_entry(old);
    1246                 :         35 :   e  = fetch_entry(s);
    1247 [ +  - ][ -  + ]:         35 :   if (EpVALENCE(e) != EpALIAS && EpVALENCE(e) != EpNEW)
    1248                 :          0 :     pari_err(e_MISC,"can't replace an existing symbol by an alias");
    1249                 :         35 :   freeep(e);
    1250                 :         35 :   x = newblock(2); x[0] = evaltyp(t_STR)|_evallg(2); /* for getheap */
    1251                 :         35 :   gel(x,1) = (GEN)ep;
    1252                 :         35 :   e->value=x; e->valence=EpALIAS;
    1253                 :         35 : }
    1254                 :            : 
    1255                 :            : GEN
    1256                 :   12902399 : ifpari(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1257                 :            : {
    1258         [ +  + ]:   12902399 :   if (gequal0(g)) /* false */
    1259         [ +  + ]:    9921488 :     return b? closure_evalgen(b): gnil;
    1260                 :            :   else /* true */
    1261         [ +  - ]:   12902399 :     return a? closure_evalgen(a): gnil;
    1262                 :            : }
    1263                 :            : 
    1264                 :            : void
    1265                 :   16552563 : ifpari_void(GEN g, GEN a/*closure*/, GEN b/*closure*/)
    1266                 :            : {
    1267         [ +  + ]:   16552563 :   if (gequal0(g)) /* false */
    1268         [ +  + ]:   16030119 :   { if (b) closure_evalvoid(b); }
    1269                 :            :   else /* true */
    1270         [ +  + ]:     522444 :   { if (a) closure_evalvoid(a); }
    1271                 :   16552542 : }
    1272                 :            : 
    1273                 :            : GEN
    1274                 :      74452 : ifpari_multi(GEN g, GEN a/*closure*/)
    1275                 :            : {
    1276                 :      74452 :   long i, nb = lg(a)-1;
    1277         [ +  + ]:      74452 :   if (!gequal0(g)) /* false */
    1278                 :      19397 :     return closure_evalgen(gel(a,1));
    1279         [ +  + ]:     117670 :   for(i=2;i<nb;i+=2)
    1280                 :            :   {
    1281                 :     109837 :     GEN g = closure_evalgen(gel(a,i));
    1282         [ +  + ]:     109837 :     if (!g) return g;
    1283         [ +  + ]:     109830 :     if (!gequal0(g))
    1284                 :      47215 :       return closure_evalgen(gel(a,i+1));
    1285                 :            :   }
    1286         [ +  + ]:      74452 :   return i<=nb? closure_evalgen(gel(a,i)): gnil;
    1287                 :            : }
    1288                 :            : 
    1289                 :            : GEN
    1290                 :     175532 : andpari(GEN a, GEN b/*closure*/)
    1291                 :            : {
    1292                 :            :   GEN g;
    1293         [ +  + ]:     175532 :   if (gequal0(a))
    1294                 :      12537 :     return gen_0;
    1295                 :     162995 :   g=closure_evalgen(b);
    1296         [ -  + ]:     162995 :   if (!g) return g;
    1297         [ +  + ]:     175532 :   return gequal0(g)?gen_0:gen_1;
    1298                 :            : }
    1299                 :            : 
    1300                 :            : GEN
    1301                 :    2480940 : orpari(GEN a, GEN b/*closure*/)
    1302                 :            : {
    1303                 :            :   GEN g;
    1304         [ +  + ]:    2480940 :   if (!gequal0(a))
    1305                 :     144998 :     return gen_1;
    1306                 :    2335942 :   g=closure_evalgen(b);
    1307         [ -  + ]:    2335942 :   if (!g) return g;
    1308         [ +  + ]:    2480940 :   return gequal0(g)?gen_0:gen_1;
    1309                 :            : }
    1310                 :            : 
    1311                 :      91134 : GEN gmule(GEN *x, GEN y) { *x = gmul(*x,y); return *x; }
    1312                 :          7 : GEN gdive(GEN *x, GEN y) { *x = gdiv(*x,y); return *x; }
    1313                 :          7 : GEN gdivente(GEN *x, GEN y) { *x = gdivent(*x,y); return *x; }
    1314                 :          7 : GEN gdivrounde(GEN *x, GEN y) { *x = gdivround(*x,y); return *x; }
    1315                 :          7 : GEN gmode(GEN *x, GEN y) { *x = gmod(*x,y); return *x; }
    1316                 :          7 : GEN gshiftle(GEN *x, long n) { *x = gshift(*x,n); return *x; }
    1317                 :          7 : GEN gshiftre(GEN *x, long n) { *x = gshift(*x,-n); return *x; }
    1318                 :    2373417 : GEN gadde(GEN *x, GEN y) { *x = gadd(*x,y); return *x; }
    1319         [ +  + ]:    3163195 : GEN gadd1e(GEN *x) { *x = typ(*x)==t_INT?addis(*x,1):gaddgs(*x,1); return *x; }
    1320                 :   15171541 : GEN gsube(GEN *x, GEN y) { *x = gsub(*x,y); return *x; }
    1321         [ +  - ]:         14 : GEN gsub1e(GEN *x) { *x = typ(*x)==t_INT?subis(*x,1):gsubgs(*x,1); return *x; }
    1322                 :            : 
    1323                 :       1392 : GEN gshift_right(GEN x, long n) { return gshift(x,-n); }
    1324                 :            : 
    1325                 :            : /********************************************************************/
    1326                 :            : /**                                                                **/
    1327                 :            : /**            PRINT USER FUNCTION AND MEMBER FUNCTION             **/
    1328                 :            : /**                                                                **/
    1329                 :            : /********************************************************************/
    1330                 :            : static int
    1331                 :          7 : cmp_epname(void *E, GEN e, GEN f)
    1332                 :            : {
    1333                 :            :   (void)E;
    1334                 :          7 :   return strcmp(((entree*)e)->name, ((entree*)f)->name);
    1335                 :            : }
    1336                 :            : 
    1337                 :            : void
    1338                 :          7 : print_all_user_fun(int member)
    1339                 :            : {
    1340                 :          7 :   pari_sp av = avma;
    1341                 :          7 :   long iL = 0, lL = 1024;
    1342                 :          7 :   GEN L = cgetg(lL+1, t_VECSMALL);
    1343                 :            :   entree *ep;
    1344                 :            :   int i;
    1345         [ +  + ]:        952 :   for (i = 0; i < functions_tblsz; i++)
    1346         [ +  + ]:       7770 :     for (ep = functions_hash[i]; ep; ep = ep->next)
    1347                 :            :     {
    1348                 :            :       const char *f;
    1349                 :            :       int is_member;
    1350 [ +  + ][ +  + ]:       6825 :       if (EpVALENCE(ep) != EpVAR || typ((GEN)ep->value)!=t_CLOSURE) continue;
    1351                 :         14 :       f = ep->name;
    1352 [ -  + ][ #  # ]:         14 :       is_member = (f[0] == '_' && f[1] == '.');
    1353         [ -  + ]:         14 :       if (member != is_member) continue;
    1354                 :            : 
    1355         [ -  + ]:         14 :       if (iL >= lL)
    1356                 :            :       {
    1357                 :          0 :         GEN oL = L;
    1358                 :            :         long j;
    1359                 :          0 :         lL *= 2; L = cgetg(lL+1, t_VECSMALL);
    1360         [ #  # ]:          0 :         for (j = 1; j <= iL; j++) gel(L,j) = gel(oL,j);
    1361                 :            :       }
    1362                 :         14 :       L[++iL] = (long)ep;
    1363                 :            :     }
    1364         [ +  - ]:          7 :   if (iL)
    1365                 :            :   {
    1366                 :          7 :     setlg(L, iL+1);
    1367                 :          7 :     L = gen_sort(L, NULL, &cmp_epname);
    1368         [ +  + ]:         21 :     for (i = 1; i <= iL; i++)
    1369                 :            :     {
    1370                 :         14 :       ep = (entree*)L[i];
    1371                 :         14 :       pari_printf("%s =\n  %Ps\n\n", ep->name, ep->value);
    1372                 :            :     }
    1373                 :            :   }
    1374                 :          7 :   avma = av;
    1375                 :          7 : }

Generated by: LCOV version 1.9