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

Generated by: LCOV version 1.13