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 - eval.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25406-bf255ab81b) Lines: 1200 1732 69.3 %
Date: 2020-06-04 05:59:24 Functions: 109 141 77.3 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI 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 "opcode.h"
      18             : 
      19             : /********************************************************************/
      20             : /*                                                                  */
      21             : /*                   break/next/return handling                     */
      22             : /*                                                                  */
      23             : /********************************************************************/
      24             : 
      25             : static THREAD long br_status, br_count;
      26             : static THREAD GEN br_res;
      27             : 
      28             : long
      29    91448509 : loop_break(void)
      30             : {
      31    91448509 :   switch(br_status)
      32             :   {
      33          21 :     case br_MULTINEXT :
      34          21 :       if (! --br_count) br_status = br_NEXT;
      35          21 :       return 1;
      36       70269 :     case br_BREAK : if (! --br_count) br_status = br_NONE; /* fall through */
      37       73430 :     case br_RETURN: return 1;
      38       19838 :     case br_NEXT: br_status = br_NONE; /* fall through */
      39             :   }
      40    91375058 :   return 0;
      41             : }
      42             : 
      43             : static void
      44       78871 : reset_break(void)
      45             : {
      46       78871 :   br_status = br_NONE;
      47       78871 :   if (br_res) { gunclone_deep(br_res); br_res = NULL; }
      48       78871 : }
      49             : 
      50             : GEN
      51       33158 : return0(GEN x)
      52             : {
      53       33158 :   GEN y = br_res;
      54       33158 :   br_res = (x && x != gnil)? gcloneref(x): NULL;
      55       33158 :   guncloneNULL_deep(y);
      56       33158 :   br_status = br_RETURN; return NULL;
      57             : }
      58             : 
      59             : GEN
      60       20566 : next0(long n)
      61             : {
      62       20566 :   if (n < 1) pari_err_DOMAIN("next", "n", "<", gen_1, stoi(n));
      63       20559 :   if (n == 1) br_status = br_NEXT;
      64             :   else
      65             :   {
      66          14 :     br_count = n-1;
      67          14 :     br_status = br_MULTINEXT;
      68             :   }
      69       20559 :   return NULL;
      70             : }
      71             : 
      72             : GEN
      73       70325 : break0(long n)
      74             : {
      75       70325 :   if (n < 1) pari_err_DOMAIN("break", "n", "<", gen_1, stoi(n));
      76       70318 :   br_count = n;
      77       70318 :   br_status = br_BREAK; return NULL;
      78             : }
      79             : 
      80             : /*******************************************************************/
      81             : /*                                                                 */
      82             : /*                            VARIABLES                            */
      83             : /*                                                                 */
      84             : /*******************************************************************/
      85             : 
      86             : /* As a rule, ep->value is a clone (COPY). push_val and pop_val are private
      87             :  * functions for use in sumiter: we want a temporary ep->value, which is NOT
      88             :  * a clone (PUSH), to avoid unnecessary copies. */
      89             : 
      90             : enum {PUSH_VAL = 0, COPY_VAL = 1, DEFAULT_VAL = 2, REF_VAL = 3};
      91             : 
      92             : /* ep->args is the stack of old values (INITIAL if initial value, from
      93             :  * installep) */
      94             : typedef struct var_cell {
      95             :   struct var_cell *prev; /* cell attached to previous value on stack */
      96             :   GEN value; /* last value (not including current one, in ep->value) */
      97             :   char flag; /* status of _current_ ep->value: PUSH or COPY ? */
      98             :   long valence; /* valence of entree* attached to 'value', to be restored
      99             :                     * by pop_val */
     100             : } var_cell;
     101             : #define INITIAL NULL
     102             : 
     103             : /* Push x on value stack attached to ep. */
     104             : static void
     105       14644 : new_val_cell(entree *ep, GEN x, char flag)
     106             : {
     107       14644 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     108       14644 :   v->value  = (GEN)ep->value;
     109       14644 :   v->prev   = (var_cell*) ep->pvalue;
     110       14644 :   v->flag   = flag;
     111       14644 :   v->valence= ep->valence;
     112             : 
     113             :   /* beware: f(p) = Nv = 0
     114             :    *         Nv = p; f(Nv) --> this call would destroy p [ isclone ] */
     115       14644 :   ep->value = (flag == COPY_VAL)? gclone(x):
     116           0 :                                   (x && isclone(x))? gcopy(x): x;
     117             :   /* Do this last. In case the clone is <C-C>'ed before completion ! */
     118       14644 :   ep->pvalue= (char*)v;
     119       14644 :   ep->valence=EpVAR;
     120       14644 : }
     121             : 
     122             : /* kill ep->value and replace by preceding one, poped from value stack */
     123             : static void
     124       14357 : pop_val(entree *ep)
     125             : {
     126       14357 :   var_cell *v = (var_cell*) ep->pvalue;
     127       14357 :   if (v != INITIAL)
     128             :   {
     129       14357 :     GEN old_val = (GEN) ep->value; /* protect against SIGINT */
     130       14357 :     ep->value  = v->value;
     131       14357 :     if (v->flag == COPY_VAL) gunclone_deep(old_val);
     132       14357 :     ep->pvalue = (char*) v->prev;
     133       14357 :     ep->valence=v->valence;
     134       14357 :     pari_free((void*)v);
     135             :   }
     136       14357 : }
     137             : 
     138             : void
     139       29241 : freeep(entree *ep)
     140             : {
     141       29241 :   if (EpSTATIC(ep)) return; /* gp function loaded at init time */
     142       29241 :   if (ep->help) {pari_free((void*)ep->help); ep->help=NULL;}
     143       29241 :   if (ep->code) {pari_free((void*)ep->code); ep->code=NULL;}
     144       29241 :   switch(EpVALENCE(ep))
     145             :   {
     146       19149 :     case EpVAR:
     147       33450 :       while (ep->pvalue!=INITIAL) pop_val(ep);
     148       19149 :       break;
     149          28 :     case EpALIAS:
     150          28 :       killblock((GEN)ep->value); ep->value=NULL; break;
     151             :   }
     152             : }
     153             : 
     154             : INLINE void
     155          42 : pushvalue(entree *ep, GEN x) {
     156          42 :   new_val_cell(ep, x, COPY_VAL);
     157          42 : }
     158             : 
     159             : INLINE void
     160          14 : zerovalue(entree *ep)
     161             : {
     162          14 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     163          14 :   v->value  = (GEN)ep->value;
     164          14 :   v->prev   = (var_cell*) ep->pvalue;
     165          14 :   v->flag   = PUSH_VAL;
     166          14 :   v->valence= ep->valence;
     167          14 :   ep->value = gen_0;
     168          14 :   ep->pvalue= (char*)v;
     169          14 :   ep->valence=EpVAR;
     170          14 : }
     171             : 
     172             : /* as above IF ep->value was PUSHed, or was created after block number 'loc'
     173             :    return 0 if not deleted, 1 otherwise [for recover()] */
     174             : int
     175      213159 : pop_val_if_newer(entree *ep, long loc)
     176             : {
     177      213159 :   var_cell *v = (var_cell*) ep->pvalue;
     178             : 
     179      213159 :   if (v == INITIAL) return 0;
     180      186609 :   if (v->flag == COPY_VAL && !pop_entree_block(ep, loc)) return 0;
     181         301 :   ep->value = v->value;
     182         301 :   ep->pvalue= (char*) v->prev;
     183         301 :   ep->valence=v->valence;
     184         301 :   pari_free((void*)v); return 1;
     185             : }
     186             : 
     187             : /* set new value of ep directly to val (COPY), do not save last value unless
     188             :  * it's INITIAL. */
     189             : void
     190    29068752 : changevalue(entree *ep, GEN x)
     191             : {
     192    29068752 :   var_cell *v = (var_cell*) ep->pvalue;
     193    29068752 :   if (v == INITIAL) new_val_cell(ep, x, COPY_VAL);
     194             :   else
     195             :   {
     196    29054150 :     GEN old_val = (GEN) ep->value; /* beware: gunclone_deep may destroy old x */
     197    29054150 :     ep->value = (void *) gclone(x);
     198    29054150 :     if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     199             :   }
     200    29068752 : }
     201             : 
     202             : INLINE GEN
     203      738332 : copyvalue(entree *ep)
     204             : {
     205      738332 :   var_cell *v = (var_cell*) ep->pvalue;
     206      738332 :   if (v && v->flag != COPY_VAL)
     207             :   {
     208           0 :     ep->value = (void*) gclone((GEN)ep->value);
     209           0 :     v->flag = COPY_VAL;
     210             :   }
     211      738332 :   return (GEN) ep->value;
     212             : }
     213             : 
     214             : INLINE void
     215           0 : err_var(GEN x) { pari_err_TYPE("evaluator [variable name expected]", x); }
     216             : 
     217             : enum chk_VALUE { chk_ERROR, chk_NOCREATE, chk_CREATE };
     218             : 
     219             : INLINE void
     220   112159807 : checkvalue(entree *ep, enum chk_VALUE flag)
     221             : {
     222   112159807 :   if (mt_is_thread())
     223          24 :     pari_err(e_MISC,"mt: attempt to change exported variable '%s'",ep->name);
     224   112159783 :   if (ep->valence==EpNEW)
     225       18907 :     switch(flag)
     226             :     {
     227        4515 :       case chk_ERROR:
     228             :         /* Do nothing until we can report a meaningful error message
     229             :            The extra variable will be cleaned-up anyway */
     230             :       case chk_CREATE:
     231        4515 :         pari_var_create(ep);
     232        4515 :         ep->valence = EpVAR;
     233        4515 :         ep->value = initial_value(ep);
     234        4515 :         break;
     235       14392 :       case chk_NOCREATE:
     236       14392 :         break;
     237             :     }
     238   112159783 :   else if (ep->valence!=EpVAR)
     239           0 :     pari_err(e_MISC, "attempt to change built-in %s", ep->name);
     240   112159783 : }
     241             : 
     242             : INLINE GEN
     243    23111823 : checkvalueptr(entree *ep)
     244             : {
     245    23111823 :   checkvalue(ep, chk_NOCREATE);
     246    23111823 :   return ep->valence==EpNEW? gen_0: (GEN)ep->value;
     247             : }
     248             : 
     249             : /* make GP variables safe for set_avma(top) */
     250             : static void
     251           0 : lvar_make_safe(void)
     252             : {
     253             :   long n;
     254             :   entree *ep;
     255           0 :   for (n = 0; n < functions_tblsz; n++)
     256           0 :     for (ep = functions_hash[n]; ep; ep = ep->next)
     257           0 :       if (EpVALENCE(ep) == EpVAR)
     258             :       { /* make sure ep->value is a COPY */
     259           0 :         var_cell *v = (var_cell*)ep->pvalue;
     260           0 :         if (v && v->flag == PUSH_VAL) {
     261           0 :           GEN x = (GEN)ep->value;
     262           0 :           if (x) changevalue(ep, (GEN)ep->value); else pop_val(ep);
     263             :         }
     264             :       }
     265           0 : }
     266             : 
     267             : static void
     268   104787749 : check_array_index(long c, long l)
     269             : {
     270   104787749 :   if (c < 1) pari_err_COMPONENT("", "<", gen_1, stoi(c));
     271   104787742 :   if (c >= l) pari_err_COMPONENT("", ">", stoi(l-1), stoi(c));
     272   104787700 : }
     273             : 
     274             : GEN*
     275           0 : safegel(GEN x, long l)
     276             : {
     277           0 :   if (!is_matvec_t(typ(x)))
     278           0 :     pari_err_TYPE("safegel",x);
     279           0 :   check_array_index(l, lg(x));
     280           0 :   return &(gel(x,l));
     281             : }
     282             : 
     283             : GEN*
     284           0 : safelistel(GEN x, long l)
     285             : {
     286             :   GEN d;
     287           0 :   if (typ(x)!=t_LIST || list_typ(x)!=t_LIST_RAW)
     288           0 :     pari_err_TYPE("safelistel",x);
     289           0 :   d = list_data(x);
     290           0 :   check_array_index(l, lg(d));
     291           0 :   return &(gel(d,l));
     292             : }
     293             : 
     294             : long*
     295           0 : safeel(GEN x, long l)
     296             : {
     297           0 :   if (typ(x)!=t_VECSMALL)
     298           0 :     pari_err_TYPE("safeel",x);
     299           0 :   check_array_index(l, lg(x));
     300           0 :   return &(x[l]);
     301             : }
     302             : 
     303             : GEN*
     304           0 : safegcoeff(GEN x, long a, long b)
     305             : {
     306           0 :   if (typ(x)!=t_MAT) pari_err_TYPE("safegcoeff", x);
     307           0 :   check_array_index(b, lg(x));
     308           0 :   check_array_index(a, lg(gel(x,b)));
     309           0 :   return &(gcoeff(x,a,b));
     310             : }
     311             : 
     312             : typedef struct matcomp
     313             : {
     314             :   GEN *ptcell;
     315             :   GEN parent;
     316             :   int full_col, full_row;
     317             : } matcomp;
     318             : 
     319             : typedef struct gp_pointer
     320             : {
     321             :   matcomp c;
     322             :   GEN x, ox;
     323             :   entree *ep;
     324             :   long vn;
     325             :   long sp;
     326             : } gp_pointer;
     327             : 
     328             : /* assign res at *pt in "simple array object" p and return it, or a copy.*/
     329             : static void
     330     9697429 : change_compo(matcomp *c, GEN res)
     331             : {
     332     9697429 :   GEN p = c->parent, *pt = c->ptcell;
     333             :   long i, t;
     334             : 
     335     9697429 :   if (typ(p) == t_VECSMALL)
     336             :   {
     337          21 :     if (typ(res) != t_INT || is_bigint(res))
     338          14 :       pari_err_TYPE("t_VECSMALL assignment", res);
     339           7 :     *pt = (GEN)itos(res); return;
     340             :   }
     341     9697408 :   t = typ(res);
     342     9697408 :   if (c->full_row)
     343             :   {
     344      204834 :     if (t != t_VEC) pari_err_TYPE("matrix row assignment", res);
     345      204813 :     if (lg(res) != lg(p)) pari_err_DIM("matrix row assignment");
     346     2097662 :     for (i=1; i<lg(p); i++)
     347             :     {
     348     1892870 :       GEN p1 = gcoeff(p,c->full_row,i); /* Protect against SIGINT */
     349     1892870 :       gcoeff(p,c->full_row,i) = gclone(gel(res,i));
     350     1892870 :       if (isclone(p1)) gunclone_deep(p1);
     351             :     }
     352      204792 :     return;
     353             :   }
     354     9492574 :   if (c->full_col)
     355             :   {
     356      355355 :     if (t != t_COL) pari_err_TYPE("matrix col assignment", res);
     357      355341 :     if (lg(res) != lg(*pt)) pari_err_DIM("matrix col assignment");
     358             :   }
     359             : 
     360     9492553 :   res = gclone(res);
     361     9492553 :   gunclone_deep(*pt);
     362     9492553 :   *pt = res;
     363             : }
     364             : 
     365             : /***************************************************************************
     366             :  **                                                                       **
     367             :  **                           Byte-code evaluator                         **
     368             :  **                                                                       **
     369             :  ***************************************************************************/
     370             : 
     371             : struct var_lex
     372             : {
     373             :   long flag;
     374             :   GEN value;
     375             : };
     376             : 
     377             : struct trace
     378             : {
     379             :   long pc;
     380             :   GEN closure;
     381             : };
     382             : 
     383             : static THREAD long sp, rp, dbg_level;
     384             : static THREAD long *st, *precs;
     385             : static THREAD GEN *locks;
     386             : static THREAD gp_pointer *ptrs;
     387             : static THREAD entree **lvars;
     388             : static THREAD struct var_lex *var;
     389             : static THREAD struct trace *trace;
     390             : static THREAD pari_stack s_st, s_ptrs, s_var, s_trace, s_prec;
     391             : static THREAD pari_stack s_lvars, s_locks;
     392             : 
     393             : static void
     394   158355619 : changelex(long vn, GEN x)
     395             : {
     396   158355619 :   struct var_lex *v=var+s_var.n+vn;
     397   158355619 :   GEN old_val = v->value;
     398   158355619 :   v->value = gclone(x);
     399   158355618 :   if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     400   158355618 : }
     401             : 
     402             : INLINE GEN
     403     9768584 : copylex(long vn)
     404             : {
     405     9768584 :   struct var_lex *v = var+s_var.n+vn;
     406     9768584 :   if (v->flag!=COPY_VAL && v->flag!=REF_VAL)
     407             :   {
     408       52920 :     v->value = gclone(v->value);
     409       52920 :     v->flag  = COPY_VAL;
     410             :   }
     411     9768584 :   return v->value;
     412             : }
     413             : 
     414             : INLINE void
     415         259 : setreflex(long vn)
     416             : {
     417         259 :   struct var_lex *v = var+s_var.n+vn;
     418         259 :   v->flag  = REF_VAL;
     419         259 : }
     420             : 
     421             : INLINE void
     422    61469058 : pushlex(long vn, GEN x)
     423             : {
     424    61469058 :   struct var_lex *v=var+s_var.n+vn;
     425    61469058 :   v->flag  = PUSH_VAL;
     426    61469058 :   v->value = x;
     427    61469058 : }
     428             : 
     429             : INLINE void
     430   161320049 : freelex(void)
     431             : {
     432   161320049 :   struct var_lex *v=var+s_var.n-1;
     433   161320049 :   s_var.n--;
     434   161320049 :   if (v->flag == COPY_VAL) gunclone_deep(v->value);
     435   161320049 : }
     436             : 
     437             : INLINE void
     438   195840432 : restore_vars(long nbmvar, long nblvar, long nblock)
     439             : {
     440             :   long j;
     441   351508584 :   for(j=1;j<=nbmvar;j++)
     442   155667941 :     freelex();
     443   195840699 :   for(j=1;j<=nblvar;j++)
     444          56 :     { s_lvars.n--; pop_val(lvars[s_lvars.n]); }
     445   195840888 :   for(j=1;j<=nblock;j++)
     446         245 :     { s_locks.n--; gunclone(locks[s_locks.n]); }
     447   195840643 : }
     448             : 
     449             : INLINE void
     450       44606 : restore_trace(long nbtrace)
     451             : {
     452             :   long j;
     453      100749 :   for(j=1;j<=nbtrace;j++)
     454             :   {
     455       56143 :     GEN C = trace[s_trace.n-j].closure;
     456       56143 :     clone_unlock(C);
     457             :   }
     458       44606 :   s_trace.n-=nbtrace;
     459       44606 : }
     460             : 
     461             : INLINE long
     462   201270068 : trace_push(long pc, GEN C)
     463             : {
     464             :   long tr;
     465   201270068 :   BLOCK_SIGINT_START
     466   202295061 :   tr = pari_stack_new(&s_trace);
     467   201871885 :   trace[tr].pc = pc;
     468   201871885 :   clone_lock(C);
     469   201521136 :   trace[tr].closure = C;
     470   201521136 :   BLOCK_SIGINT_END
     471   202217709 :   return tr;
     472             : }
     473             : 
     474             : void
     475     5652491 : push_lex(GEN a, GEN C)
     476             : {
     477     5652491 :   long vn=pari_stack_new(&s_var);
     478     5652491 :   struct var_lex *v=var+vn;
     479     5652491 :   v->flag  = PUSH_VAL;
     480     5652491 :   v->value = a;
     481     5652491 :   if (C) (void) trace_push(-1, C);
     482     5652491 : }
     483             : 
     484             : GEN
     485    45233802 : get_lex(long vn)
     486             : {
     487    45233802 :   struct var_lex *v=var+s_var.n+vn;
     488    45233802 :   return v->value;
     489             : }
     490             : 
     491             : void
     492    42235886 : set_lex(long vn, GEN x)
     493             : {
     494    42235886 :   struct var_lex *v=var+s_var.n+vn;
     495    42235886 :   if (v->flag == COPY_VAL) { gunclone_deep(v->value); v->flag = PUSH_VAL; }
     496    42235886 :   v->value = x;
     497    42235886 : }
     498             : 
     499             : void
     500     5512886 : pop_lex(long n)
     501             : {
     502             :   long j;
     503    11165100 :   for(j=1; j<=n; j++)
     504     5652214 :     freelex();
     505     5512886 :   s_trace.n--;
     506     5512886 : }
     507             : 
     508             : static THREAD pari_stack s_relocs;
     509             : static THREAD entree **relocs;
     510             : 
     511             : void
     512      161057 : pari_init_evaluator(void)
     513             : {
     514      161057 :   sp=0;
     515      161057 :   pari_stack_init(&s_st,sizeof(*st),(void**)&st);
     516      161030 :   pari_stack_alloc(&s_st,32);
     517      161600 :   s_st.n=s_st.alloc;
     518      161600 :   rp=0;
     519      161600 :   pari_stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
     520      161503 :   pari_stack_alloc(&s_ptrs,16);
     521      161684 :   s_ptrs.n=s_ptrs.alloc;
     522      161684 :   pari_stack_init(&s_var,sizeof(*var),(void**)&var);
     523      161483 :   pari_stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
     524      161215 :   pari_stack_init(&s_locks,sizeof(*locks),(void**)&locks);
     525      161036 :   pari_stack_init(&s_trace,sizeof(*trace),(void**)&trace);
     526      160903 :   br_res = NULL;
     527      160903 :   pari_stack_init(&s_relocs,sizeof(*relocs),(void**)&relocs);
     528      160789 :   pari_stack_init(&s_prec,sizeof(*precs),(void**)&precs);
     529      160704 : }
     530             : void
     531      160313 : pari_close_evaluator(void)
     532             : {
     533      160313 :   pari_stack_delete(&s_st);
     534      161891 :   pari_stack_delete(&s_ptrs);
     535      161899 :   pari_stack_delete(&s_var);
     536      161877 :   pari_stack_delete(&s_lvars);
     537      161456 :   pari_stack_delete(&s_trace);
     538      161844 :   pari_stack_delete(&s_relocs);
     539      161429 :   pari_stack_delete(&s_prec);
     540      161785 : }
     541             : 
     542             : static gp_pointer *
     543    58406441 : new_ptr(void)
     544             : {
     545    58406441 :   if (rp==s_ptrs.n-1)
     546             :   {
     547             :     long i;
     548           0 :     gp_pointer *old = ptrs;
     549           0 :     (void)pari_stack_new(&s_ptrs);
     550           0 :     if (old != ptrs)
     551           0 :       for(i=0; i<rp; i++)
     552             :       {
     553           0 :         gp_pointer *g = &ptrs[i];
     554           0 :         if(g->sp >= 0) gel(st,g->sp) = (GEN) &(g->x);
     555             :       }
     556             :   }
     557    58406441 :   return &ptrs[rp++];
     558             : }
     559             : 
     560             : void
     561      253522 : push_localbitprec(long p)
     562             : {
     563      253522 :   long n = pari_stack_new(&s_prec);
     564      254280 :   precs[n] = p;
     565      254280 : }
     566             : void
     567       83730 : push_localprec(long p) { push_localbitprec(prec2nbits(p)); }
     568             : 
     569             : void
     570       83723 : pop_localprec(void) { s_prec.n--; }
     571             : 
     572             : long
     573    16307827 : get_localbitprec(void) { return s_prec.n? precs[s_prec.n-1]: precreal; }
     574             : 
     575             : long
     576    16125334 : get_localprec(void) { return nbits2prec(get_localbitprec()); }
     577             : 
     578             : static void
     579       10787 : checkprec(const char *f, long p, long M)
     580             : {
     581       10787 :   if (p < 1) pari_err_DOMAIN(f, "p", "<", gen_1, stoi(p));
     582       10773 :   if (p > M) pari_err_DOMAIN(f, "p", ">", utoipos(M), utoi(p));
     583       10761 : }
     584             : static long
     585       10866 : _prec(GEN p, const char *f)
     586             : {
     587       10866 :   pari_sp av = avma;
     588       10866 :   if (typ(p) == t_INT) return itos(p);
     589          35 :   p = gceil(p);
     590          35 :   if (typ(p) != t_INT) pari_err_TYPE(f, p);
     591          28 :   return gc_long(av, itos(p));
     592             : }
     593             : void
     594        7791 : localprec(GEN pp)
     595             : {
     596        7791 :   long p = _prec(pp, "localprec");
     597        7783 :   checkprec("localprec", p, prec2ndec(LGBITS));
     598        7770 :   p = ndec2nbits(p); push_localbitprec(p);
     599        7770 : }
     600             : void
     601        3005 : localbitprec(GEN pp)
     602             : {
     603        3005 :   long p = _prec(pp, "localbitprec");
     604        3004 :   checkprec("localbitprec", p, (long)LGBITS);
     605        2991 :   push_localbitprec(p);
     606        2991 : }
     607             : long
     608          14 : getlocalprec(long prec) { return prec2ndec(prec); }
     609             : long
     610         161 : getlocalbitprec(long bit) { return bit; }
     611             : 
     612             : static GEN
     613        3752 : _precision0(GEN x)
     614             : {
     615        3752 :   long a = gprecision(x);
     616        3752 :   return a? utoi(prec2ndec(a)): mkoo();
     617             : }
     618             : GEN
     619          35 : precision0(GEN x, long n)
     620          35 : { return n? gprec(x,n): _precision0(x); }
     621             : static GEN
     622         587 : _bitprecision0(GEN x)
     623             : {
     624         587 :   long a = gprecision(x);
     625         587 :   return a? utoi(prec2nbits(a)): mkoo();
     626             : }
     627             : GEN
     628          35 : bitprecision0(GEN x, long n)
     629             : {
     630          35 :   if (n < 0)
     631           0 :     pari_err_DOMAIN("bitprecision", "bitprecision", "<", gen_0, stoi(n));
     632          35 :   if (n) {
     633          35 :     pari_sp av = avma;
     634          35 :     GEN y = gprec_w(x, nbits2prec(n));
     635          35 :     return gerepilecopy(av, y);
     636             :   }
     637           0 :   return _bitprecision0(x);
     638             : }
     639             : GEN
     640        3787 : precision00(GEN x, GEN n)
     641             : {
     642        3787 :   if (!n) return _precision0(x);
     643          35 :   return precision0(x, _prec(n, "precision"));
     644             : }
     645             : GEN
     646         622 : bitprecision00(GEN x, GEN n)
     647             : {
     648         622 :   if (!n) return _bitprecision0(x);
     649          35 :   return bitprecision0(x, _prec(n, "bitprecision"));
     650             : }
     651             : 
     652             : INLINE GEN
     653    27820797 : copyupto(GEN z, GEN t)
     654             : {
     655    27820797 :   if (is_universal_constant(z) || (z>(GEN)pari_mainstack->bot && z<=t))
     656    26248047 :     return z;
     657             :   else
     658     1572544 :     return gcopy(z);
     659             : }
     660             : 
     661             : static void closure_eval(GEN C);
     662             : 
     663             : INLINE GEN
     664       33925 : get_and_reset_break(void)
     665             : {
     666       33925 :   GEN z = br_res? gcopy(br_res): gnil;
     667       33925 :   reset_break(); return z;
     668             : }
     669             : 
     670             : INLINE GEN
     671    40066251 : closure_return(GEN C)
     672             : {
     673    40066251 :   pari_sp av = avma;
     674    40066251 :   closure_eval(C);
     675    40044166 :   if (br_status) { set_avma(av); return get_and_reset_break(); }
     676    40010290 :   return gerepileupto(av, gel(st,--sp));
     677             : }
     678             : 
     679             : /* for the break_loop debugger. Not memory clean */
     680             : GEN
     681         175 : closure_evalbrk(GEN C, long *status)
     682             : {
     683         175 :   closure_eval(C); *status = br_status;
     684         140 :   return br_status? get_and_reset_break(): gel(st,--sp);
     685             : }
     686             : 
     687             : INLINE long
     688     1133831 : closure_varn(GEN x)
     689             : {
     690     1133831 :   if (!x) return -1;
     691     1133271 :   if (!gequalX(x)) err_var(x);
     692     1133271 :   return varn(x);
     693             : }
     694             : 
     695             : INLINE void
     696    91700697 : closure_castgen(GEN z, long mode)
     697             : {
     698    91700697 :   switch (mode)
     699             :   {
     700    91700032 :   case Ggen:
     701    91700032 :     gel(st,sp++)=z;
     702    91700032 :     break;
     703         665 :   case Gsmall:
     704         665 :     st[sp++]=gtos(z);
     705         665 :     break;
     706           0 :   case Gusmall:
     707           0 :     st[sp++]=gtou(z);
     708           0 :     break;
     709           0 :   case Gvar:
     710           0 :     st[sp++]=closure_varn(z);
     711           0 :     break;
     712           0 :   case Gvoid:
     713           0 :     break;
     714           0 :   default:
     715           0 :     pari_err_BUG("closure_castgen, type unknown");
     716             :   }
     717    91700697 : }
     718             : 
     719             : INLINE void
     720        5467 : closure_castlong(long z, long mode)
     721             : {
     722        5467 :   switch (mode)
     723             :   {
     724           0 :   case Gsmall:
     725           0 :     st[sp++]=z;
     726           0 :     break;
     727           0 :   case Gusmall:
     728           0 :     if (z < 0)
     729           0 :       pari_err_TYPE("stou [integer >=0 expected]", stoi(z));
     730           0 :     st[sp++]=(ulong) z;
     731           0 :     break;
     732        5460 :   case Ggen:
     733        5460 :     gel(st,sp++)=stoi(z);
     734        5460 :     break;
     735           0 :   case Gvar:
     736           0 :     err_var(stoi(z));
     737           7 :   case Gvoid:
     738           7 :     break;
     739           0 :   default:
     740           0 :     pari_err_BUG("closure_castlong, type unknown");
     741             :   }
     742        5467 : }
     743             : 
     744             : const char *
     745       10255 : closure_func_err(void)
     746             : {
     747       10255 :   long fun=s_trace.n-1, pc;
     748             :   const char *code;
     749             :   GEN C, oper;
     750       10255 :   if (fun < 0 || trace[fun].pc < 0) return NULL;
     751        9692 :   pc = trace[fun].pc; C  = trace[fun].closure;
     752        9692 :   code = closure_codestr(C); oper = closure_get_oper(C);
     753        9692 :   if (code[pc]==OCcallgen || code[pc]==OCcallgen2 ||
     754        3441 :       code[pc]==OCcallint || code[pc]==OCcalllong || code[pc]==OCcallvoid)
     755        6738 :     return ((entree*)oper[pc])->name;
     756        2954 :   return NULL;
     757             : }
     758             : 
     759             : /* return the next label for the call chain debugger closure_err(),
     760             :  * incorporating the name of the user of member function. Return NULL for an
     761             :  * anonymous (inline) closure. */
     762             : static char *
     763         238 : get_next_label(const char *s, int member, char **next_fun)
     764             : {
     765         238 :   const char *v, *t = s+1;
     766             :   char *u, *next_label;
     767             : 
     768         238 :   if (!is_keyword_char(*s)) return NULL;
     769         854 :   while (is_keyword_char(*t)) t++;
     770             :   /* e.g. (x->1/x)(0) instead of (x)->1/x */
     771         217 :   if (t[0] == '-' && t[1] == '>') return NULL;
     772         210 :   next_label = (char*)pari_malloc(t - s + 32);
     773         210 :   sprintf(next_label, "in %sfunction ", member? "member ": "");
     774         210 :   u = *next_fun = next_label + strlen(next_label);
     775         210 :   v = s;
     776        1057 :   while (v < t) *u++ = *v++;
     777         210 :   *u++ = 0; return next_label;
     778             : }
     779             : 
     780             : static const char *
     781          21 : get_arg_name(GEN C, long i)
     782             : {
     783          21 :   GEN d = closure_get_dbg(C), frpc = gel(d,2), fram = gel(d,3);
     784          21 :   long j, l = lg(frpc);
     785          28 :   for (j=1; j<l; j++)
     786          28 :     if (frpc[j]==1 && i<lg(gel(fram,j)))
     787          21 :       return ((entree*)mael(fram,j,i))->name;
     788           0 :   return "(unnamed)";
     789             : }
     790             : 
     791             : void
     792        9705 : closure_err(long level)
     793             : {
     794             :   GEN base;
     795        9705 :   const long lastfun = s_trace.n - 1 - level;
     796             :   char *next_label, *next_fun;
     797        9705 :   long i = maxss(0, lastfun - 19);
     798        9705 :   if (lastfun < 0) return; /*e.g. when called by gp_main_loop's simplify */
     799        9705 :   if (i > 0) while (lg(trace[i].closure)==6) i--;
     800        9705 :   base = closure_get_text(trace[i].closure); /* gcc -Wall*/
     801        9705 :   next_label = pari_strdup(i == 0? "at top-level": "[...] at");
     802        9705 :   next_fun = next_label;
     803       10341 :   for (; i <= lastfun; i++)
     804             :   {
     805       10341 :     GEN C = trace[i].closure;
     806       10341 :     if (lg(C) >= 7) base=closure_get_text(C);
     807       10341 :     if ((i==lastfun || lg(trace[i+1].closure)>=7))
     808             :     {
     809        9943 :       GEN dbg = gel(closure_get_dbg(C),1);
     810             :       /* After a SIGINT, pc can be slightly off: ensure 0 <= pc < lg() */
     811        9943 :       long pc = minss(lg(dbg)-1, trace[i].pc>=0 ? trace[i].pc: 1);
     812        9943 :       long offset = pc? dbg[pc]: 0;
     813             :       int member;
     814             :       const char *s, *sbase;
     815        9943 :       if (typ(base)!=t_VEC) sbase = GSTR(base);
     816         182 :       else if (offset>=0)   sbase = GSTR(gel(base,2));
     817          21 :       else { sbase = GSTR(gel(base,1)); offset += strlen(sbase); }
     818        9943 :       s = sbase + offset;
     819        9943 :       member = offset>0 && (s[-1] == '.');
     820             :       /* avoid "in function foo: foo" */
     821        9943 :       if (!next_fun || strcmp(next_fun, s)) {
     822        9936 :         print_errcontext(pariErr, next_label, s, sbase);
     823        9936 :         out_putc(pariErr, '\n');
     824             :       }
     825        9943 :       pari_free(next_label);
     826        9943 :       if (i == lastfun) break;
     827             : 
     828         238 :       next_label = get_next_label(s, member, &next_fun);
     829         238 :       if (!next_label) {
     830          28 :         next_label = pari_strdup("in anonymous function");
     831          28 :         next_fun = NULL;
     832             :       }
     833             :     }
     834             :   }
     835             : }
     836             : 
     837             : GEN
     838          37 : pari_self(void)
     839             : {
     840          37 :   long fun = s_trace.n - 1;
     841          72 :   if (fun > 0) while (lg(trace[fun].closure)==6) fun--;
     842          37 :   return fun >= 0 ? trace[fun].closure: NULL;
     843             : }
     844             : 
     845             : long
     846          91 : closure_context(long start, long level)
     847             : {
     848          91 :   const long lastfun = s_trace.n - 1 - level;
     849          91 :   long i, fun = lastfun;
     850          91 :   if (fun<0) return lastfun;
     851         224 :   while (fun>start && lg(trace[fun].closure)==6) fun--;
     852         315 :   for (i=fun; i <= lastfun; i++)
     853         224 :     push_frame(trace[i].closure, trace[i].pc,0);
     854         126 :   for (  ; i < s_trace.n; i++)
     855          35 :     push_frame(trace[i].closure, trace[i].pc,1);
     856          91 :   return s_trace.n-level;
     857             : }
     858             : 
     859             : INLINE void
     860  2347112337 : st_alloc(long n)
     861             : {
     862  2347112337 :   if (sp+n>s_st.n)
     863             :   {
     864          49 :     pari_stack_alloc(&s_st,n+16);
     865          49 :     s_st.n=s_st.alloc;
     866          49 :     if (DEBUGMEM>=2) pari_warn(warner,"doubling evaluator stack");
     867             :   }
     868  2347112337 : }
     869             : 
     870             : INLINE void
     871     9902410 : ptr_proplock(gp_pointer *g, GEN C)
     872             : {
     873     9902410 :   g->x = C;
     874     9902410 :   if (isclone(g->x))
     875             :   {
     876      444465 :     clone_unlock_deep(g->ox);
     877      444465 :     g->ox = g->x;
     878      444465 :     ++bl_refc(g->ox);
     879             :   }
     880     9902410 : }
     881             : 
     882             : static void
     883   195846133 : closure_eval(GEN C)
     884             : {
     885   195846133 :   const char *code=closure_codestr(C);
     886   195825481 :   GEN oper=closure_get_oper(C);
     887   195808424 :   GEN data=closure_get_data(C);
     888   195798376 :   long loper=lg(oper);
     889   195798376 :   long saved_sp=sp-closure_arity(C);
     890   195788882 :   long saved_rp=rp, saved_prec=s_prec.n;
     891   195788882 :   long j, nbmvar=0, nblvar=0, nblock=0;
     892             :   long pc, t;
     893             : #ifdef STACK_CHECK
     894             :   GEN stackelt;
     895   195788882 :   if (PARI_stack_limit && (void*) &stackelt <= PARI_stack_limit)
     896           0 :     pari_err(e_MISC, "deep recursion");
     897             : #endif
     898   195788882 :   t = trace_push(0, C);
     899   196478941 :   if (lg(C)==8)
     900             :   {
     901     5322299 :     GEN z=closure_get_frame(C);
     902     5322248 :     long l=lg(z)-1;
     903     5322248 :     pari_stack_alloc(&s_var,l);
     904     5324369 :     s_var.n+=l;
     905     5324369 :     nbmvar+=l;
     906    21179060 :     for(j=1;j<=l;j++)
     907             :     {
     908    15854691 :       var[s_var.n-j].flag=PUSH_VAL;
     909    15854691 :       var[s_var.n-j].value=gel(z,j);
     910             :     }
     911             :   }
     912             : 
     913  2476337320 :   for(pc=1;pc<loper;pc++)
     914             :   {
     915  2280387268 :     op_code opcode=(op_code) code[pc];
     916  2280387268 :     long operand=oper[pc];
     917  2280387268 :     if (sp<0) pari_err_BUG("closure_eval, stack underflow");
     918  2280387268 :     st_alloc(16);
     919  2280254071 :     trace[t].pc = pc;
     920             :     CHECK_CTRLC
     921  2280254071 :     switch(opcode)
     922             :     {
     923   164522643 :     case OCpushlong:
     924   164522643 :       st[sp++]=operand;
     925   164522643 :       break;
     926       95045 :     case OCpushgnil:
     927       95045 :       gel(st,sp++)=gnil;
     928       95045 :       break;
     929    97226743 :     case OCpushgen:
     930    97226743 :       gel(st,sp++)=gel(data,operand);
     931    97226743 :       break;
     932       84302 :     case OCpushreal:
     933       84302 :       gel(st,sp++)=strtor(GSTR(data[operand]),get_localprec());
     934       84302 :       break;
     935   166567198 :     case OCpushstoi:
     936   166567198 :       gel(st,sp++)=stoi(operand);
     937   166567186 :       break;
     938       26069 :     case OCpushvar:
     939             :       {
     940       26069 :         entree *ep = (entree *)operand;
     941       26069 :         gel(st,sp++)=pol_x(pari_var_create(ep));
     942       26069 :         break;
     943             :       }
     944    82353082 :     case OCpushdyn:
     945             :       {
     946    82353082 :         entree *ep = (entree *)operand;
     947    82353082 :         if (!mt_is_thread())
     948             :         {
     949    82352587 :           checkvalue(ep, chk_CREATE);
     950    82352587 :           gel(st,sp++)=(GEN)ep->value;
     951             :         } else
     952             :         {
     953         495 :           GEN val = export_get(ep->name);
     954         495 :           if (!val)
     955           0 :             pari_err(e_MISC,"mt: please use export(%s)", ep->name);
     956         495 :           gel(st,sp++)=val;
     957             :         }
     958    82353082 :         break;
     959             :       }
     960   494874305 :     case OCpushlex:
     961   494874305 :       gel(st,sp++)=var[s_var.n+operand].value;
     962   494874305 :       break;
     963    23111823 :     case OCsimpleptrdyn:
     964             :       {
     965    23111823 :         gp_pointer *g = new_ptr();
     966    23111823 :         g->vn=0;
     967    23111823 :         g->ep = (entree*) operand;
     968    23111823 :         g->x = checkvalueptr(g->ep);
     969    23111823 :         g->ox = g->x; clone_lock(g->ox);
     970    23111823 :         g->sp = sp;
     971    23111823 :         gel(st,sp++) = (GEN)&(g->x);
     972    23111823 :         break;
     973             :       }
     974    25597140 :     case OCsimpleptrlex:
     975             :       {
     976    25597140 :         gp_pointer *g = new_ptr();
     977    25597140 :         g->vn=operand;
     978    25597140 :         g->ep=(entree *)0x1L;
     979    25597140 :         g->x = (GEN) var[s_var.n+operand].value;
     980    25597140 :         g->ox = g->x; clone_lock(g->ox);
     981    25597140 :         g->sp = sp;
     982    25597140 :         gel(st,sp++) = (GEN)&(g->x);
     983    25597140 :         break;
     984             :       }
     985        2919 :     case OCnewptrdyn:
     986             :       {
     987        2919 :         entree *ep = (entree *)operand;
     988        2919 :         gp_pointer *g = new_ptr();
     989             :         matcomp *C;
     990        2919 :         checkvalue(ep, chk_ERROR);
     991        2919 :         g->sp = -1;
     992        2919 :         g->x = copyvalue(ep);
     993        2919 :         g->ox = g->x; clone_lock(g->ox);
     994        2919 :         g->vn=0;
     995        2919 :         g->ep=NULL;
     996        2919 :         C=&g->c;
     997        2919 :         C->full_col = C->full_row = 0;
     998        2919 :         C->parent   = (GEN)    g->x;
     999        2919 :         C->ptcell   = (GEN *) &g->x;
    1000        2919 :         break;
    1001             :       }
    1002     9694559 :     case OCnewptrlex:
    1003             :       {
    1004     9694559 :         gp_pointer *g = new_ptr();
    1005             :         matcomp *C;
    1006     9694559 :         g->sp = -1;
    1007     9694559 :         g->x = copylex(operand);
    1008     9694559 :         g->ox = g->x; clone_lock(g->ox);
    1009     9694559 :         g->vn=0;
    1010     9694559 :         g->ep=NULL;
    1011     9694559 :         C=&g->c;
    1012     9694559 :         C->full_col = C->full_row = 0;
    1013     9694559 :         C->parent   = (GEN)     g->x;
    1014     9694559 :         C->ptcell   = (GEN *) &(g->x);
    1015     9694559 :         break;
    1016             :       }
    1017      557606 :     case OCpushptr:
    1018             :       {
    1019      557606 :         gp_pointer *g = &ptrs[rp-1];
    1020      557606 :         g->sp = sp;
    1021      557606 :         gel(st,sp++) = (GEN)&(g->x);
    1022             :       }
    1023      557606 :       break;
    1024    49266513 :     case OCendptr:
    1025    98533026 :       for(j=0;j<operand;j++)
    1026             :       {
    1027    49266513 :         gp_pointer *g = &ptrs[--rp];
    1028    49266513 :         if (g->ep)
    1029             :         {
    1030    48708907 :           if (g->vn)
    1031    25597140 :             changelex(g->vn, g->x);
    1032             :           else
    1033    23111767 :             changevalue(g->ep, g->x);
    1034             :         }
    1035      557606 :         else change_compo(&(g->c), g->x);
    1036    49266513 :         clone_unlock_deep(g->ox);
    1037             :       }
    1038    49266513 :       break;
    1039     5956993 :     case OCstoredyn:
    1040             :       {
    1041     5956993 :         entree *ep = (entree *)operand;
    1042     5956993 :         checkvalue(ep, chk_NOCREATE);
    1043     5956985 :         changevalue(ep, gel(st,--sp));
    1044     5956985 :         break;
    1045             :       }
    1046   132758479 :     case OCstorelex:
    1047   132758479 :       changelex(operand,gel(st,--sp));
    1048   132758478 :       break;
    1049     9139823 :     case OCstoreptr:
    1050             :       {
    1051     9139823 :         gp_pointer *g = &ptrs[--rp];
    1052     9139823 :         change_compo(&(g->c), gel(st,--sp));
    1053     9139746 :         clone_unlock_deep(g->ox);
    1054     9139746 :         break;
    1055             :       }
    1056    21786810 :     case OCstackgen:
    1057             :       {
    1058    21786810 :         GEN z = gerepileupto(st[sp-2],gel(st,sp-1));
    1059    21786808 :         gmael(st,sp-3,operand) = copyupto(z,gel(st,sp-2));
    1060    21786813 :         st[sp-2] = avma;
    1061    21786813 :         sp--;
    1062    21786813 :         break;
    1063             :       }
    1064    16041027 :     case OCprecreal:
    1065    16041027 :       st[sp++]=get_localprec();
    1066    16041031 :       break;
    1067       21525 :     case OCbitprecreal:
    1068       21525 :       st[sp++]=get_localbitprec();
    1069       21525 :       break;
    1070         917 :     case OCprecdl:
    1071         917 :       st[sp++]=precdl;
    1072         917 :       break;
    1073        2170 :     case OCavma:
    1074        2170 :       st[sp++]=avma;
    1075        2170 :       break;
    1076      735413 :     case OCcowvardyn:
    1077             :       {
    1078      735413 :         entree *ep = (entree *)operand;
    1079      735413 :         checkvalue(ep, chk_ERROR);
    1080      735413 :         (void)copyvalue(ep);
    1081      735413 :         break;
    1082             :       }
    1083       73024 :     case OCcowvarlex:
    1084       73024 :       (void)copylex(operand);
    1085       73024 :       break;
    1086         259 :     case OCsetref:
    1087         259 :       setreflex(operand);
    1088         259 :       break;
    1089         259 :     case OClock:
    1090             :     {
    1091         259 :       GEN v = gel(st,sp-1);
    1092         259 :       if (isclone(v))
    1093             :       {
    1094         245 :         long n = pari_stack_new(&s_locks);
    1095         245 :         locks[n] = v;
    1096         245 :         nblock++;
    1097         245 :         ++bl_refc(v);
    1098             :       }
    1099         259 :       break;
    1100             :     }
    1101    14918298 :     case OCstoi:
    1102    14918298 :       gel(st,sp-1)=stoi(st[sp-1]);
    1103    14918940 :       break;
    1104           0 :     case OCutoi:
    1105           0 :       gel(st,sp-1)=utoi(st[sp-1]);
    1106           0 :       break;
    1107    70805167 :     case OCitos:
    1108    70805167 :       st[sp+operand]=gtos(gel(st,sp+operand));
    1109    70805154 :       break;
    1110       82557 :     case OCitou:
    1111       82557 :       st[sp+operand]=gtou(gel(st,sp+operand));
    1112       82557 :       break;
    1113        5122 :     case OCtostr:
    1114             :       {
    1115        5122 :         GEN z = gel(st,sp+operand);
    1116        5122 :         st[sp+operand] = (long) (z ? GENtostr_unquoted(z): NULL);
    1117        5122 :         break;
    1118             :       }
    1119     1133831 :     case OCvarn:
    1120     1133831 :       st[sp+operand] = closure_varn(gel(st,sp+operand));
    1121     1133831 :       break;
    1122    23792605 :     case OCcopy:
    1123    23792605 :       gel(st,sp-1) = gcopy(gel(st,sp-1));
    1124    23792605 :       break;
    1125        2170 :     case OCgerepile:
    1126             :     {
    1127             :       pari_sp av;
    1128             :       GEN x;
    1129        2170 :       sp--;
    1130        2170 :       av = st[sp-1];
    1131        2170 :       x = gel(st,sp);
    1132        2170 :       if (isonstack(x))
    1133             :       {
    1134        2170 :         pari_sp av2 = (pari_sp)(x + lg(x));
    1135        2170 :         if ((long) (av - av2) > 1000000L)
    1136             :         {
    1137           7 :           if (DEBUGMEM>=2)
    1138           0 :             pari_warn(warnmem,"eval: recovering %ld bytes", av - av2);
    1139           7 :           x = gerepileupto(av, x);
    1140             :         }
    1141           0 :       } else set_avma(av);
    1142        2170 :       gel(st,sp-1) = x;
    1143        2170 :       break;
    1144             :     }
    1145           0 :     case OCcopyifclone:
    1146           0 :       if (isclone(gel(st,sp-1)))
    1147           0 :         gel(st,sp-1) = gcopy(gel(st,sp-1));
    1148           0 :       break;
    1149    90040107 :     case OCcompo1:
    1150             :       {
    1151    90040107 :         GEN  p=gel(st,sp-2);
    1152    90040107 :         long c=st[sp-1];
    1153    90040107 :         sp-=2;
    1154    90040107 :         switch(typ(p))
    1155             :         {
    1156    90034606 :         case t_VEC: case t_COL:
    1157    90034606 :           check_array_index(c, lg(p));
    1158    90034605 :           closure_castgen(gel(p,c),operand);
    1159    90034607 :           break;
    1160          13 :         case t_LIST:
    1161             :           {
    1162             :             long lx;
    1163          13 :             if (list_typ(p)!=t_LIST_RAW)
    1164           0 :               pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1165          13 :             p = list_data(p); lx = p? lg(p): 1;
    1166          13 :             check_array_index(c, lx);
    1167          13 :             closure_castgen(gel(p,c),operand);
    1168          13 :             break;
    1169             :           }
    1170        5481 :         case t_VECSMALL:
    1171        5481 :           check_array_index(c,lg(p));
    1172        5467 :           closure_castlong(p[c],operand);
    1173        5468 :           break;
    1174           7 :         default:
    1175           7 :           pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1176           0 :           break;
    1177             :         }
    1178    90040088 :         break;
    1179             :       }
    1180     9423169 :     case OCcompo1ptr:
    1181             :       {
    1182     9423169 :         long c=st[sp-1];
    1183             :         long lx;
    1184     9423169 :         gp_pointer *g = &ptrs[rp-1];
    1185     9423169 :         matcomp *C=&g->c;
    1186     9423169 :         GEN p = g->x;
    1187     9423169 :         sp--;
    1188     9423169 :         switch(typ(p))
    1189             :         {
    1190     9423106 :         case t_VEC: case t_COL:
    1191     9423106 :           check_array_index(c, lg(p));
    1192     9423106 :           C->ptcell = (GEN *) p+c;
    1193     9423106 :           ptr_proplock(g, *(C->ptcell));
    1194     9423106 :           break;
    1195          28 :         case t_VECSMALL:
    1196          28 :           check_array_index(c, lg(p));
    1197          21 :           C->ptcell = (GEN *) p+c;
    1198          21 :           g->x = stoi(p[c]);
    1199          21 :           break;
    1200          28 :         case t_LIST:
    1201          28 :           if (list_typ(p)!=t_LIST_RAW)
    1202           0 :             pari_err_TYPE("&_[_] OCcompo1 [not a vector]", p);
    1203          28 :           p = list_data(p); lx = p? lg(p): 1;
    1204          28 :           check_array_index(c,lx);
    1205          28 :           C->ptcell = (GEN *) p+c;
    1206          28 :           ptr_proplock(g, *(C->ptcell));
    1207          28 :           break;
    1208           7 :         default:
    1209           7 :           pari_err_TYPE("&_[_] OCcompo1ptr [not a vector]", p);
    1210             :         }
    1211     9423155 :         C->parent   = p;
    1212     9423155 :         break;
    1213             :       }
    1214     1666084 :     case OCcompo2:
    1215             :       {
    1216     1666084 :         GEN  p=gel(st,sp-3);
    1217     1666084 :         long c=st[sp-2];
    1218     1666084 :         long d=st[sp-1];
    1219     1666084 :         if (typ(p)!=t_MAT) pari_err_TYPE("_[_,_] OCcompo2 [not a matrix]", p);
    1220     1666077 :         check_array_index(d, lg(p));
    1221     1666077 :         check_array_index(c, lg(gel(p,d)));
    1222     1666077 :         sp-=3;
    1223     1666077 :         closure_castgen(gcoeff(p,c,d),operand);
    1224     1666077 :         break;
    1225             :       }
    1226      123921 :     case OCcompo2ptr:
    1227             :       {
    1228      123921 :         long c=st[sp-2];
    1229      123921 :         long d=st[sp-1];
    1230      123921 :         gp_pointer *g = &ptrs[rp-1];
    1231      123921 :         matcomp *C=&g->c;
    1232      123921 :         GEN p = g->x;
    1233      123921 :         sp-=2;
    1234      123921 :         if (typ(p)!=t_MAT)
    1235           0 :           pari_err_TYPE("&_[_,_] OCcompo2ptr [not a matrix]", p);
    1236      123921 :         check_array_index(d, lg(p));
    1237      123921 :         check_array_index(c, lg(gel(p,d)));
    1238      123921 :         C->ptcell = (GEN *) gel(p,d)+c;
    1239      123921 :         C->parent   = p;
    1240      123921 :         ptr_proplock(g, *(C->ptcell));
    1241      123921 :         break;
    1242             :       }
    1243      911442 :     case OCcompoC:
    1244             :       {
    1245      911442 :         GEN  p=gel(st,sp-2);
    1246      911442 :         long c=st[sp-1];
    1247      911442 :         if (typ(p)!=t_MAT)
    1248           7 :           pari_err_TYPE("_[,_] OCcompoC [not a matrix]", p);
    1249      911435 :         check_array_index(c, lg(p));
    1250      911428 :         sp--;
    1251      911428 :         gel(st,sp-1) = gel(p,c);
    1252      911428 :         break;
    1253             :       }
    1254      355369 :     case OCcompoCptr:
    1255             :       {
    1256      355369 :         long c=st[sp-1];
    1257      355369 :         gp_pointer *g = &ptrs[rp-1];
    1258      355369 :         matcomp *C=&g->c;
    1259      355369 :         GEN p = g->x;
    1260      355369 :         sp--;
    1261      355369 :         if (typ(p)!=t_MAT)
    1262           7 :           pari_err_TYPE("&_[,_] OCcompoCptr [not a matrix]", p);
    1263      355362 :         check_array_index(c, lg(p));
    1264      355355 :         C->ptcell = (GEN *) p+c;
    1265      355355 :         C->full_col = c;
    1266      355355 :         C->parent   = p;
    1267      355355 :         ptr_proplock(g, *(C->ptcell));
    1268      355355 :         break;
    1269             :       }
    1270      272860 :     case OCcompoL:
    1271             :       {
    1272      272860 :         GEN  p=gel(st,sp-2);
    1273      272860 :         long r=st[sp-1];
    1274      272860 :         sp--;
    1275      272860 :         if (typ(p)!=t_MAT)
    1276           7 :           pari_err_TYPE("_[_,] OCcompoL [not a matrix]", p);
    1277      272853 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1278      272846 :         gel(st,sp-1) = row(p,r);
    1279      272846 :         break;
    1280             :       }
    1281      204848 :     case OCcompoLptr:
    1282             :       {
    1283      204848 :         long r=st[sp-1];
    1284      204848 :         gp_pointer *g = &ptrs[rp-1];
    1285      204848 :         matcomp *C=&g->c;
    1286      204848 :         GEN p = g->x, p2;
    1287      204848 :         sp--;
    1288      204848 :         if (typ(p)!=t_MAT)
    1289           7 :           pari_err_TYPE("&_[_,] OCcompoLptr [not a matrix]", p);
    1290      204841 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1291      204834 :         p2 = rowcopy(p,r);
    1292      204834 :         C->full_row = r; /* record row number */
    1293      204834 :         C->ptcell = &p2;
    1294      204834 :         C->parent   = p;
    1295      204834 :         g->x = p2;
    1296      204834 :         break;
    1297             :       }
    1298       11872 :     case OCdefaultarg:
    1299       11872 :       if (var[s_var.n+operand].flag==DEFAULT_VAL)
    1300             :       {
    1301        2618 :         GEN z = gel(st,sp-1);
    1302        2618 :         if (typ(z)==t_CLOSURE)
    1303             :         {
    1304        1001 :           pushlex(operand, closure_evalnobrk(z));
    1305        1001 :           copylex(operand);
    1306             :         }
    1307             :         else
    1308        1617 :           pushlex(operand, z);
    1309             :       }
    1310       11872 :       sp--;
    1311       11872 :       break;
    1312          50 :     case OClocalvar:
    1313             :       {
    1314             :         long n;
    1315          50 :         entree *ep = (entree *)operand;
    1316          50 :         checkvalue(ep, chk_NOCREATE);
    1317          42 :         n = pari_stack_new(&s_lvars);
    1318          42 :         lvars[n] = ep;
    1319          42 :         nblvar++;
    1320          42 :         pushvalue(ep,gel(st,--sp));
    1321          42 :         break;
    1322             :       }
    1323          22 :     case OClocalvar0:
    1324             :       {
    1325             :         long n;
    1326          22 :         entree *ep = (entree *)operand;
    1327          22 :         checkvalue(ep, chk_NOCREATE);
    1328          14 :         n = pari_stack_new(&s_lvars);
    1329          14 :         lvars[n] = ep;
    1330          14 :         nblvar++;
    1331          14 :         zerovalue(ep);
    1332          12 :         break;
    1333             :       }
    1334          30 :     case OCexportvar:
    1335             :       {
    1336          30 :         entree *ep = (entree *)operand;
    1337          30 :         mt_export_add(ep->name, gel(st,--sp));
    1338          30 :         break;
    1339             :       }
    1340           2 :     case OCunexportvar:
    1341             :       {
    1342           2 :         entree *ep = (entree *)operand;
    1343           2 :         mt_export_del(ep->name);
    1344           2 :         break;
    1345             :       }
    1346             : 
    1347             : #define EVAL_f(f) \
    1348             :   switch (ep->arity) \
    1349             :   { \
    1350             :     case 0: f(); break; \
    1351             :     case 1: sp--; f(st[sp]); break; \
    1352             :     case 2: sp-=2; f(st[sp],st[sp+1]); break; \
    1353             :     case 3: sp-=3; f(st[sp],st[sp+1],st[sp+2]); break; \
    1354             :     case 4: sp-=4; f(st[sp],st[sp+1],st[sp+2],st[sp+3]); break; \
    1355             :     case 5: sp-=5; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4]); break; \
    1356             :     case 6: sp-=6; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5]); break; \
    1357             :     case 7: sp-=7; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6]); break; \
    1358             :     case 8: sp-=8; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7]); break; \
    1359             :     case 9: sp-=9; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8]); break; \
    1360             :     case 10: sp-=10; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9]); break; \
    1361             :     case 11: sp-=11; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10]); break; \
    1362             :     case 12: sp-=12; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11]); break; \
    1363             :     case 13: sp-=13; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12]); break; \
    1364             :     case 14: sp-=14; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13]); break; \
    1365             :     case 15: sp-=15; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14]); break; \
    1366             :     case 16: sp-=16; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15]); break; \
    1367             :     case 17: sp-=17; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16]); break; \
    1368             :     case 18: sp-=18; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17]); break; \
    1369             :     case 19: sp-=19; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17],st[sp+18]); break; \
    1370             :     case 20: sp-=20; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17],st[sp+18],st[sp+19]); break; \
    1371             :     default: \
    1372             :       pari_err_IMPL("functions with more than 20 parameters");\
    1373             :       goto endeval; /*LCOV_EXCL_LINE*/ \
    1374             :   }
    1375             : 
    1376    87398751 :     case OCcallgen:
    1377             :       {
    1378    87398751 :         entree *ep = (entree *)operand;
    1379             :         GEN res;
    1380             :         /* Macro Madness : evaluate function ep->value on arguments
    1381             :          * st[sp-ep->arity .. sp]. Set res = result. */
    1382    87398751 :         EVAL_f(res = ((GEN (*)(ANYARG))ep->value));
    1383    87384397 :         if (br_status) goto endeval;
    1384    87260332 :         gel(st,sp++)=res;
    1385    87260332 :         break;
    1386             :       }
    1387   407906496 :     case OCcallgen2: /*same for ep->arity = 2. Is this optimization worth it ?*/
    1388             :       {
    1389   407906496 :         entree *ep = (entree *)operand;
    1390             :         GEN res;
    1391   407906496 :         sp-=2;
    1392   407906496 :         res = ((GEN (*)(GEN,GEN))ep->value)(gel(st,sp),gel(st,sp+1));
    1393   407919279 :         if (br_status) goto endeval;
    1394   407919251 :         gel(st,sp++)=res;
    1395   407919251 :         break;
    1396             :       }
    1397    13225081 :     case OCcalllong:
    1398             :       {
    1399    13225081 :         entree *ep = (entree *)operand;
    1400             :         long res;
    1401    13225081 :         EVAL_f(res = ((long (*)(ANYARG))ep->value));
    1402    13226586 :         if (br_status) goto endeval;
    1403    13226586 :         st[sp++] = res;
    1404    13226586 :         break;
    1405             :       }
    1406     1694644 :     case OCcallint:
    1407             :       {
    1408     1694644 :         entree *ep = (entree *)operand;
    1409             :         long res;
    1410     1694644 :         EVAL_f(res = ((int (*)(ANYARG))ep->value));
    1411     1694539 :         if (br_status) goto endeval;
    1412     1694539 :         st[sp++] = res;
    1413     1694539 :         break;
    1414             :       }
    1415    47747688 :     case OCcallvoid:
    1416             :       {
    1417    47747688 :         entree *ep = (entree *)operand;
    1418    47747688 :         EVAL_f(((void (*)(ANYARG))ep->value));
    1419    47747272 :         if (br_status) goto endeval;
    1420    47612262 :         break;
    1421             :       }
    1422             : #undef EVAL_f
    1423             : 
    1424    34508949 :     case OCcalluser:
    1425             :       {
    1426    34508949 :         long n=operand;
    1427    34508949 :         GEN fun = gel(st,sp-1-n);
    1428             :         long arity, isvar;
    1429             :         GEN z;
    1430    34508949 :         if (typ(fun)!=t_CLOSURE) pari_err(e_NOTFUNC, fun);
    1431    34506226 :         isvar = closure_is_variadic(fun);
    1432    34506223 :         arity = closure_arity(fun);
    1433    34506221 :         if (!isvar || n < arity)
    1434             :         {
    1435    34506151 :           st_alloc(arity-n);
    1436    34506146 :           if (n>arity)
    1437           0 :             pari_err(e_MISC,"too many parameters in user-defined function call");
    1438    34526952 :           for (j=n+1;j<=arity;j++)
    1439       20811 :             gel(st,sp++)=0;
    1440    34506141 :           if (isvar) gel(st,sp-1) = cgetg(1,t_VEC);
    1441             :         }
    1442             :         else
    1443             :         {
    1444             :           GEN v;
    1445          70 :           long j, m = n-arity+1;
    1446          70 :           v = cgetg(m+1,t_VEC);
    1447          70 :           sp-=m;
    1448         301 :           for (j=1; j<=m; j++)
    1449         231 :             gel(v,j) = gel(st,sp+j-1)? gcopy(gel(st,sp+j-1)): gen_0;
    1450          70 :           gel(st,sp++)=v;
    1451             :         }
    1452    34506211 :         z = closure_return(fun);
    1453    34502488 :         if (br_status) goto endeval;
    1454    34502488 :         gel(st, sp-1) = z;
    1455    34502488 :         break;
    1456             :       }
    1457    41753965 :     case OCnewframe:
    1458    41753965 :       if (operand>0) nbmvar+=operand;
    1459           2 :       else operand=-operand;
    1460    41753965 :       pari_stack_alloc(&s_var,operand);
    1461    41753965 :       s_var.n+=operand;
    1462   120096157 :       for(j=1;j<=operand;j++)
    1463             :       {
    1464    78342192 :         var[s_var.n-j].flag=PUSH_VAL;
    1465    78342192 :         var[s_var.n-j].value=gen_0;
    1466             :       }
    1467    41753965 :       break;
    1468        5401 :     case OCsaveframe:
    1469             :       {
    1470        5401 :         GEN cl = (operand?gcopy:shallowcopy)(gel(st,sp-1));
    1471        5401 :         GEN f = gel(cl, 7);
    1472        5401 :         long j, l = lg(f);
    1473        5401 :         GEN v = cgetg(l, t_VEC);
    1474       71672 :         for (j = 1; j < l; j++)
    1475       66271 :           if (signe(gel(f,l-j))==0)
    1476             :           {
    1477        9325 :             GEN val = var[s_var.n-j].value;
    1478        9325 :             gel(v,j) = operand?gcopy(val):val;
    1479             :           } else
    1480       56946 :             gel(v,j) = gnil;
    1481        5401 :         gel(cl,7) = v;
    1482        5401 :         gel(st,sp-1) = cl;
    1483             :       }
    1484        5401 :       break;
    1485         105 :     case OCpackargs:
    1486             :     {
    1487         105 :       GEN def = cgetg(operand+1, t_VECSMALL);
    1488         105 :       GEN args = cgetg(operand+1, t_VEC);
    1489         105 :       pari_stack_alloc(&s_var,operand);
    1490         105 :       sp-=operand;
    1491         210 :       for (j=0;j<operand;j++)
    1492             :       {
    1493         105 :         if (gel(st,sp+j))
    1494             :         {
    1495         105 :           gel(args,j+1) = gel(st,sp+j);
    1496         105 :           uel(def ,j+1) = 1;
    1497             :         }
    1498             :         else
    1499             :         {
    1500           0 :           gel(args,j+1) = gen_0;
    1501           0 :           uel(def ,j+1) = 0;
    1502             :         }
    1503             :       }
    1504         105 :       gel(st, sp++) = args;
    1505         105 :       gel(st, sp++) = def;
    1506         105 :       break;
    1507             :     }
    1508    35456657 :     case OCgetargs:
    1509    35456657 :       pari_stack_alloc(&s_var,operand);
    1510    35455913 :       s_var.n+=operand;
    1511    35455913 :       nbmvar+=operand;
    1512    35455913 :       sp-=operand;
    1513    96927506 :       for (j=0;j<operand;j++)
    1514             :       {
    1515    61470955 :         if (gel(st,sp+j))
    1516    61466391 :           pushlex(j-operand,gel(st,sp+j));
    1517             :         else
    1518             :         {
    1519        4564 :           var[s_var.n+j-operand].flag=DEFAULT_VAL;
    1520        4564 :           var[s_var.n+j-operand].value=gen_0;
    1521             :         }
    1522             :       }
    1523    35456551 :       break;
    1524          49 :     case OCcheckuserargs:
    1525         105 :       for (j=0; j<operand; j++)
    1526          77 :         if (var[s_var.n-operand+j].flag==DEFAULT_VAL)
    1527          21 :           pari_err(e_MISC,"missing mandatory argument"
    1528             :                    " '%s' in user function",get_arg_name(C,j+1));
    1529          28 :       break;
    1530     4500152 :     case OCcheckargs:
    1531    22420114 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1532    17919976 :         if ((operand&1L) && gel(st,j)==NULL)
    1533           0 :           pari_err(e_MISC,"missing mandatory argument");
    1534     4500138 :       break;
    1535         441 :     case OCcheckargs0:
    1536         882 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1537         441 :         if ((operand&1L) && gel(st,j))
    1538           0 :           pari_err(e_MISC,"argument type not implemented");
    1539         441 :       break;
    1540       13812 :     case OCdefaultlong:
    1541       13812 :       sp--;
    1542       13812 :       if (st[sp+operand])
    1543         910 :         st[sp+operand]=gtos(gel(st,sp+operand));
    1544             :       else
    1545       12902 :         st[sp+operand]=st[sp];
    1546       13812 :       break;
    1547           0 :     case OCdefaultulong:
    1548           0 :       sp--;
    1549           0 :       if (st[sp+operand])
    1550           0 :         st[sp+operand]=gtou(gel(st,sp+operand));
    1551             :       else
    1552           0 :         st[sp+operand]=st[sp];
    1553           0 :       break;
    1554           0 :     case OCdefaultgen:
    1555           0 :       sp--;
    1556           0 :       if (!st[sp+operand])
    1557           0 :         st[sp+operand]=st[sp];
    1558           0 :       break;
    1559    10047594 :     case OCvec:
    1560    10047594 :       gel(st,sp++)=cgetg(operand,t_VEC);
    1561    10047592 :       st[sp++]=avma;
    1562    10047592 :       break;
    1563        3514 :     case OCcol:
    1564        3514 :       gel(st,sp++)=cgetg(operand,t_COL);
    1565        3514 :       st[sp++]=avma;
    1566        3514 :       break;
    1567       55013 :     case OCmat:
    1568             :       {
    1569             :         GEN z;
    1570       55013 :         long l=st[sp-1];
    1571       55013 :         z=cgetg(operand,t_MAT);
    1572      183092 :         for(j=1;j<operand;j++)
    1573      128079 :           gel(z,j) = cgetg(l,t_COL);
    1574       55013 :         gel(st,sp-1) = z;
    1575       55013 :         st[sp++]=avma;
    1576             :       }
    1577       55013 :       break;
    1578    51480993 :     case OCpop:
    1579    51480993 :       sp-=operand;
    1580    51480993 :       break;
    1581    31351100 :     case OCdup:
    1582             :       {
    1583    31351100 :         long i, s=st[sp-1];
    1584    31351100 :         st_alloc(operand);
    1585    62710943 :         for(i=1;i<=operand;i++)
    1586    31359843 :           st[sp++]=s;
    1587             :       }
    1588    31351100 :       break;
    1589             :     }
    1590  2279856309 :   }
    1591             :   if (0)
    1592             :   {
    1593      259103 : endeval:
    1594      259103 :     sp = saved_sp;
    1595      259103 :     for(  ; rp>saved_rp ;  )
    1596             :     {
    1597           0 :       gp_pointer *g = &ptrs[--rp];
    1598           0 :       clone_unlock_deep(g->ox);
    1599             :     }
    1600             :   }
    1601   196209155 :   s_prec.n = saved_prec;
    1602   196209155 :   s_trace.n--;
    1603   196209155 :   restore_vars(nbmvar, nblvar, nblock);
    1604   195778231 :   clone_unlock(C);
    1605   195769301 : }
    1606             : 
    1607             : GEN
    1608    23474399 : closure_evalgen(GEN C)
    1609             : {
    1610    23474399 :   pari_sp ltop=avma;
    1611    23474399 :   closure_eval(C);
    1612    23439603 :   if (br_status) return gc_NULL(ltop);
    1613    23439545 :   return gerepileupto(ltop,gel(st,--sp));
    1614             : }
    1615             : 
    1616             : long
    1617      125976 : evalstate_get_trace(void)
    1618      125976 : { return s_trace.n; }
    1619             : 
    1620             : void
    1621          18 : evalstate_set_trace(long lvl)
    1622          18 : { s_trace.n = lvl; }
    1623             : 
    1624             : void
    1625     1380577 : evalstate_save(struct pari_evalstate *state)
    1626             : {
    1627     1380577 :   state->avma = avma;
    1628     1380577 :   state->sp   = sp;
    1629     1380577 :   state->rp   = rp;
    1630     1380577 :   state->prec = s_prec.n;
    1631     1380577 :   state->var  = s_var.n;
    1632     1380577 :   state->lvars= s_lvars.n;
    1633     1380577 :   state->locks= s_locks.n;
    1634     1380577 :   state->trace= s_trace.n;
    1635     1380577 :   compilestate_save(&state->comp);
    1636     1380577 :   mtstate_save(&state->mt);
    1637     1380577 : }
    1638             : 
    1639             : void
    1640       44606 : evalstate_restore(struct pari_evalstate *state)
    1641             : {
    1642       44606 :   set_avma(state->avma);
    1643       44606 :   mtstate_restore(&state->mt);
    1644       44606 :   sp = state->sp;
    1645       44606 :   rp = state->rp;
    1646       44606 :   s_prec.n = state->prec;
    1647       44606 :   restore_vars(s_var.n-state->var, s_lvars.n-state->lvars,
    1648       44606 :                s_locks.n-state->locks);
    1649       44606 :   restore_trace(s_trace.n-state->trace);
    1650       44606 :   reset_break();
    1651       44606 :   compilestate_restore(&state->comp);
    1652       44606 : }
    1653             : 
    1654             : GEN
    1655       34782 : evalstate_restore_err(struct pari_evalstate *state)
    1656             : {
    1657       34782 :   GENbin* err = copy_bin(pari_err_last());
    1658       34782 :   evalstate_restore(state);
    1659       34782 :   return bin_copy(err);
    1660             : }
    1661             : 
    1662             : void
    1663         340 : evalstate_reset(void)
    1664             : {
    1665         340 :   mtstate_reset();
    1666         340 :   sp = 0;
    1667         340 :   rp = 0;
    1668         340 :   dbg_level = 0;
    1669         340 :   restore_vars(s_var.n, s_lvars.n, s_locks.n);
    1670         340 :   s_trace.n = 0;
    1671         340 :   reset_break();
    1672         340 :   compilestate_reset();
    1673         340 :   parsestate_reset();
    1674         340 :   set_avma(pari_mainstack->top);
    1675         340 : }
    1676             : 
    1677             : void
    1678           0 : evalstate_clone(void)
    1679             : {
    1680             :   long i;
    1681           0 :   for (i = 1; i<=s_var.n; i++) copylex(-i);
    1682           0 :   lvar_make_safe();
    1683           0 :   for (i = 0; i< s_trace.n; i++)
    1684             :   {
    1685           0 :     GEN C = trace[i].closure;
    1686           0 :     if (isonstack(C)) trace[i].closure = gclone(C);
    1687             :   }
    1688           0 : }
    1689             : 
    1690             : GEN
    1691          21 : closure_trapgen(GEN C, long numerr)
    1692             : {
    1693             :   VOLATILE GEN x;
    1694             :   struct pari_evalstate state;
    1695          21 :   evalstate_save(&state);
    1696          21 :   pari_CATCH(numerr) { x = (GEN)1L; }
    1697          21 :   pari_TRY { x = closure_evalgen(C); } pari_ENDCATCH;
    1698          14 :   if (x == (GEN)1L) evalstate_restore(&state);
    1699          14 :   return x;
    1700             : }
    1701             : 
    1702             : GEN
    1703    34496368 : closure_evalnobrk(GEN C)
    1704             : {
    1705    34496368 :   pari_sp ltop=avma;
    1706    34496368 :   closure_eval(C);
    1707    34496361 :   if (br_status) pari_err(e_MISC, "break not allowed here");
    1708    34496354 :   return gerepileupto(ltop,gel(st,--sp));
    1709             : }
    1710             : 
    1711             : void
    1712    97794364 : closure_evalvoid(GEN C)
    1713             : {
    1714    97794364 :   pari_sp ltop=avma;
    1715    97794364 :   closure_eval(C);
    1716    97778950 :   set_avma(ltop);
    1717    97756503 : }
    1718             : 
    1719             : GEN
    1720      103600 : closure_evalres(GEN C)
    1721             : {
    1722      103600 :   return closure_return(C);
    1723             : }
    1724             : 
    1725             : INLINE GEN
    1726     5456378 : closure_returnupto(GEN C)
    1727             : {
    1728     5456378 :   pari_sp av=avma;
    1729     5456378 :   return copyupto(closure_return(C),(GEN)av);
    1730             : }
    1731             : 
    1732             : GEN
    1733           4 : pareval_worker(GEN C)
    1734             : {
    1735           4 :   return closure_callgenall(C, 0);
    1736             : }
    1737             : 
    1738             : GEN
    1739           2 : pareval(GEN C)
    1740             : {
    1741           2 :   pari_sp av = avma;
    1742           2 :   long l = lg(C), i;
    1743             :   GEN worker;
    1744           2 :   if (!is_vec_t(typ(C))) pari_err_TYPE("pareval",C);
    1745           6 :   for (i=1; i<l; i++)
    1746           4 :     if (typ(gel(C,i))!=t_CLOSURE)
    1747           0 :       pari_err_TYPE("pareval",gel(C,i));
    1748           2 :   worker = snm_closure(is_entry("_pareval_worker"), NULL);
    1749           2 :   return gerepileupto(av, gen_parapply(worker, C));
    1750             : }
    1751             : 
    1752             : GEN
    1753         271 : parvector_worker(GEN i, GEN C)
    1754             : {
    1755         271 :   return closure_callgen1(C, i);
    1756             : }
    1757             : 
    1758             : GEN
    1759        3772 : parfor_worker(GEN i, GEN C)
    1760             : {
    1761        3772 :   retmkvec2(gcopy(i), closure_callgen1(C, i));
    1762             : }
    1763             : 
    1764             : GEN
    1765          15 : parvector(long n, GEN code)
    1766             : {
    1767          15 :   long i, pending = 0, workid;
    1768          15 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1769             :   GEN a, V, done;
    1770             :   struct pari_mt pt;
    1771          15 :   mt_queue_start_lim(&pt, worker, n);
    1772          15 :   a = mkvec(cgetipos(3)); /* left on the stack */
    1773          15 :   V = cgetg(n+1, t_VEC);
    1774         306 :   for (i=1; i<=n || pending; i++)
    1775             :   {
    1776         293 :     mael(a,1,2) = i;
    1777         293 :     mt_queue_submit(&pt, i, i<=n? a: NULL);
    1778         293 :     done = mt_queue_get(&pt, &workid, &pending);
    1779         291 :     if (done) gel(V,workid) = done;
    1780             :   }
    1781          13 :   mt_queue_end(&pt);
    1782          13 :   return V;
    1783             : }
    1784             : 
    1785             : /* B <- {a + k * m : k = 0, ..., (b-a)/m)} */
    1786             : static void
    1787         295 : arithprogset(GEN B, GEN a, GEN b, long m)
    1788             : {
    1789             :   long k;
    1790       20888 :   for (k = 1; cmpii(a, b) <= 0; a = addui(m,a), k++) gel(B, k) = a;
    1791         295 :   setlg(B, k);
    1792         295 : }
    1793             : static GEN
    1794         268 : vecsum_i(GEN v)
    1795             : {
    1796         268 :   long i, l = lg(v);
    1797             :   GEN s;
    1798         268 :   if (l == 1) return gen_0;
    1799       20491 :   s = gel(v,1); for (i = 2; i < l; i++) s = gadd(s, gel(v,i));
    1800         268 :   return s;
    1801             : }
    1802             : GEN
    1803          41 : parsum(GEN a, GEN b, GEN code)
    1804             : {
    1805          41 :   pari_sp av = avma;
    1806             :   GEN worker, L, v, s, N;
    1807             :   long r, m, pending;
    1808             :   struct pari_mt pt;
    1809             :   pari_sp av2;
    1810             : 
    1811          41 :   if (typ(a) != t_INT) pari_err_TYPE("parsum",a);
    1812          41 :   if (gcmp(b,a) < 0) return gen_0;
    1813          41 :   worker = snm_closure(is_entry("_parapply_slice_worker"), mkvec(code));
    1814          41 :   b = gfloor(b);
    1815          41 :   N = addiu(subii(b, a), 1);
    1816          41 :   m = itou(sqrti(N)); if (cmpiu(N, m) < 0) m = itou(N);
    1817          41 :   mt_queue_start_lim(&pt, worker, m);
    1818          41 :   L = cgetg(m + 2, t_VEC); v = mkvec(L);
    1819          41 :   s = gen_0; a = setloop(a); pending = 0; av2 = avma;
    1820         415 :   for (r = 1; r <= m || pending; r++)
    1821             :   {
    1822             :     long workid;
    1823             :     GEN done;
    1824         395 :     if (r <= m) { arithprogset(L, icopy(a), b, m); a = incloop(a); }
    1825         395 :     mt_queue_submit(&pt, 0, r <= m? v: NULL);
    1826         377 :     done = mt_queue_get(&pt, &workid, &pending);
    1827         374 :     if (done) s = gerepileupto(av2, gadd(s, vecsum_i(done)));
    1828             :   }
    1829          20 :   mt_queue_end(&pt); return gerepileupto(av, s);
    1830             : }
    1831             : 
    1832             : void
    1833          53 : parfor(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1834             : {
    1835          53 :   pari_sp av = avma, av2;
    1836          53 :   long running, pending = 0, lim;
    1837          53 :   long status = br_NONE;
    1838          53 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1839          53 :   GEN done, stop = NULL;
    1840             :   struct pari_mt pt;
    1841          53 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1842          53 :   if (b)
    1843             :   {
    1844          53 :     if (gcmp(b,a) < 0) return;
    1845          53 :     if (typ(b) == t_INFINITY)
    1846             :     {
    1847           2 :       if (inf_get_sign(b) < 0) return;
    1848           2 :       b = NULL;
    1849             :     }
    1850             :     else
    1851          51 :       b = gfloor(b);
    1852             :   }
    1853          53 :   lim = b ? itos_or_0(subii(addis(b,1),a)): 0;
    1854          53 :   mt_queue_start_lim(&pt, worker, lim);
    1855          53 :   a = mkvec(setloop(a));
    1856          53 :   av2 = avma;
    1857        4218 :   while ((running = (!stop && (!b || cmpii(gel(a,1),b) <= 0))) || pending)
    1858             :   {
    1859        4167 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1860        4167 :     done = mt_queue_get(&pt, NULL, &pending);
    1861        4165 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1862        2957 :       if (call(E, gel(done,1), gel(done,2)))
    1863             :       {
    1864          14 :         status = br_status;
    1865          14 :         br_status = br_NONE;
    1866          14 :         stop = gerepileuptoint(av2, gel(done,1));
    1867             :       }
    1868        4165 :     gel(a,1) = incloop(gel(a,1));
    1869        4165 :     if (!stop) set_avma(av2);
    1870             :   }
    1871          51 :   set_avma(av2);
    1872          51 :   mt_queue_end(&pt);
    1873          51 :   br_status = status;
    1874          51 :   set_avma(av);
    1875             : }
    1876             : 
    1877             : static void
    1878           0 : parforiter_init(struct parfor_iter *T, GEN code)
    1879             : {
    1880           0 :   T->pending = 0;
    1881           0 :   T->worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1882           0 :   mt_queue_start(&T->pt, T->worker);
    1883           0 : }
    1884             : 
    1885             : static GEN
    1886           0 : parforiter_next(struct parfor_iter *T, GEN v)
    1887             : {
    1888           0 :   mt_queue_submit(&T->pt, 0, v);
    1889           0 :   return mt_queue_get(&T->pt, NULL, &T->pending);
    1890             : }
    1891             : 
    1892             : static void
    1893           0 : parforiter_stop(struct parfor_iter *T)
    1894             : {
    1895           0 :   while (T->pending)
    1896             :   {
    1897           0 :     mt_queue_submit(&T->pt, 0, NULL);
    1898           0 :     (void) mt_queue_get(&T->pt, NULL, &T->pending);
    1899             :   }
    1900           0 :   mt_queue_end(&T->pt);
    1901           0 : }
    1902             : 
    1903             : void
    1904           0 : parfor_init(parfor_t *T, GEN a, GEN b, GEN code)
    1905             : {
    1906           0 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1907           0 :   T->b = b ? gfloor(b): NULL;
    1908           0 :   T->a = mkvec(setloop(a));
    1909           0 :   parforiter_init(&T->iter, code);
    1910           0 : }
    1911             : 
    1912             : GEN
    1913           0 : parfor_next(parfor_t *T)
    1914             : {
    1915             :   long running;
    1916           0 :   while ((running=((!T->b || cmpii(gel(T->a,1),T->b) <= 0))) || T->iter.pending)
    1917             :   {
    1918           0 :     GEN done = parforiter_next(&T->iter, running ? T->a: NULL);
    1919           0 :     gel(T->a,1) = incloop(gel(T->a,1));
    1920           0 :     if (done) return done;
    1921             :   }
    1922           0 :   mt_queue_end(&T->iter.pt);
    1923           0 :   return NULL;
    1924             : }
    1925             : 
    1926             : void
    1927           0 : parfor_stop(parfor_t *T) { parforiter_stop(&T->iter); }
    1928             : 
    1929             : static long
    1930        3213 : gp_evalvoid2(void *E, GEN x, GEN y)
    1931             : {
    1932        3213 :   GEN code =(GEN) E;
    1933        3213 :   push_lex(x, code);
    1934        3213 :   push_lex(y, NULL);
    1935        3213 :   closure_evalvoid(code);
    1936        3213 :   pop_lex(2);
    1937        3213 :   return loop_break();
    1938             : }
    1939             : 
    1940             : void
    1941          53 : parfor0(GEN a, GEN b, GEN code, GEN code2)
    1942             : {
    1943          53 :   parfor(a, b, code, (void*)code2, code2 ? gp_evalvoid2: NULL);
    1944          51 : }
    1945             : 
    1946             : void
    1947           0 : parforprime_init(parforprime_t *T, GEN a, GEN b, GEN code)
    1948             : {
    1949           0 :   forprime_init(&T->forprime, a, b);
    1950           0 :   T->v = mkvec(gen_0);
    1951           0 :   parforiter_init(&T->iter, code);
    1952           0 : }
    1953             : 
    1954             : GEN
    1955           0 : parforprime_next(parforprime_t *T)
    1956             : {
    1957             :   long running;
    1958           0 :   while ((running = !!forprime_next(&T->forprime)) || T->iter.pending)
    1959             :   {
    1960             :     GEN done;
    1961           0 :     gel(T->v, 1) = T->forprime.pp;
    1962           0 :     done = parforiter_next(&T->iter, running ? T->v: NULL);
    1963           0 :     if (done) return done;
    1964             :   }
    1965           0 :   mt_queue_end(&T->iter.pt);
    1966           0 :   return NULL;
    1967             : }
    1968             : 
    1969             : void
    1970           0 : parforprime_stop(parforprime_t *T) { parforiter_stop(&T->iter); }
    1971             : 
    1972             : void
    1973           9 : parforprime(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1974             : {
    1975           9 :   pari_sp av = avma, av2;
    1976           9 :   long running, pending = 0;
    1977           9 :   long status = br_NONE;
    1978           9 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1979           9 :   GEN v, done, stop = NULL;
    1980             :   struct pari_mt pt;
    1981             :   forprime_t T;
    1982             : 
    1983           9 :   if (!forprime_init(&T, a,b)) { set_avma(av); return; }
    1984           9 :   mt_queue_start(&pt, worker);
    1985           9 :   v = mkvec(gen_0);
    1986           9 :   av2 = avma;
    1987         105 :   while ((running = (!stop && forprime_next(&T))) || pending)
    1988             :   {
    1989          96 :     gel(v, 1) = T.pp;
    1990          96 :     mt_queue_submit(&pt, 0, running ? v: NULL);
    1991          96 :     done = mt_queue_get(&pt, NULL, &pending);
    1992          96 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1993          72 :       if (call(E, gel(done,1), gel(done,2)))
    1994             :       {
    1995           0 :         status = br_status;
    1996           0 :         br_status = br_NONE;
    1997           0 :         stop = gerepileuptoint(av2, gel(done,1));
    1998             :       }
    1999          96 :     if (!stop) set_avma(av2);
    2000             :   }
    2001           9 :   set_avma(av2);
    2002           9 :   mt_queue_end(&pt);
    2003           9 :   br_status = status;
    2004           9 :   set_avma(av);
    2005             : }
    2006             : 
    2007             : void
    2008           9 : parforprime0(GEN a, GEN b, GEN code, GEN code2)
    2009             : {
    2010           9 :   parforprime(a, b, code, (void*)code2, code2? gp_evalvoid2: NULL);
    2011           9 : }
    2012             : 
    2013             : void
    2014           0 : parforvec_init(parforvec_t *T, GEN x, GEN code, long flag)
    2015             : {
    2016           0 :   forvec_init(&T->forvec, x, flag);
    2017           0 :   T->v = mkvec(gen_0);
    2018           0 :   parforiter_init(&T->iter, code);
    2019           0 : }
    2020             : 
    2021             : GEN
    2022           0 : parforvec_next(parforvec_t *T)
    2023             : {
    2024           0 :   GEN v = gen_0;
    2025           0 :   while ((v = forvec_next(&T->forvec)) || T->iter.pending)
    2026             :   {
    2027             :     GEN done;
    2028           0 :     if (v) gel(T->v, 1) = v;
    2029           0 :     done = parforiter_next(&T->iter, v ? T->v: NULL);
    2030           0 :     if (done) return done;
    2031             :   }
    2032           0 :   mt_queue_end(&T->iter.pt);
    2033           0 :   return NULL;
    2034             : }
    2035             : 
    2036             : void
    2037           0 : parforvec_stop(parforvec_t *T) { parforiter_stop(&T->iter); }
    2038             : 
    2039             : void
    2040          27 : parforvec(GEN x, GEN code, long flag, void *E, long call(void*, GEN, GEN))
    2041             : {
    2042          27 :   pari_sp av = avma, av2;
    2043          27 :   long running, pending = 0;
    2044          27 :   long status = br_NONE;
    2045          27 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    2046          27 :   GEN done, stop = NULL;
    2047             :   struct pari_mt pt;
    2048             :   forvec_t T;
    2049          27 :   GEN a, v = gen_0;
    2050             : 
    2051          27 :   if (!forvec_init(&T, x, flag)) { set_avma(av); return; }
    2052          27 :   mt_queue_start(&pt, worker);
    2053          27 :   a = mkvec(gen_0);
    2054          27 :   av2 = avma;
    2055         287 :   while ((running = (!stop && v && (v = forvec_next(&T)))) || pending)
    2056             :   {
    2057         260 :     gel(a, 1) = v;
    2058         260 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    2059         260 :     done = mt_queue_get(&pt, NULL, &pending);
    2060         260 :     if (call && done && (!stop || lexcmp(gel(done,1),stop) < 0))
    2061         184 :       if (call(E, gel(done,1), gel(done,2)))
    2062             :       {
    2063           0 :         status = br_status;
    2064           0 :         br_status = br_NONE;
    2065           0 :         stop = gerepilecopy(av2, gel(done,1));
    2066             :       }
    2067         260 :     if (!stop) set_avma(av2);
    2068             :   }
    2069          27 :   set_avma(av2);
    2070          27 :   mt_queue_end(&pt);
    2071          27 :   br_status = status;
    2072          27 :   set_avma(av);
    2073             : }
    2074             : 
    2075             : void
    2076          27 : parforvec0(GEN x, GEN code, GEN code2, long flag)
    2077             : {
    2078          27 :   parforvec(x, code, flag, (void*)code2, code2? gp_evalvoid2: NULL);
    2079          27 : }
    2080             : 
    2081             : void
    2082           0 : closure_callvoid1(GEN C, GEN x)
    2083             : {
    2084           0 :   long i, ar = closure_arity(C);
    2085           0 :   gel(st,sp++) = x;
    2086           0 :   for(i=2; i <= ar; i++) gel(st,sp++) = NULL;
    2087           0 :   closure_evalvoid(C);
    2088           0 : }
    2089             : 
    2090             : GEN
    2091          91 : closure_callgen0prec(GEN C, long prec)
    2092             : {
    2093             :   GEN z;
    2094          91 :   long i, ar = closure_arity(C);
    2095          91 :   for(i=1; i<= ar; i++) gel(st,sp++) = NULL;
    2096          91 :   push_localprec(prec);
    2097          91 :   z = closure_returnupto(C);
    2098          91 :   pop_localprec();
    2099          91 :   return z;
    2100             : }
    2101             : 
    2102             : GEN
    2103     4446741 : closure_callgen1(GEN C, GEN x)
    2104             : {
    2105     4446741 :   long i, ar = closure_arity(C);
    2106     4446539 :   gel(st,sp++) = x;
    2107     4453082 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    2108     4446539 :   return closure_returnupto(C);
    2109             : }
    2110             : 
    2111             : GEN
    2112       62933 : closure_callgen1prec(GEN C, GEN x, long prec)
    2113             : {
    2114             :   GEN z;
    2115       62933 :   long i, ar = closure_arity(C);
    2116       62933 :   gel(st,sp++) = x;
    2117       62947 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    2118       62933 :   push_localprec(prec);
    2119       62933 :   z = closure_returnupto(C);
    2120       62933 :   pop_localprec();
    2121       62933 :   return z;
    2122             : }
    2123             : 
    2124             : GEN
    2125       64848 : closure_callgen2(GEN C, GEN x, GEN y)
    2126             : {
    2127       64848 :   long i, ar = closure_arity(C);
    2128       64848 :   st_alloc(ar);
    2129       64848 :   gel(st,sp++) = x;
    2130       64848 :   gel(st,sp++) = y;
    2131       64848 :   for(i=3; i<=ar; i++) gel(st,sp++) = NULL;
    2132       64848 :   return closure_returnupto(C);
    2133             : }
    2134             : 
    2135             : GEN
    2136      881824 : closure_callgenvec(GEN C, GEN args)
    2137             : {
    2138      881824 :   long i, l = lg(args)-1, ar = closure_arity(C);
    2139      881804 :   st_alloc(ar);
    2140      881784 :   if (l > ar)
    2141           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2142      881784 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    2143           7 :     pari_err_TYPE("call", gel(args,l));
    2144     1795595 :   for (i = 1; i <= l;  i++) gel(st,sp++) = gel(args,i);
    2145      881767 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    2146      881763 :   return closure_returnupto(C);
    2147             : }
    2148             : 
    2149             : GEN
    2150           0 : closure_callgenvecprec(GEN C, GEN args, long prec)
    2151             : {
    2152             :   GEN z;
    2153           0 :   push_localprec(prec);
    2154           0 :   z = closure_callgenvec(C, args);
    2155           0 :   pop_localprec();
    2156           0 :   return z;
    2157             : }
    2158             : 
    2159             : GEN
    2160         322 : closure_callgenvecdef(GEN C, GEN args, GEN def)
    2161             : {
    2162         322 :   long i, l = lg(args)-1, ar = closure_arity(C);
    2163         322 :   st_alloc(ar);
    2164         322 :   if (l > ar)
    2165           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2166         322 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    2167           0 :     pari_err_TYPE("call", gel(args,l));
    2168         644 :   for (i = 1; i <= l;  i++) gel(st,sp++) = def[i] ? gel(args,i): NULL;
    2169         322 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    2170         322 :   return closure_returnupto(C);
    2171             : }
    2172             : 
    2173             : GEN
    2174         322 : closure_callgenvecdefprec(GEN C, GEN args, GEN def, long prec)
    2175             : {
    2176             :   GEN z;
    2177         322 :   push_localprec(prec);
    2178         322 :   z = closure_callgenvecdef(C, args, def);
    2179         322 :   pop_localprec();
    2180         322 :   return z;
    2181             : }
    2182             : GEN
    2183           4 : closure_callgenall(GEN C, long n, ...)
    2184             : {
    2185             :   va_list ap;
    2186           4 :   long i, ar = closure_arity(C);
    2187           4 :   va_start(ap,n);
    2188           4 :   if (n > ar)
    2189           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2190           4 :   st_alloc(ar);
    2191           4 :   for (i = 1; i <=n;  i++) gel(st,sp++) = va_arg(ap, GEN);
    2192           4 :   for(      ; i <=ar; i++) gel(st,sp++) = NULL;
    2193           4 :   va_end(ap);
    2194           4 :   return closure_returnupto(C);
    2195             : }
    2196             : 
    2197             : GEN
    2198     9442591 : gp_eval(void *E, GEN x)
    2199             : {
    2200     9442591 :   GEN code = (GEN)E;
    2201     9442591 :   set_lex(-1,x);
    2202     9442591 :   return closure_evalnobrk(code);
    2203             : }
    2204             : 
    2205             : GEN
    2206      577647 : gp_evalupto(void *E, GEN x)
    2207             : {
    2208      577647 :   pari_sp av = avma;
    2209      577647 :   return copyupto(gp_eval(E,x), (GEN)av);
    2210             : }
    2211             : 
    2212             : GEN
    2213       19460 : gp_evalprec(void *E, GEN x, long prec)
    2214             : {
    2215             :   GEN z;
    2216       19460 :   push_localprec(prec);
    2217       19460 :   z = gp_eval(E, x);
    2218       19460 :   pop_localprec();
    2219       19460 :   return z;
    2220             : }
    2221             : 
    2222             : long
    2223      167902 : gp_evalbool(void *E, GEN x)
    2224      167902 : { pari_sp av = avma; return gc_long(av, !gequal0(gp_eval(E,x))); }
    2225             : 
    2226             : long
    2227     3655715 : gp_evalvoid(void *E, GEN x)
    2228             : {
    2229     3655715 :   GEN code = (GEN)E;
    2230     3655715 :   set_lex(-1,x);
    2231     3655715 :   closure_evalvoid(code);
    2232     3655715 :   return loop_break();
    2233             : }
    2234             : 
    2235             : GEN
    2236       20237 : gp_call(void *E, GEN x)
    2237             : {
    2238       20237 :   GEN code = (GEN)E;
    2239       20237 :   return closure_callgen1(code, x);
    2240             : }
    2241             : 
    2242             : GEN
    2243        9730 : gp_callprec(void *E, GEN x, long prec)
    2244             : {
    2245        9730 :   GEN code = (GEN)E;
    2246        9730 :   return closure_callgen1prec(code, x, prec);
    2247             : }
    2248             : 
    2249             : GEN
    2250          91 : gp_call2(void *E, GEN x, GEN y)
    2251             : {
    2252          91 :   GEN code = (GEN)E;
    2253          91 :   return closure_callgen2(code, x, y);
    2254             : }
    2255             : 
    2256             : long
    2257      859502 : gp_callbool(void *E, GEN x)
    2258             : {
    2259      859502 :   pari_sp av = avma;
    2260      859502 :   GEN code = (GEN)E;
    2261      859502 :   return gc_long(av, !gequal0(closure_callgen1(code, x)));
    2262             : }
    2263             : 
    2264             : long
    2265           0 : gp_callvoid(void *E, GEN x)
    2266             : {
    2267           0 :   GEN code = (GEN)E;
    2268           0 :   closure_callvoid1(code, x);
    2269           0 :   return loop_break();
    2270             : }
    2271             : 
    2272             : INLINE const char *
    2273           0 : disassemble_cast(long mode)
    2274             : {
    2275           0 :   switch (mode)
    2276             :   {
    2277           0 :   case Gsmall:
    2278           0 :     return "small";
    2279           0 :   case Ggen:
    2280           0 :     return "gen";
    2281           0 :   case Gvar:
    2282           0 :     return "var";
    2283           0 :   case Gvoid:
    2284           0 :     return "void";
    2285           0 :   default:
    2286           0 :     return "unknown";
    2287             :   }
    2288             : }
    2289             : 
    2290             : void
    2291           0 : closure_disassemble(GEN C)
    2292             : {
    2293             :   const char * code;
    2294             :   GEN oper;
    2295             :   long i;
    2296           0 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("disassemble",C);
    2297           0 :   code=closure_codestr(C);
    2298           0 :   oper=closure_get_oper(C);
    2299           0 :   for(i=1;i<lg(oper);i++)
    2300             :   {
    2301           0 :     op_code opcode=(op_code) code[i];
    2302           0 :     long operand=oper[i];
    2303           0 :     pari_printf("%05ld\t",i);
    2304           0 :     switch(opcode)
    2305             :     {
    2306           0 :     case OCpushlong:
    2307           0 :       pari_printf("pushlong\t%ld\n",operand);
    2308           0 :       break;
    2309           0 :     case OCpushgnil:
    2310           0 :       pari_printf("pushgnil\n");
    2311           0 :       break;
    2312           0 :     case OCpushgen:
    2313           0 :       pari_printf("pushgen\t\t%ld\n",operand);
    2314           0 :       break;
    2315           0 :     case OCpushreal:
    2316           0 :       pari_printf("pushreal\t%ld\n",operand);
    2317           0 :       break;
    2318           0 :     case OCpushstoi:
    2319           0 :       pari_printf("pushstoi\t%ld\n",operand);
    2320           0 :       break;
    2321           0 :     case OCpushvar:
    2322             :       {
    2323           0 :         entree *ep = (entree *)operand;
    2324           0 :         pari_printf("pushvar\t%s\n",ep->name);
    2325           0 :         break;
    2326             :       }
    2327           0 :     case OCpushdyn:
    2328             :       {
    2329           0 :         entree *ep = (entree *)operand;
    2330           0 :         pari_printf("pushdyn\t\t%s\n",ep->name);
    2331           0 :         break;
    2332             :       }
    2333           0 :     case OCpushlex:
    2334           0 :       pari_printf("pushlex\t\t%ld\n",operand);
    2335           0 :       break;
    2336           0 :     case OCstoredyn:
    2337             :       {
    2338           0 :         entree *ep = (entree *)operand;
    2339           0 :         pari_printf("storedyn\t%s\n",ep->name);
    2340           0 :         break;
    2341             :       }
    2342           0 :     case OCstorelex:
    2343           0 :       pari_printf("storelex\t%ld\n",operand);
    2344           0 :       break;
    2345           0 :     case OCstoreptr:
    2346           0 :       pari_printf("storeptr\n");
    2347           0 :       break;
    2348           0 :     case OCsimpleptrdyn:
    2349             :       {
    2350           0 :         entree *ep = (entree *)operand;
    2351           0 :         pari_printf("simpleptrdyn\t%s\n",ep->name);
    2352           0 :         break;
    2353             :       }
    2354           0 :     case OCsimpleptrlex:
    2355           0 :       pari_printf("simpleptrlex\t%ld\n",operand);
    2356           0 :       break;
    2357           0 :     case OCnewptrdyn:
    2358             :       {
    2359           0 :         entree *ep = (entree *)operand;
    2360           0 :         pari_printf("newptrdyn\t%s\n",ep->name);
    2361           0 :         break;
    2362             :       }
    2363           0 :     case OCnewptrlex:
    2364           0 :       pari_printf("newptrlex\t%ld\n",operand);
    2365           0 :       break;
    2366           0 :     case OCpushptr:
    2367           0 :       pari_printf("pushptr\n");
    2368           0 :       break;
    2369           0 :     case OCstackgen:
    2370           0 :       pari_printf("stackgen\t%ld\n",operand);
    2371           0 :       break;
    2372           0 :     case OCendptr:
    2373           0 :       pari_printf("endptr\t\t%ld\n",operand);
    2374           0 :       break;
    2375           0 :     case OCprecreal:
    2376           0 :       pari_printf("precreal\n");
    2377           0 :       break;
    2378           0 :     case OCbitprecreal:
    2379           0 :       pari_printf("bitprecreal\n");
    2380           0 :       break;
    2381           0 :     case OCprecdl:
    2382           0 :       pari_printf("precdl\n");
    2383           0 :       break;
    2384           0 :     case OCstoi:
    2385           0 :       pari_printf("stoi\n");
    2386           0 :       break;
    2387           0 :     case OCutoi:
    2388           0 :       pari_printf("utoi\n");
    2389           0 :       break;
    2390           0 :     case OCitos:
    2391           0 :       pari_printf("itos\t\t%ld\n",operand);
    2392           0 :       break;
    2393           0 :     case OCitou:
    2394           0 :       pari_printf("itou\t\t%ld\n",operand);
    2395           0 :       break;
    2396           0 :     case OCtostr:
    2397           0 :       pari_printf("tostr\t\t%ld\n",operand);
    2398           0 :       break;
    2399           0 :     case OCvarn:
    2400           0 :       pari_printf("varn\t\t%ld\n",operand);
    2401           0 :       break;
    2402           0 :     case OCcopy:
    2403           0 :       pari_printf("copy\n");
    2404           0 :       break;
    2405           0 :     case OCcopyifclone:
    2406           0 :       pari_printf("copyifclone\n");
    2407           0 :       break;
    2408           0 :     case OCcompo1:
    2409           0 :       pari_printf("compo1\t\t%s\n",disassemble_cast(operand));
    2410           0 :       break;
    2411           0 :     case OCcompo1ptr:
    2412           0 :       pari_printf("compo1ptr\n");
    2413           0 :       break;
    2414           0 :     case OCcompo2:
    2415           0 :       pari_printf("compo2\t\t%s\n",disassemble_cast(operand));
    2416           0 :       break;
    2417           0 :     case OCcompo2ptr:
    2418           0 :       pari_printf("compo2ptr\n");
    2419           0 :       break;
    2420           0 :     case OCcompoC:
    2421           0 :       pari_printf("compoC\n");
    2422           0 :       break;
    2423           0 :     case OCcompoCptr:
    2424           0 :       pari_printf("compoCptr\n");
    2425           0 :       break;
    2426           0 :     case OCcompoL:
    2427           0 :       pari_printf("compoL\n");
    2428           0 :       break;
    2429           0 :     case OCcompoLptr:
    2430           0 :       pari_printf("compoLptr\n");
    2431           0 :       break;
    2432           0 :     case OCcheckargs:
    2433           0 :       pari_printf("checkargs\t0x%lx\n",operand);
    2434           0 :       break;
    2435           0 :     case OCcheckargs0:
    2436           0 :       pari_printf("checkargs0\t0x%lx\n",operand);
    2437           0 :       break;
    2438           0 :     case OCcheckuserargs:
    2439           0 :       pari_printf("checkuserargs\t%ld\n",operand);
    2440           0 :       break;
    2441           0 :     case OCdefaultlong:
    2442           0 :       pari_printf("defaultlong\t%ld\n",operand);
    2443           0 :       break;
    2444           0 :     case OCdefaultulong:
    2445           0 :       pari_printf("defaultulong\t%ld\n",operand);
    2446           0 :       break;
    2447           0 :     case OCdefaultgen:
    2448           0 :       pari_printf("defaultgen\t%ld\n",operand);
    2449           0 :       break;
    2450           0 :     case OCpackargs:
    2451           0 :       pari_printf("packargs\t%ld\n",operand);
    2452           0 :       break;
    2453           0 :     case OCgetargs:
    2454           0 :       pari_printf("getargs\t\t%ld\n",operand);
    2455           0 :       break;
    2456           0 :     case OCdefaultarg:
    2457           0 :       pari_printf("defaultarg\t%ld\n",operand);
    2458           0 :       break;
    2459           0 :     case OClocalvar:
    2460             :       {
    2461           0 :         entree *ep = (entree *)operand;
    2462           0 :         pari_printf("localvar\t%s\n",ep->name);
    2463           0 :         break;
    2464             :       }
    2465           0 :     case OClocalvar0:
    2466             :       {
    2467           0 :         entree *ep = (entree *)operand;
    2468           0 :         pari_printf("localvar0\t%s\n",ep->name);
    2469           0 :         break;
    2470             :       }
    2471           0 :     case OCexportvar:
    2472             :       {
    2473           0 :         entree *ep = (entree *)operand;
    2474           0 :         pari_printf("exportvar\t%s\n",ep->name);
    2475           0 :         break;
    2476             :       }
    2477           0 :     case OCunexportvar:
    2478             :       {
    2479           0 :         entree *ep = (entree *)operand;
    2480           0 :         pari_printf("unexportvar\t%s\n",ep->name);
    2481           0 :         break;
    2482             :       }
    2483           0 :     case OCcallgen:
    2484             :       {
    2485           0 :         entree *ep = (entree *)operand;
    2486           0 :         pari_printf("callgen\t\t%s\n",ep->name);
    2487           0 :         break;
    2488             :       }
    2489           0 :     case OCcallgen2:
    2490             :       {
    2491           0 :         entree *ep = (entree *)operand;
    2492           0 :         pari_printf("callgen2\t%s\n",ep->name);
    2493           0 :         break;
    2494             :       }
    2495           0 :     case OCcalllong:
    2496             :       {
    2497           0 :         entree *ep = (entree *)operand;
    2498           0 :         pari_printf("calllong\t%s\n",ep->name);
    2499           0 :         break;
    2500             :       }
    2501           0 :     case OCcallint:
    2502             :       {
    2503           0 :         entree *ep = (entree *)operand;
    2504           0 :         pari_printf("callint\t\t%s\n",ep->name);
    2505           0 :         break;
    2506             :       }
    2507           0 :     case OCcallvoid:
    2508             :       {
    2509           0 :         entree *ep = (entree *)operand;
    2510           0 :         pari_printf("callvoid\t%s\n",ep->name);
    2511           0 :         break;
    2512             :       }
    2513           0 :     case OCcalluser:
    2514           0 :       pari_printf("calluser\t%ld\n",operand);
    2515           0 :       break;
    2516           0 :     case OCvec:
    2517           0 :       pari_printf("vec\t\t%ld\n",operand);
    2518           0 :       break;
    2519           0 :     case OCcol:
    2520           0 :       pari_printf("col\t\t%ld\n",operand);
    2521           0 :       break;
    2522           0 :     case OCmat:
    2523           0 :       pari_printf("mat\t\t%ld\n",operand);
    2524           0 :       break;
    2525           0 :     case OCnewframe:
    2526           0 :       pari_printf("newframe\t%ld\n",operand);
    2527           0 :       break;
    2528           0 :     case OCsaveframe:
    2529           0 :       pari_printf("saveframe\t%ld\n", operand);
    2530           0 :       break;
    2531           0 :     case OCpop:
    2532           0 :       pari_printf("pop\t\t%ld\n",operand);
    2533           0 :       break;
    2534           0 :     case OCdup:
    2535           0 :       pari_printf("dup\t\t%ld\n",operand);
    2536           0 :       break;
    2537           0 :     case OCavma:
    2538           0 :       pari_printf("avma\n",operand);
    2539           0 :       break;
    2540           0 :     case OCgerepile:
    2541           0 :       pari_printf("gerepile\n",operand);
    2542           0 :       break;
    2543           0 :     case OCcowvardyn:
    2544             :       {
    2545           0 :         entree *ep = (entree *)operand;
    2546           0 :         pari_printf("cowvardyn\t%s\n",ep->name);
    2547           0 :         break;
    2548             :       }
    2549           0 :     case OCcowvarlex:
    2550           0 :       pari_printf("cowvarlex\t%ld\n",operand);
    2551           0 :       break;
    2552           0 :     case OCsetref:
    2553           0 :       pari_printf("setref\t\t%ld\n",operand);
    2554           0 :       break;
    2555           0 :     case OClock:
    2556           0 :       pari_printf("lock\t\t%ld\n",operand);
    2557           0 :       break;
    2558             :     }
    2559           0 :   }
    2560           0 : }
    2561             : 
    2562             : static int
    2563           0 : opcode_need_relink(op_code opcode)
    2564             : {
    2565           0 :   switch(opcode)
    2566             :   {
    2567           0 :   case OCpushlong:
    2568             :   case OCpushgen:
    2569             :   case OCpushgnil:
    2570             :   case OCpushreal:
    2571             :   case OCpushstoi:
    2572             :   case OCpushlex:
    2573             :   case OCstorelex:
    2574             :   case OCstoreptr:
    2575             :   case OCsimpleptrlex:
    2576             :   case OCnewptrlex:
    2577             :   case OCpushptr:
    2578             :   case OCstackgen:
    2579             :   case OCendptr:
    2580             :   case OCprecreal:
    2581             :   case OCbitprecreal:
    2582             :   case OCprecdl:
    2583             :   case OCstoi:
    2584             :   case OCutoi:
    2585             :   case OCitos:
    2586             :   case OCitou:
    2587             :   case OCtostr:
    2588             :   case OCvarn:
    2589             :   case OCcopy:
    2590             :   case OCcopyifclone:
    2591             :   case OCcompo1:
    2592             :   case OCcompo1ptr:
    2593             :   case OCcompo2:
    2594             :   case OCcompo2ptr:
    2595             :   case OCcompoC:
    2596             :   case OCcompoCptr:
    2597             :   case OCcompoL:
    2598             :   case OCcompoLptr:
    2599             :   case OCcheckargs:
    2600             :   case OCcheckargs0:
    2601             :   case OCcheckuserargs:
    2602             :   case OCpackargs:
    2603             :   case OCgetargs:
    2604             :   case OCdefaultarg:
    2605             :   case OCdefaultgen:
    2606             :   case OCdefaultlong:
    2607             :   case OCdefaultulong:
    2608             :   case OCcalluser:
    2609             :   case OCvec:
    2610             :   case OCcol:
    2611             :   case OCmat:
    2612             :   case OCnewframe:
    2613             :   case OCsaveframe:
    2614             :   case OCdup:
    2615             :   case OCpop:
    2616             :   case OCavma:
    2617             :   case OCgerepile:
    2618             :   case OCcowvarlex:
    2619             :   case OCsetref:
    2620             :   case OClock:
    2621           0 :     break;
    2622           0 :   case OCpushvar:
    2623             :   case OCpushdyn:
    2624             :   case OCstoredyn:
    2625             :   case OCsimpleptrdyn:
    2626             :   case OCnewptrdyn:
    2627             :   case OClocalvar:
    2628             :   case OClocalvar0:
    2629             :   case OCexportvar:
    2630             :   case OCunexportvar:
    2631             :   case OCcallgen:
    2632             :   case OCcallgen2:
    2633             :   case OCcalllong:
    2634             :   case OCcallint:
    2635             :   case OCcallvoid:
    2636             :   case OCcowvardyn:
    2637           0 :     return 1;
    2638             :   }
    2639           0 :   return 0;
    2640             : }
    2641             : 
    2642             : static void
    2643           0 : closure_relink(GEN C, hashtable *table)
    2644             : {
    2645           0 :   const char *code = closure_codestr(C);
    2646           0 :   GEN oper = closure_get_oper(C);
    2647           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2648             :   long i, j;
    2649           0 :   for(i=1;i<lg(oper);i++)
    2650           0 :     if (oper[i] && opcode_need_relink((op_code)code[i]))
    2651           0 :       oper[i] = (long) hash_search(table,(void*) oper[i])->val;
    2652           0 :   for (i=1;i<lg(fram);i++)
    2653           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2654           0 :       if (mael(fram,i,j))
    2655           0 :         mael(fram,i,j) = (long) hash_search(table,(void*) mael(fram,i,j))->val;
    2656           0 : }
    2657             : 
    2658             : void
    2659           0 : gen_relink(GEN x, hashtable *table)
    2660             : {
    2661           0 :   long i, lx, tx = typ(x);
    2662           0 :   switch(tx)
    2663             :   {
    2664           0 :     case t_CLOSURE:
    2665           0 :       closure_relink(x, table);
    2666           0 :       gen_relink(closure_get_data(x), table);
    2667           0 :       if (lg(x)==8) gen_relink(closure_get_frame(x), table);
    2668           0 :       break;
    2669           0 :     case t_LIST:
    2670           0 :       if (list_data(x)) gen_relink(list_data(x), table);
    2671           0 :       break;
    2672           0 :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2673           0 :       lx = lg(x);
    2674           0 :       for (i=lontyp[tx]; i<lx; i++) gen_relink(gel(x,i), table);
    2675             :   }
    2676           0 : }
    2677             : 
    2678             : static void
    2679           0 : closure_unlink(GEN C)
    2680             : {
    2681           0 :   const char *code = closure_codestr(C);
    2682           0 :   GEN oper = closure_get_oper(C);
    2683           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2684             :   long i, j;
    2685           0 :   for(i=1;i<lg(oper);i++)
    2686           0 :     if (oper[i] && opcode_need_relink((op_code) code[i]))
    2687             :     {
    2688           0 :       long n = pari_stack_new(&s_relocs);
    2689           0 :       relocs[n] = (entree *) oper[i];
    2690             :     }
    2691           0 :   for (i=1;i<lg(fram);i++)
    2692           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2693           0 :       if (mael(fram,i,j))
    2694             :       {
    2695           0 :         long n = pari_stack_new(&s_relocs);
    2696           0 :         relocs[n] = (entree *) mael(fram,i,j);
    2697             :       }
    2698           0 : }
    2699             : 
    2700             : static void
    2701           0 : gen_unlink(GEN x)
    2702             : {
    2703           0 :   long i, lx, tx = typ(x);
    2704           0 :   switch(tx)
    2705             :   {
    2706           0 :     case t_CLOSURE:
    2707           0 :       closure_unlink(x);
    2708           0 :       gen_unlink(closure_get_data(x));
    2709           0 :       if (lg(x)==8) gen_unlink(closure_get_frame(x));
    2710           0 :       break;
    2711           0 :     case t_LIST:
    2712           0 :       if (list_data(x)) gen_unlink(list_data(x));
    2713           0 :       break;
    2714           0 :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2715           0 :       lx = lg(x);
    2716           0 :       for (i = lontyp[tx]; i<lx; i++) gen_unlink(gel(x,i));
    2717             :   }
    2718           0 : }
    2719             : 
    2720             : GEN
    2721           0 : copybin_unlink(GEN C)
    2722             : {
    2723           0 :   long i, l , n, nold = s_relocs.n;
    2724             :   GEN v, w, V, res;
    2725           0 :   if (C)
    2726           0 :     gen_unlink(C);
    2727             :   else
    2728             :   { /* contents of all variables */
    2729           0 :     long v, maxv = pari_var_next();
    2730           0 :     for (v=0; v<maxv; v++)
    2731             :     {
    2732           0 :       entree *ep = varentries[v];
    2733           0 :       if (!ep || !ep->value) continue;
    2734           0 :       gen_unlink((GEN)ep->value);
    2735             :     }
    2736             :   }
    2737           0 :   n = s_relocs.n-nold;
    2738           0 :   v = cgetg(n+1, t_VECSMALL);
    2739           0 :   for(i=0; i<n; i++)
    2740           0 :     v[i+1] = (long) relocs[i];
    2741           0 :   s_relocs.n = nold;
    2742           0 :   w = vecsmall_uniq(v); l = lg(w);
    2743           0 :   res = cgetg(3,t_VEC);
    2744           0 :   V = cgetg(l, t_VEC);
    2745           0 :   for(i=1; i<l; i++)
    2746             :   {
    2747           0 :     entree *ep = (entree*) w[i];
    2748           0 :     gel(V,i) = strtoGENstr(ep->name);
    2749             :   }
    2750           0 :   gel(res,1) = vecsmall_copy(w);
    2751           0 :   gel(res,2) = V;
    2752           0 :   return res;
    2753             : }
    2754             : 
    2755             : /* e = t_VECSMALL of entree *ep [ addresses ],
    2756             :  * names = t_VEC of strtoGENstr(ep.names),
    2757             :  * Return hashtable : ep => is_entry(ep.name) */
    2758             : hashtable *
    2759           0 : hash_from_link(GEN e, GEN names, int use_stack)
    2760             : {
    2761           0 :   long i, l = lg(e);
    2762           0 :   hashtable *h = hash_create_ulong(l-1, use_stack);
    2763           0 :   if (lg(names) != l) pari_err_DIM("hash_from_link");
    2764           0 :   for (i = 1; i < l; i++)
    2765             :   {
    2766           0 :     char *s = GSTR(gel(names,i));
    2767           0 :     hash_insert(h, (void*)e[i], (void*)fetch_entry(s));
    2768             :   }
    2769           0 :   return h;
    2770             : }
    2771             : 
    2772             : void
    2773           0 : bincopy_relink(GEN C, GEN V)
    2774             : {
    2775           0 :   pari_sp av = avma;
    2776           0 :   hashtable *table = hash_from_link(gel(V,1),gel(V,2),1);
    2777           0 :   gen_relink(C, table);
    2778           0 :   set_avma(av);
    2779           0 : }

Generated by: LCOV version 1.13