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.0 lcov report (development 23332-367b47754) Lines: 1065 1437 74.1 %
Date: 2018-12-10 05:41:52 Functions: 99 118 83.9 %
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    92169859 : loop_break(void)
      30             : {
      31    92169859 :   switch(br_status)
      32             :   {
      33             :     case br_MULTINEXT :
      34          21 :       if (! --br_count) br_status = br_NEXT;
      35          21 :       return 1;
      36       70263 :     case br_BREAK : if (! --br_count) br_status = br_NONE; /* fall through */
      37       75222 :     case br_RETURN: return 1;
      38       19621 :     case br_NEXT: br_status = br_NONE; /* fall through */
      39             :   }
      40    92094616 :   return 0;
      41             : }
      42             : 
      43             : static void
      44       97891 : reset_break(void)
      45             : {
      46       97891 :   br_status = br_NONE;
      47       97891 :   if (br_res) { gunclone_deep(br_res); br_res = NULL; }
      48       97891 : }
      49             : 
      50             : GEN
      51       53198 : return0(GEN x)
      52             : {
      53       53198 :   GEN y = br_res;
      54       53198 :   br_res = (x && x != gnil)? gcloneref(x): NULL;
      55       53198 :   if (y) gunclone_deep(y);
      56       53198 :   br_status = br_RETURN; return NULL;
      57             : }
      58             : 
      59             : GEN
      60       20349 : next0(long n)
      61             : {
      62       20349 :   if (n < 1) pari_err_DOMAIN("next", "n", "<", gen_1, stoi(n));
      63       20342 :   if (n == 1) br_status = br_NEXT;
      64             :   else
      65             :   {
      66          14 :     br_count = n-1;
      67          14 :     br_status = br_MULTINEXT;
      68             :   }
      69       20342 :   return NULL;
      70             : }
      71             : 
      72             : GEN
      73       70319 : break0(long n)
      74             : {
      75       70319 :   if (n < 1) pari_err_DOMAIN("break", "n", "<", gen_1, stoi(n));
      76       70312 :   br_count = n;
      77       70312 :   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};
      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       13315 : new_val_cell(entree *ep, GEN x, char flag)
     106             : {
     107       13315 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     108       13315 :   v->value  = (GEN)ep->value;
     109       13315 :   v->prev   = (var_cell*) ep->pvalue;
     110       13315 :   v->flag   = flag;
     111       13315 :   v->valence= ep->valence;
     112             : 
     113             :   /* beware: f(p) = Nv = 0
     114             :    *         Nv = p; f(Nv) --> this call would destroy p [ isclone ] */
     115       13315 :   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       13315 :   ep->pvalue= (char*)v;
     119       13315 :   ep->valence=EpVAR;
     120       13315 : }
     121             : 
     122             : /* kill ep->value and replace by preceding one, poped from value stack */
     123             : static void
     124       13084 : pop_val(entree *ep)
     125             : {
     126       13084 :   var_cell *v = (var_cell*) ep->pvalue;
     127       13084 :   if (v != INITIAL)
     128             :   {
     129       13084 :     GEN old_val = (GEN) ep->value; /* protect against SIGINT */
     130       13084 :     ep->value  = v->value;
     131       13084 :     if (v->flag == COPY_VAL) gunclone_deep(old_val);
     132       13084 :     ep->pvalue = (char*) v->prev;
     133       13084 :     ep->valence=v->valence;
     134       13084 :     pari_free((void*)v);
     135             :   }
     136       13084 : }
     137             : 
     138             : void
     139       27315 : freeep(entree *ep)
     140             : {
     141       27315 :   if (EpSTATIC(ep)) return; /* gp function loaded at init time */
     142       27315 :   if (ep->help) {pari_free((void*)ep->help); ep->help=NULL;}
     143       27315 :   if (ep->code) {pari_free((void*)ep->code); ep->code=NULL;}
     144       27315 :   switch(EpVALENCE(ep))
     145             :   {
     146             :     case EpVAR:
     147       17687 :       while (ep->pvalue!=INITIAL) pop_val(ep);
     148       17687 :       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      200393 : pop_val_if_newer(entree *ep, long loc)
     177             : {
     178      200393 :   var_cell *v = (var_cell*) ep->pvalue;
     179             : 
     180      200393 :   if (v == INITIAL) return 0;
     181      175454 :   if (v->flag == COPY_VAL && !pop_entree_block(ep, loc)) return 0;
     182         245 :   ep->value = v->value;
     183         245 :   ep->pvalue= (char*) v->prev;
     184         245 :   ep->valence=v->valence;
     185         245 :   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    29065358 : changevalue(entree *ep, GEN x)
     192             : {
     193    29065358 :   var_cell *v = (var_cell*) ep->pvalue;
     194    29065358 :   if (v == INITIAL) new_val_cell(ep, x, COPY_VAL);
     195             :   else
     196             :   {
     197    29052071 :     GEN old_val = (GEN) ep->value; /* beware: gunclone_deep may destroy old x */
     198    29052071 :     ep->value = (void *) gclone(x);
     199    29052071 :     if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     200             :   }
     201    29065358 : }
     202             : 
     203             : INLINE GEN
     204      738031 : copyvalue(entree *ep)
     205             : {
     206      738031 :   var_cell *v = (var_cell*) ep->pvalue;
     207      738031 :   if (v && v->flag != COPY_VAL)
     208             :   {
     209           0 :     ep->value = (void*) gclone((GEN)ep->value);
     210           0 :     v->flag = COPY_VAL;
     211             :   }
     212      738031 :   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   112158397 : checkvalue(entree *ep, enum chk_VALUE flag)
     222             : {
     223   112158397 :   if (mt_is_thread())
     224           0 :     pari_err(e_MISC,"mt: attempt to change exported variable '%s'",ep->name);
     225   112158397 :   if (ep->valence==EpNEW)
     226       17592 :     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        4452 :         pari_var_create(ep);
     233        4452 :         ep->valence = EpVAR;
     234        4452 :         ep->value = initial_value(ep);
     235        4452 :         break;
     236             :       case chk_NOCREATE:
     237       13140 :         break;
     238             :     }
     239   112140805 :   else if (ep->valence!=EpVAR)
     240           0 :     err_var(strtoGENstr(ep->name));
     241   112158397 : }
     242             : 
     243             : INLINE GEN
     244    23111536 : checkvalueptr(entree *ep)
     245             : {
     246    23111536 :   checkvalue(ep, chk_NOCREATE);
     247    23111536 :   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   102699313 : check_array_index(long c, long l)
     270             : {
     271   102699313 :   if (c < 1) pari_err_COMPONENT("", "<", gen_1, stoi(c));
     272   102699307 :   if (c >= l) pari_err_COMPONENT("", ">", stoi(l-1), stoi(c));
     273   102699265 : }
     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     9697093 : change_compo(matcomp *c, GEN res)
     333             : {
     334     9697093 :   GEN p = c->parent, *pt = c->ptcell;
     335             :   long i, t;
     336             : 
     337     9697093 :   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     9697072 :   t = typ(res);
     344     9697072 :   if (c->full_row)
     345             :   {
     346      204820 :     if (t != t_VEC) pari_err_TYPE("matrix row assignment", res);
     347      204799 :     if (lg(res) != lg(p)) pari_err_DIM("matrix row assignment");
     348     2097620 :     for (i=1; i<lg(p); i++)
     349             :     {
     350     1892842 :       GEN p1 = gcoeff(p,c->full_row,i); /* Protect against SIGINT */
     351     1892842 :       gcoeff(p,c->full_row,i) = gclone(gel(res,i));
     352     1892842 :       if (isclone(p1)) gunclone_deep(p1);
     353             :     }
     354      204778 :     return;
     355             :   }
     356     9492252 :   if (c->full_col)
     357             :   {
     358      355341 :     if (t != t_COL) pari_err_TYPE("matrix col assignment", res);
     359      355327 :     if (lg(res) != lg(*pt)) pari_err_DIM("matrix col assignment");
     360             :   }
     361             : 
     362     9492231 :   res = gclone(res);
     363     9492231 :   gunclone_deep(*pt);
     364     9492231 :   *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 gp_pointer *ptrs;
     388             : static THREAD entree **lvars;
     389             : static THREAD struct var_lex *var;
     390             : static THREAD struct trace *trace;
     391             : static THREAD pari_stack s_st, s_ptrs, s_var, s_lvars, s_trace, s_prec;
     392             : 
     393             : static void
     394   158225995 : changelex(long vn, GEN x)
     395             : {
     396   158225995 :   struct var_lex *v=var+s_var.n+vn;
     397   158225995 :   GEN old_val = v->value;
     398   158225995 :   v->value = gclone(x);
     399   158226000 :   if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     400   158226000 : }
     401             : 
     402             : INLINE GEN
     403     9746275 : copylex(long vn)
     404             : {
     405     9746275 :   struct var_lex *v = var+s_var.n+vn;
     406     9746275 :   if (v->flag!=COPY_VAL)
     407             :   {
     408       52920 :     v->value = gclone(v->value);
     409       52920 :     v->flag  = COPY_VAL;
     410             :   }
     411     9746275 :   return v->value;
     412             : }
     413             : 
     414             : INLINE void
     415    60662378 : pushlex(long vn, GEN x)
     416             : {
     417    60662378 :   struct var_lex *v=var+s_var.n+vn;
     418    60662378 :   v->flag  = PUSH_VAL;
     419    60662378 :   v->value = x;
     420    60662378 : }
     421             : 
     422             : INLINE void
     423   148562395 : freelex(void)
     424             : {
     425   148562395 :   struct var_lex *v=var+s_var.n-1;
     426   148562395 :   s_var.n--;
     427   148562395 :   if (v->flag == COPY_VAL) gunclone_deep(v->value);
     428   148562395 : }
     429             : 
     430             : INLINE void
     431   190415122 : restore_vars(long nbmvar, long nblvar)
     432             : {
     433             :   long j;
     434   333333773 :   for(j=1;j<=nbmvar;j++)
     435   142918331 :     freelex();
     436   190415484 :   for(j=1;j<=nblvar;j++)
     437          42 :     { s_lvars.n--; pop_val(lvars[s_lvars.n]); }
     438   190415442 : }
     439             : 
     440             : INLINE void
     441       43636 : restore_trace(long nbtrace)
     442             : {
     443             :   long j;
     444       98903 :   for(j=1;j<=nbtrace;j++)
     445             :   {
     446       55267 :     GEN C = trace[s_trace.n-j].closure;
     447       55267 :     if (isclone(C)) gunclone(C);
     448             :   }
     449       43636 :   s_trace.n-=nbtrace;
     450       43636 : }
     451             : 
     452             : INLINE long
     453   195698033 : trace_push(long pc, GEN C)
     454             : {
     455             :   long tr;
     456   195698033 :   BLOCK_SIGINT_START
     457   197024695 :   tr = pari_stack_new(&s_trace);
     458   196559979 :   trace[tr].pc = pc;
     459   196559979 :   trace[tr].closure = C;
     460   196559979 :   BLOCK_SIGINT_END
     461   196914892 :   return tr;
     462             : }
     463             : 
     464             : void
     465     5644380 : push_lex(GEN a, GEN C)
     466             : {
     467     5644380 :   long vn=pari_stack_new(&s_var);
     468     5644381 :   struct var_lex *v=var+vn;
     469     5644381 :   v->flag  = PUSH_VAL;
     470     5644381 :   v->value = a;
     471     5644381 :   if (C) (void) trace_push(-1, C);
     472     5644387 : }
     473             : 
     474             : GEN
     475    45964823 : get_lex(long vn)
     476             : {
     477    45964823 :   struct var_lex *v=var+s_var.n+vn;
     478    45964823 :   return v->value;
     479             : }
     480             : 
     481             : void
     482    40365731 : set_lex(long vn, GEN x)
     483             : {
     484    40365731 :   struct var_lex *v=var+s_var.n+vn;
     485    40365731 :   if (v->flag == COPY_VAL) { gunclone_deep(v->value); v->flag = PUSH_VAL; }
     486    40365731 :   v->value = x;
     487    40365731 : }
     488             : 
     489             : void
     490     5505571 : pop_lex(long n)
     491             : {
     492             :   long j;
     493    11149688 :   for(j=1; j<=n; j++)
     494     5644116 :     freelex();
     495     5505572 :   s_trace.n--;
     496     5505572 : }
     497             : 
     498             : static THREAD pari_stack s_relocs;
     499             : static THREAD entree **relocs;
     500             : 
     501             : void
     502      118980 : pari_init_evaluator(void)
     503             : {
     504      118980 :   sp=0;
     505      118980 :   pari_stack_init(&s_st,sizeof(*st),(void**)&st);
     506      118928 :   pari_stack_alloc(&s_st,32);
     507      119087 :   s_st.n=s_st.alloc;
     508      119087 :   rp=0;
     509      119087 :   pari_stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
     510      119079 :   pari_stack_alloc(&s_ptrs,16);
     511      119105 :   s_ptrs.n=s_ptrs.alloc;
     512      119105 :   pari_stack_init(&s_var,sizeof(*var),(void**)&var);
     513      119009 :   pari_stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
     514      119024 :   pari_stack_init(&s_trace,sizeof(*trace),(void**)&trace);
     515      119005 :   br_res = NULL;
     516      119005 :   pari_stack_init(&s_relocs,sizeof(*relocs),(void**)&relocs);
     517      118922 :   pari_stack_init(&s_prec,sizeof(*precs),(void**)&precs);
     518      118922 : }
     519             : void
     520      116904 : pari_close_evaluator(void)
     521             : {
     522      116904 :   pari_stack_delete(&s_st);
     523      118339 :   pari_stack_delete(&s_ptrs);
     524      118518 :   pari_stack_delete(&s_var);
     525      118591 :   pari_stack_delete(&s_lvars);
     526      118211 :   pari_stack_delete(&s_trace);
     527      118481 :   pari_stack_delete(&s_relocs);
     528      118074 :   pari_stack_delete(&s_prec);
     529      117531 : }
     530             : 
     531             : static gp_pointer *
     532    58405155 : new_ptr(void)
     533             : {
     534    58405155 :   if (rp==s_ptrs.n-1)
     535             :   {
     536             :     long i;
     537           0 :     gp_pointer *old = ptrs;
     538           0 :     (void)pari_stack_new(&s_ptrs);
     539           0 :     if (old != ptrs)
     540           0 :       for(i=0; i<rp; i++)
     541             :       {
     542           0 :         gp_pointer *g = &ptrs[i];
     543           0 :         if(g->sp >= 0) gel(st,g->sp) = (GEN) &(g->x);
     544             :       }
     545             :   }
     546    58405155 :   return &ptrs[rp++];
     547             : }
     548             : 
     549             : void
     550       91542 : push_localbitprec(long p)
     551             : {
     552       91542 :   long n = pari_stack_new(&s_prec);
     553       91542 :   precs[n] = p;
     554       91542 : }
     555             : void
     556       80916 : push_localprec(long p) { push_localbitprec(prec2nbits(p)); }
     557             : 
     558             : void
     559       80916 : pop_localprec(void) { s_prec.n--; }
     560             : 
     561             : long
     562    14305333 : get_localbitprec(void) { return s_prec.n? precs[s_prec.n-1]: precreal; }
     563             : 
     564             : long
     565    14287795 : get_localprec(void) { return nbits2prec(get_localbitprec()); }
     566             : 
     567             : static void
     568       10652 : checkprec(const char *f, long p, long M)
     569             : {
     570       10652 :   if (p < 1) pari_err_DOMAIN(f, "p", "<", gen_1, stoi(p));
     571       10638 :   if (p > M) pari_err_DOMAIN(f, "p", ">", utoipos(M), utoi(p));
     572       10626 : }
     573             : static long
     574       10724 : _prec(GEN p, const char *f)
     575             : {
     576       10724 :   pari_sp av = avma;
     577       10724 :   if (typ(p) == t_INT) return itos(p);
     578          35 :   p = gceil(p);
     579          35 :   if (typ(p) != t_INT) pari_err_TYPE(f, p);
     580          28 :   return gc_long(av, itos(p));
     581             : }
     582             : long
     583        8001 : localprec(GEN pp)
     584             : {
     585             :   long p;
     586        8001 :   if (!pp) return prec2ndec(get_localprec());
     587        8001 :   p = _prec(pp, "localprec");
     588        7993 :   checkprec("localprec", p, prec2ndec(LGBITS));
     589        7980 :   p = ndec2nbits(p);
     590        7980 :   push_localbitprec(p); return p;
     591             : }
     592             : long
     593        2660 : localbitprec(GEN pp)
     594             : {
     595             :   long p;
     596        2660 :   if (!pp) return get_localbitprec();
     597        2660 :   p = _prec(pp, "localbitprec");
     598        2659 :   checkprec("localbitprec", p, (long)LGBITS);
     599        2646 :   push_localbitprec(p); return p;
     600             : }
     601             : 
     602             : static GEN
     603        3486 : _precision0(GEN x)
     604             : {
     605        3486 :   long a = gprecision(x);
     606        3486 :   return a? utoi(prec2ndec(a)): mkoo();
     607             : }
     608             : GEN
     609          35 : precision0(GEN x, long n)
     610          35 : { return n? gprec(x,n): _precision0(x); }
     611             : static GEN
     612         560 : _bitprecision0(GEN x)
     613             : {
     614         560 :   long a = gprecision(x);
     615         560 :   return a? utoi(prec2nbits(a)): mkoo();
     616             : }
     617             : GEN
     618          28 : bitprecision0(GEN x, long n)
     619             : {
     620          28 :   if (n < 0)
     621           0 :     pari_err_DOMAIN("bitprecision", "bitprecision", "<", gen_0, stoi(n));
     622          28 :   if (n) {
     623          28 :     pari_sp av = avma;
     624          28 :     GEN y = gprec_w(x, nbits2prec(n));
     625          28 :     return gerepilecopy(av, y);
     626             :   }
     627           0 :   return _bitprecision0(x);
     628             : }
     629             : GEN
     630        3535 : precision00(GEN x, GEN n)
     631             : {
     632        3535 :   if (!x)
     633             :   {
     634          14 :     if (n) pari_err(e_MISC, "omitting x with n present");
     635           7 :     return utoipos(prec2ndec(get_localprec()));
     636             :   }
     637        3521 :   if (!n) return _precision0(x);
     638          35 :   return precision0(x, _prec(n, "precision"));
     639             : }
     640             : GEN
     641         602 : bitprecision00(GEN x, GEN n)
     642             : {
     643         602 :   if (!x)
     644             :   {
     645          14 :     if (n) pari_err(e_MISC, "omitting x with n present");
     646           7 :     return utoipos(get_localbitprec());
     647             :   }
     648         588 :   if (!n) return _bitprecision0(x);
     649          28 :   return bitprecision0(x, _prec(n, "bitprecision"));
     650             : }
     651             : 
     652             : INLINE GEN
     653    23383972 : copyupto(GEN z, GEN t)
     654             : {
     655    23383972 :   if (is_universal_constant(z) || (z>(GEN)pari_mainstack->bot && z<=t))
     656    21770967 :     return z;
     657             :   else
     658     1612987 :     return gcopy(z);
     659             : }
     660             : 
     661             : static void closure_eval(GEN C);
     662             : 
     663             : INLINE GEN
     664    35957276 : closure_return(GEN C)
     665             : {
     666    35957276 :   pari_sp ltop=avma;
     667    35957276 :   closure_eval(C);
     668    35935167 :   if (br_status)
     669             :   {
     670             :     GEN z;
     671       53915 :     set_avma(ltop);
     672       53915 :     z=br_res?gcopy(br_res):gnil;
     673       53915 :     reset_break();
     674       53915 :     return z;
     675             :   }
     676    35881252 :   return gerepileupto(ltop,gel(st,--sp));
     677             : }
     678             : 
     679             : /* for the break_loop debugger. Not memory clean */
     680             : GEN
     681         161 : closure_evalbrk(GEN C, long *status)
     682             : {
     683         161 :   closure_eval(C);
     684         133 :   *status = br_status;
     685         133 :   if (br_status)
     686             :   {
     687          49 :     GEN z = br_res? gcopy(br_res): gnil;
     688          49 :     reset_break();
     689          49 :     return z;
     690             :   }
     691          84 :   return gel(st,--sp);
     692             : }
     693             : 
     694             : INLINE long
     695     1130681 : closure_varn(GEN x)
     696             : {
     697     1130681 :   if (!x) return -1;
     698     1130121 :   if (!gequalX(x)) err_var(x);
     699     1130121 :   return varn(x);
     700             : }
     701             : 
     702             : INLINE void
     703    90647759 : closure_castgen(GEN z, long mode)
     704             : {
     705    90647759 :   switch (mode)
     706             :   {
     707             :   case Ggen:
     708    90647094 :     gel(st,sp++)=z;
     709    90647094 :     break;
     710             :   case Gsmall:
     711         665 :     st[sp++]=gtos(z);
     712         665 :     break;
     713             :   case Gusmall:
     714           0 :     st[sp++]=gtou(z);
     715           0 :     break;
     716             :   case Gvar:
     717           0 :     st[sp++]=closure_varn(z);
     718           0 :     break;
     719             :   case Gvoid:
     720           0 :     break;
     721             :   default:
     722           0 :     pari_err_BUG("closure_castgen, type unknown");
     723             :   }
     724    90647759 : }
     725             : 
     726             : INLINE void
     727        5467 : closure_castlong(long z, long mode)
     728             : {
     729        5467 :   switch (mode)
     730             :   {
     731             :   case Gsmall:
     732           0 :     st[sp++]=z;
     733           0 :     break;
     734             :   case Gusmall:
     735           0 :     if (z < 0)
     736           0 :       pari_err_TYPE("stou [integer >=0 expected]", stoi(z));
     737           0 :     st[sp++]=(ulong) z;
     738           0 :     break;
     739             :   case Ggen:
     740        5460 :     gel(st,sp++)=stoi(z);
     741        5460 :     break;
     742             :   case Gvar:
     743           0 :     err_var(stoi(z));
     744             :   case Gvoid:
     745           7 :     break;
     746             :   default:
     747           0 :     pari_err_BUG("closure_castlong, type unknown");
     748             :   }
     749        5467 : }
     750             : 
     751             : const char *
     752        9593 : closure_func_err(void)
     753             : {
     754        9593 :   long fun=s_trace.n-1, pc;
     755             :   const char *code;
     756             :   GEN C, oper;
     757        9593 :   if (fun < 0 || trace[fun].pc < 0) return NULL;
     758        9090 :   pc = trace[fun].pc; C  = trace[fun].closure;
     759        9090 :   code = closure_codestr(C); oper = closure_get_oper(C);
     760       12531 :   if (code[pc]==OCcallgen || code[pc]==OCcallgen2 ||
     761        6784 :       code[pc]==OCcallint || code[pc]==OCcalllong || code[pc]==OCcallvoid)
     762        6136 :     return ((entree*)oper[pc])->name;
     763        2954 :   return NULL;
     764             : }
     765             : 
     766             : /* return the next label for the call chain debugger closure_err(),
     767             :  * incorporating the name of the user of member function. Return NULL for an
     768             :  * anonymous (inline) closure. */
     769             : static char *
     770         182 : get_next_label(const char *s, int member, char **next_fun)
     771             : {
     772         182 :   const char *v, *t = s+1;
     773             :   char *u, *next_label;
     774             : 
     775         182 :   if (!is_keyword_char(*s)) return NULL;
     776         175 :   while (is_keyword_char(*t)) t++;
     777             :   /* e.g. (x->1/x)(0) instead of (x)->1/x */
     778         175 :   if (t[0] == '-' && t[1] == '>') return NULL;
     779         168 :   next_label = (char*)pari_malloc(t - s + 32);
     780         168 :   sprintf(next_label, "in %sfunction ", member? "member ": "");
     781         168 :   u = *next_fun = next_label + strlen(next_label);
     782         168 :   v = s;
     783         168 :   while (v < t) *u++ = *v++;
     784         168 :   *u++ = 0; return next_label;
     785             : }
     786             : 
     787             : static const char *
     788          21 : get_arg_name(GEN C, long i)
     789             : {
     790          21 :   GEN d = closure_get_dbg(C), frpc = gel(d,2), fram = gel(d,3);
     791          21 :   long j, l = lg(frpc);
     792          28 :   for (j=1; j<l; j++)
     793          28 :     if (frpc[j]==1 && i<lg(gel(fram,j)))
     794          21 :       return ((entree*)mael(fram,j,i))->name;
     795           0 :   return "(unnamed)";
     796             : }
     797             : 
     798             : void
     799        9092 : closure_err(long level)
     800             : {
     801             :   GEN base;
     802        9092 :   const long lastfun = s_trace.n - 1 - level;
     803             :   char *next_label, *next_fun;
     804        9092 :   long i = maxss(0, lastfun - 19);
     805        9092 :   if (lastfun < 0) return; /*e.g. when called by gp_main_loop's simplify */
     806        9092 :   if (i > 0) while (lg(trace[i].closure)==6) i--;
     807        9092 :   base = closure_get_text(trace[i].closure); /* gcc -Wall*/
     808        9092 :   next_label = pari_strdup(i == 0? "at top-level": "[...] at");
     809        9092 :   next_fun = next_label;
     810        9640 :   for (; i <= lastfun; i++)
     811             :   {
     812        9640 :     GEN C = trace[i].closure;
     813        9640 :     if (lg(C) >= 7) base=closure_get_text(C);
     814        9640 :     if ((i==lastfun || lg(trace[i+1].closure)>=7))
     815             :     {
     816        9274 :       GEN dbg = gel(closure_get_dbg(C),1);
     817             :       /* After a SIGINT, pc can be slightly off: ensure 0 <= pc < lg() */
     818        9274 :       long pc = minss(lg(dbg)-1, trace[i].pc>=0 ? trace[i].pc: 1);
     819        9274 :       long offset = pc? dbg[pc]: 0;
     820             :       int member;
     821             :       const char *s, *sbase;
     822        9274 :       if (typ(base)!=t_VEC) sbase = GSTR(base);
     823         147 :       else if (offset>=0)   sbase = GSTR(gel(base,2));
     824          21 :       else { sbase = GSTR(gel(base,1)); offset += strlen(sbase); }
     825        9274 :       s = sbase + offset;
     826        9274 :       member = offset>0 && (s[-1] == '.');
     827             :       /* avoid "in function foo: foo" */
     828        9274 :       if (!next_fun || strcmp(next_fun, s)) {
     829        9267 :         print_errcontext(pariErr, next_label, s, sbase);
     830        9267 :         out_putc(pariErr, '\n');
     831             :       }
     832        9274 :       pari_free(next_label);
     833        9274 :       if (i == lastfun) break;
     834             : 
     835         182 :       next_label = get_next_label(s, member, &next_fun);
     836         182 :       if (!next_label) {
     837          14 :         next_label = pari_strdup("in anonymous function");
     838          14 :         next_fun = NULL;
     839             :       }
     840             :     }
     841             :   }
     842             : }
     843             : 
     844             : GEN
     845          35 : pari_self(void)
     846             : {
     847          35 :   long fun = s_trace.n - 1;
     848          35 :   if (fun > 0) while (lg(trace[fun].closure)==6) fun--;
     849          35 :   return fun >= 0 ? trace[fun].closure: NULL;
     850             : }
     851             : 
     852             : long
     853          84 : closure_context(long start, long level)
     854             : {
     855          84 :   const long lastfun = s_trace.n - 1 - level;
     856          84 :   long i, fun = lastfun;
     857          84 :   if (fun<0) return lastfun;
     858          84 :   while (fun>start && lg(trace[fun].closure)==6) fun--;
     859         280 :   for (i=fun; i <= lastfun; i++)
     860         196 :     push_frame(trace[i].closure, trace[i].pc,0);
     861         119 :   for (  ; i < s_trace.n; i++)
     862          35 :     push_frame(trace[i].closure, trace[i].pc,1);
     863          84 :   return s_trace.n-level;
     864             : }
     865             : 
     866             : INLINE void
     867  2301001870 : st_alloc(long n)
     868             : {
     869  2301001870 :   if (sp+n>s_st.n)
     870             :   {
     871          42 :     pari_stack_alloc(&s_st,n+16);
     872          42 :     s_st.n=s_st.alloc;
     873          42 :     if (DEBUGMEM>=2) pari_warn(warner,"doubling evaluator stack");
     874             :   }
     875  2301001870 : }
     876             : 
     877             : INLINE void
     878     9902088 : ptr_proplock(gp_pointer *g, GEN C)
     879             : {
     880     9902088 :   g->x = C;
     881     9902088 :   if (isclone(g->x))
     882             :   {
     883      444465 :     clone_unlock_deep(g->ox);
     884      444465 :     g->ox = g->x;
     885      444465 :     ++bl_refc(g->ox);
     886             :   }
     887     9902088 : }
     888             : 
     889             : static void
     890   190363862 : closure_eval(GEN C)
     891             : {
     892   190363862 :   const char *code=closure_codestr(C);
     893   190326133 :   GEN oper=closure_get_oper(C);
     894   190296540 :   GEN data=closure_get_data(C);
     895   190283174 :   long loper=lg(oper);
     896   190283174 :   long saved_sp=sp-closure_arity(C);
     897   190261415 :   long saved_rp=rp, saved_prec=s_prec.n;
     898   190261415 :   long j, nbmvar=0, nblvar=0;
     899             :   long pc, t;
     900             : #ifdef STACK_CHECK
     901             :   GEN stackelt;
     902   190261415 :   if (PARI_stack_limit && (void*) &stackelt <= PARI_stack_limit)
     903           0 :     pari_err(e_MISC, "deep recursion");
     904             : #endif
     905   190261415 :   clone_lock(C);
     906   190246665 :   t = trace_push(0, C);
     907   191221716 :   if (lg(C)==8)
     908             :   {
     909     1227637 :     GEN z=closure_get_frame(C);
     910     1227576 :     long l=lg(z)-1;
     911     1227576 :     pari_stack_alloc(&s_var,l);
     912     1227600 :     s_var.n+=l;
     913     1227600 :     nbmvar+=l;
     914     5264811 :     for(j=1;j<=l;j++)
     915             :     {
     916     4037211 :       var[s_var.n-j].flag=PUSH_VAL;
     917     4037211 :       var[s_var.n-j].value=gel(z,j);
     918             :     }
     919             :   }
     920             : 
     921  2424725709 :   for(pc=1;pc<loper;pc++)
     922             :   {
     923  2234174620 :     op_code opcode=(op_code) code[pc];
     924  2234174620 :     long operand=oper[pc];
     925  2234174620 :     if (sp<0) pari_err_BUG("closure_eval, stack underflow");
     926  2234174620 :     st_alloc(16);
     927  2233672407 :     trace[t].pc = pc;
     928             :     CHECK_CTRLC
     929  2233672407 :     switch(opcode)
     930             :     {
     931             :     case OCpushlong:
     932   160545678 :       st[sp++]=operand;
     933   160545678 :       break;
     934             :     case OCpushgnil:
     935       93384 :       gel(st,sp++)=gnil;
     936       93384 :       break;
     937             :     case OCpushgen:
     938    95443846 :       gel(st,sp++)=gel(data,operand);
     939    95443846 :       break;
     940             :     case OCpushreal:
     941       83792 :       gel(st,sp++)=strtor(GSTR(data[operand]),get_localprec());
     942       83792 :       break;
     943             :     case OCpushstoi:
     944   162235578 :       gel(st,sp++)=stoi(operand);
     945   162235573 :       break;
     946             :     case OCpushvar:
     947             :       {
     948       21507 :         entree *ep = (entree *)operand;
     949       21507 :         gel(st,sp++)=pol_x(pari_var_create(ep));
     950       21507 :         break;
     951             :       }
     952             :     case OCpushdyn:
     953             :       {
     954    82355108 :         entree *ep = (entree *)operand;
     955    82355108 :         if (!mt_is_thread())
     956             :         {
     957    82354910 :           checkvalue(ep, chk_CREATE);
     958    82354910 :           gel(st,sp++)=(GEN)ep->value;
     959             :         } else
     960             :         {
     961         198 :           GEN val = export_get(ep->name);
     962         198 :           if (!val)
     963           0 :             pari_err(e_MISC,"mt: please use export(%s)", ep->name);
     964         198 :           gel(st,sp++)=val;
     965             :         }
     966    82355108 :         break;
     967             :       }
     968             :     case OCpushlex:
     969   480121006 :       gel(st,sp++)=var[s_var.n+operand].value;
     970   480121006 :       break;
     971             :     case OCsimpleptrdyn:
     972             :       {
     973    23111536 :         gp_pointer *g = new_ptr();
     974    23111536 :         g->vn=0;
     975    23111536 :         g->ep = (entree*) operand;
     976    23111536 :         g->x = checkvalueptr(g->ep);
     977    23111536 :         g->ox = g->x; clone_lock(g->ox);
     978    23111536 :         g->sp = sp;
     979    23111536 :         gel(st,sp++) = (GEN)&(g->x);
     980    23111536 :         break;
     981             :       }
     982             :     case OCsimpleptrlex:
     983             :       {
     984    25596477 :         gp_pointer *g = new_ptr();
     985    25596477 :         g->vn=operand;
     986    25596477 :         g->ep=(entree *)0x1L;
     987    25596477 :         g->x = (GEN) var[s_var.n+operand].value;
     988    25596477 :         g->ox = g->x; clone_lock(g->ox);
     989    25596477 :         g->sp = sp;
     990    25596477 :         gel(st,sp++) = (GEN)&(g->x);
     991    25596477 :         break;
     992             :       }
     993             :     case OCnewptrdyn:
     994             :       {
     995        2646 :         entree *ep = (entree *)operand;
     996        2646 :         gp_pointer *g = new_ptr();
     997             :         matcomp *C;
     998        2646 :         checkvalue(ep, chk_ERROR);
     999        2646 :         g->sp = -1;
    1000        2646 :         g->x = copyvalue(ep);
    1001        2646 :         g->ox = g->x; clone_lock(g->ox);
    1002        2646 :         g->vn=0;
    1003        2646 :         g->ep=NULL;
    1004        2646 :         C=&g->c;
    1005        2646 :         C->full_col = C->full_row = 0;
    1006        2646 :         C->parent   = (GEN)    g->x;
    1007        2646 :         C->ptcell   = (GEN *) &g->x;
    1008        2646 :         break;
    1009             :       }
    1010             :     case OCnewptrlex:
    1011             :       {
    1012     9694496 :         gp_pointer *g = new_ptr();
    1013             :         matcomp *C;
    1014     9694496 :         g->sp = -1;
    1015     9694496 :         g->x = copylex(operand);
    1016     9694496 :         g->ox = g->x; clone_lock(g->ox);
    1017     9694496 :         g->vn=0;
    1018     9694496 :         g->ep=NULL;
    1019     9694496 :         C=&g->c;
    1020     9694496 :         C->full_col = C->full_row = 0;
    1021     9694496 :         C->parent   = (GEN)     g->x;
    1022     9694496 :         C->ptcell   = (GEN *) &(g->x);
    1023     9694496 :         break;
    1024             :       }
    1025             :     case OCpushptr:
    1026             :       {
    1027      557543 :         gp_pointer *g = &ptrs[rp-1];
    1028      557543 :         g->sp = sp;
    1029      557543 :         gel(st,sp++) = (GEN)&(g->x);
    1030             :       }
    1031      557543 :       break;
    1032             :     case OCendptr:
    1033    98531000 :       for(j=0;j<operand;j++)
    1034             :       {
    1035    49265500 :         gp_pointer *g = &ptrs[--rp];
    1036    49265500 :         if (g->ep)
    1037             :         {
    1038    48707957 :           if (g->vn)
    1039    25596477 :             changelex(g->vn, g->x);
    1040             :           else
    1041    23111480 :             changevalue(g->ep, g->x);
    1042             :         }
    1043      557543 :         else change_compo(&(g->c), g->x);
    1044    49265500 :         clone_unlock_deep(g->ox);
    1045             :       }
    1046    49265500 :       break;
    1047             :     case OCstoredyn:
    1048             :       {
    1049     5953878 :         entree *ep = (entree *)operand;
    1050     5953878 :         checkvalue(ep, chk_NOCREATE);
    1051     5953878 :         changevalue(ep, gel(st,--sp));
    1052     5953878 :         break;
    1053             :       }
    1054             :     case OCstorelex:
    1055   132629518 :       changelex(operand,gel(st,--sp));
    1056   132629519 :       break;
    1057             :     case OCstoreptr:
    1058             :       {
    1059     9139550 :         gp_pointer *g = &ptrs[--rp];
    1060     9139550 :         change_compo(&(g->c), gel(st,--sp));
    1061     9139473 :         clone_unlock_deep(g->ox);
    1062     9139473 :         break;
    1063             :       }
    1064             :     case OCstackgen:
    1065             :       {
    1066    21462951 :         GEN z = gerepileupto(st[sp-2],gel(st,sp-1));
    1067    21462959 :         gmael(st,sp-3,operand) = copyupto(z,gel(st,sp-2));
    1068    21462962 :         st[sp-2] = avma;
    1069    21462962 :         sp--;
    1070    21462962 :         break;
    1071             :       }
    1072             :     case OCprecreal:
    1073    14203998 :       st[sp++]=get_localprec();
    1074    14203996 :       break;
    1075             :     case OCbitprecreal:
    1076       17528 :       st[sp++]=get_localbitprec();
    1077       17528 :       break;
    1078             :     case OCprecdl:
    1079         910 :       st[sp++]=precdl;
    1080         910 :       break;
    1081             :     case OCavma:
    1082        1771 :       st[sp++]=avma;
    1083        1771 :       break;
    1084             :     case OCcowvardyn:
    1085             :       {
    1086      735385 :         entree *ep = (entree *)operand;
    1087      735385 :         checkvalue(ep, chk_ERROR);
    1088      735385 :         (void)copyvalue(ep);
    1089      735385 :         break;
    1090             :       }
    1091             :     case OCcowvarlex:
    1092       50778 :       (void)copylex(operand);
    1093       50778 :       break;
    1094             :     case OCstoi:
    1095    14919977 :       gel(st,sp-1)=stoi(st[sp-1]);
    1096    14919940 :       break;
    1097             :     case OCutoi:
    1098           0 :       gel(st,sp-1)=utoi(st[sp-1]);
    1099           0 :       break;
    1100             :     case OCitos:
    1101    70711585 :       st[sp+operand]=gtos(gel(st,sp+operand));
    1102    70711566 :       break;
    1103             :     case OCitou:
    1104      146631 :       st[sp+operand]=gtou(gel(st,sp+operand));
    1105      146641 :       break;
    1106             :     case OCtostr:
    1107             :       {
    1108        4873 :         GEN z = gel(st,sp+operand);
    1109        4873 :         st[sp+operand] = (long)GENtostr_unquoted(z);
    1110        4873 :         break;
    1111             :       }
    1112             :     case OCvarn:
    1113     1130681 :       st[sp+operand] = closure_varn(gel(st,sp+operand));
    1114     1130681 :       break;
    1115             :     case OCcopy:
    1116    23749160 :       gel(st,sp-1) = gcopy(gel(st,sp-1));
    1117    23749164 :       break;
    1118             :     case OCgerepile:
    1119             :     {
    1120             :       pari_sp av;
    1121             :       GEN x;
    1122        1771 :       sp--;
    1123        1771 :       av = st[sp-1];
    1124        1771 :       x = gel(st,sp);
    1125        1771 :       if (isonstack(x))
    1126             :       {
    1127        1771 :         pari_sp av2 = (pari_sp)(x + lg(x));
    1128        1771 :         if ((long) (av - av2) > 1000000L)
    1129             :         {
    1130           0 :           if (DEBUGMEM>=2)
    1131           0 :             pari_warn(warnmem,"eval: recovering %ld bytes", av - av2);
    1132           0 :           x = gerepileupto(av, x);
    1133             :         }
    1134           0 :       } else set_avma(av);
    1135        1771 :       gel(st,sp-1) = x;
    1136        1771 :       break;
    1137             :     }
    1138             :     case OCcopyifclone:
    1139           0 :       if (isclone(gel(st,sp-1)))
    1140           0 :         gel(st,sp-1) = gcopy(gel(st,sp-1));
    1141           0 :       break;
    1142             :     case OCcompo1:
    1143             :       {
    1144    90020438 :         GEN  p=gel(st,sp-2);
    1145    90020438 :         long c=st[sp-1];
    1146    90020438 :         sp-=2;
    1147    90020438 :         switch(typ(p))
    1148             :         {
    1149             :         case t_VEC: case t_COL:
    1150    90014943 :           check_array_index(c, lg(p));
    1151    90014943 :           closure_castgen(gel(p,c),operand);
    1152    90014945 :           break;
    1153             :         case t_LIST:
    1154             :           {
    1155             :             long lx;
    1156           7 :             if (list_typ(p)!=t_LIST_RAW)
    1157           0 :               pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1158           7 :             p = list_data(p); lx = p? lg(p): 1;
    1159           7 :             check_array_index(c, lx);
    1160           7 :             closure_castgen(gel(p,c),operand);
    1161           7 :             break;
    1162             :           }
    1163             :         case t_VECSMALL:
    1164        5481 :           check_array_index(c,lg(p));
    1165        5467 :           closure_castlong(p[c],operand);
    1166        5467 :           break;
    1167             :         default:
    1168           7 :           pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1169           0 :           break;
    1170             :         }
    1171    90020419 :         break;
    1172             :       }
    1173             :     case OCcompo1ptr:
    1174             :       {
    1175     9422861 :         long c=st[sp-1];
    1176             :         long lx;
    1177     9422861 :         gp_pointer *g = &ptrs[rp-1];
    1178     9422861 :         matcomp *C=&g->c;
    1179     9422861 :         GEN p = g->x;
    1180     9422861 :         sp--;
    1181     9422861 :         switch(typ(p))
    1182             :         {
    1183             :         case t_VEC: case t_COL:
    1184     9422798 :           check_array_index(c, lg(p));
    1185     9422798 :           C->ptcell = (GEN *) p+c;
    1186     9422798 :           ptr_proplock(g, *(C->ptcell));
    1187     9422798 :           break;
    1188             :         case t_VECSMALL:
    1189          28 :           check_array_index(c, lg(p));
    1190          21 :           C->ptcell = (GEN *) p+c;
    1191          21 :           g->x = stoi(p[c]);
    1192          21 :           break;
    1193             :         case t_LIST:
    1194          28 :           if (list_typ(p)!=t_LIST_RAW)
    1195           0 :             pari_err_TYPE("&_[_] OCcompo1 [not a vector]", p);
    1196          28 :           p = list_data(p); lx = p? lg(p): 1;
    1197          28 :           check_array_index(c,lx);
    1198          28 :           C->ptcell = (GEN *) p+c;
    1199          28 :           ptr_proplock(g, *(C->ptcell));
    1200          28 :           break;
    1201             :         default:
    1202           7 :           pari_err_TYPE("&_[_] OCcompo1ptr [not a vector]", p);
    1203             :         }
    1204     9422847 :         C->parent   = p;
    1205     9422847 :         break;
    1206             :       }
    1207             :     case OCcompo2:
    1208             :       {
    1209      632814 :         GEN  p=gel(st,sp-3);
    1210      632814 :         long c=st[sp-2];
    1211      632814 :         long d=st[sp-1];
    1212      632814 :         if (typ(p)!=t_MAT) pari_err_TYPE("_[_,_] OCcompo2 [not a matrix]", p);
    1213      632807 :         check_array_index(d, lg(p));
    1214      632807 :         check_array_index(c, lg(gel(p,d)));
    1215      632807 :         sp-=3;
    1216      632807 :         closure_castgen(gcoeff(p,c,d),operand);
    1217      632807 :         break;
    1218             :       }
    1219             :     case OCcompo2ptr:
    1220             :       {
    1221      123921 :         long c=st[sp-2];
    1222      123921 :         long d=st[sp-1];
    1223      123921 :         gp_pointer *g = &ptrs[rp-1];
    1224      123921 :         matcomp *C=&g->c;
    1225      123921 :         GEN p = g->x;
    1226      123921 :         sp-=2;
    1227      123921 :         if (typ(p)!=t_MAT)
    1228           0 :           pari_err_TYPE("&_[_,_] OCcompo2ptr [not a matrix]", p);
    1229      123921 :         check_array_index(d, lg(p));
    1230      123921 :         check_array_index(c, lg(gel(p,d)));
    1231      123921 :         C->ptcell = (GEN *) gel(p,d)+c;
    1232      123921 :         C->parent   = p;
    1233      123921 :         ptr_proplock(g, *(C->ptcell));
    1234      123921 :         break;
    1235             :       }
    1236             :     case OCcompoC:
    1237             :       {
    1238      909552 :         GEN  p=gel(st,sp-2);
    1239      909552 :         long c=st[sp-1];
    1240      909552 :         if (typ(p)!=t_MAT)
    1241           7 :           pari_err_TYPE("_[,_] OCcompoC [not a matrix]", p);
    1242      909545 :         check_array_index(c, lg(p));
    1243      909538 :         sp--;
    1244      909538 :         gel(st,sp-1) = gel(p,c);
    1245      909538 :         break;
    1246             :       }
    1247             :     case OCcompoCptr:
    1248             :       {
    1249      355355 :         long c=st[sp-1];
    1250      355355 :         gp_pointer *g = &ptrs[rp-1];
    1251      355355 :         matcomp *C=&g->c;
    1252      355355 :         GEN p = g->x;
    1253      355355 :         sp--;
    1254      355355 :         if (typ(p)!=t_MAT)
    1255           7 :           pari_err_TYPE("&_[,_] OCcompoCptr [not a matrix]", p);
    1256      355348 :         check_array_index(c, lg(p));
    1257      355341 :         C->ptcell = (GEN *) p+c;
    1258      355341 :         C->full_col = c;
    1259      355341 :         C->parent   = p;
    1260      355341 :         ptr_proplock(g, *(C->ptcell));
    1261      355341 :         break;
    1262             :       }
    1263             :     case OCcompoL:
    1264             :       {
    1265      272860 :         GEN  p=gel(st,sp-2);
    1266      272860 :         long r=st[sp-1];
    1267      272860 :         sp--;
    1268      272860 :         if (typ(p)!=t_MAT)
    1269           7 :           pari_err_TYPE("_[_,] OCcompoL [not a matrix]", p);
    1270      272853 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1271      272846 :         gel(st,sp-1) = row(p,r);
    1272      272846 :         break;
    1273             :       }
    1274             :     case OCcompoLptr:
    1275             :       {
    1276      204834 :         long r=st[sp-1];
    1277      204834 :         gp_pointer *g = &ptrs[rp-1];
    1278      204834 :         matcomp *C=&g->c;
    1279      204834 :         GEN p = g->x, p2;
    1280      204834 :         sp--;
    1281      204834 :         if (typ(p)!=t_MAT)
    1282           7 :           pari_err_TYPE("&_[_,] OCcompoLptr [not a matrix]", p);
    1283      204827 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1284      204820 :         p2 = rowcopy(p,r);
    1285      204820 :         C->full_row = r; /* record row number */
    1286      204820 :         C->ptcell = &p2;
    1287      204820 :         C->parent   = p;
    1288      204820 :         g->x = p2;
    1289      204820 :         break;
    1290             :       }
    1291             :     case OCdefaultarg:
    1292       11116 :       if (var[s_var.n+operand].flag==DEFAULT_VAL)
    1293             :       {
    1294        2114 :         GEN z = gel(st,sp-1);
    1295        2114 :         if (typ(z)==t_CLOSURE)
    1296             :         {
    1297        1001 :           pushlex(operand, closure_evalnobrk(z));
    1298        1001 :           copylex(operand);
    1299             :         }
    1300             :         else
    1301        1113 :           pushlex(operand, z);
    1302             :       }
    1303       11116 :       sp--;
    1304       11116 :       break;
    1305             :     case OClocalvar:
    1306             :       {
    1307          28 :         long n = pari_stack_new(&s_lvars);
    1308          28 :         entree *ep = (entree *)operand;
    1309          28 :         checkvalue(ep, chk_NOCREATE);
    1310          28 :         lvars[n] = ep;
    1311          28 :         nblvar++;
    1312          28 :         pushvalue(ep,gel(st,--sp));
    1313          28 :         break;
    1314             :       }
    1315             :     case OClocalvar0:
    1316             :       {
    1317          14 :         long n = pari_stack_new(&s_lvars);
    1318          14 :         entree *ep = (entree *)operand;
    1319          14 :         checkvalue(ep, chk_NOCREATE);
    1320          14 :         lvars[n] = ep;
    1321          14 :         nblvar++;
    1322          14 :         zerovalue(ep);
    1323          14 :         break;
    1324             :       }
    1325             :     case OCexportvar:
    1326             :       {
    1327           2 :         entree *ep = (entree *)operand;
    1328           2 :         mt_export_add(ep->name, gel(st,--sp));
    1329           2 :         break;
    1330             :       }
    1331             :     case OCunexportvar:
    1332             :       {
    1333           2 :         entree *ep = (entree *)operand;
    1334           2 :         mt_export_del(ep->name);
    1335           2 :         break;
    1336             :       }
    1337             : 
    1338             : #define EVAL_f(f) \
    1339             :   switch (ep->arity) \
    1340             :   { \
    1341             :     case 0: f(); break; \
    1342             :     case 1: sp--; f(st[sp]); break; \
    1343             :     case 2: sp-=2; f(st[sp],st[sp+1]); break; \
    1344             :     case 3: sp-=3; f(st[sp],st[sp+1],st[sp+2]); break; \
    1345             :     case 4: sp-=4; f(st[sp],st[sp+1],st[sp+2],st[sp+3]); break; \
    1346             :     case 5: sp-=5; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4]); break; \
    1347             :     case 6: sp-=6; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5]); break; \
    1348             :     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; \
    1349             :     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; \
    1350             :     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; \
    1351             :     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; \
    1352             :     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; \
    1353             :     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; \
    1354             :     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; \
    1355             :     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; \
    1356             :     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; \
    1357             :     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; \
    1358             :     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; \
    1359             :     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; \
    1360             :     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; \
    1361             :     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; \
    1362             :     default: \
    1363             :       pari_err_IMPL("functions with more than 20 parameters");\
    1364             :       goto endeval; /*LCOV_EXCL_LINE*/ \
    1365             :   }
    1366             : 
    1367             :     case OCcallgen:
    1368             :       {
    1369    81388942 :         entree *ep = (entree *)operand;
    1370             :         GEN res;
    1371             :         /* Macro Madness : evaluate function ep->value on arguments
    1372             :          * st[sp-ep->arity .. sp]. Set res = result. */
    1373    81388942 :         EVAL_f(res = ((GEN (*)(ANYARG))ep->value));
    1374    81374571 :         if (br_status) goto endeval;
    1375    81230689 :         gel(st,sp++)=res;
    1376    81230689 :         break;
    1377             :       }
    1378             :     case OCcallgen2: /*same for ep->arity = 2. Is this optimization worth it ?*/
    1379             :       {
    1380   400957798 :         entree *ep = (entree *)operand;
    1381             :         GEN res;
    1382   400957798 :         sp-=2;
    1383   400957798 :         res = ((GEN (*)(GEN,GEN))ep->value)(gel(st,sp),gel(st,sp+1));
    1384   401117697 :         if (br_status) goto endeval;
    1385   401117669 :         gel(st,sp++)=res;
    1386   401117669 :         break;
    1387             :       }
    1388             :     case OCcalllong:
    1389             :       {
    1390    13239044 :         entree *ep = (entree *)operand;
    1391             :         long res;
    1392    13239044 :         EVAL_f(res = ((long (*)(ANYARG))ep->value));
    1393    13238241 :         if (br_status) goto endeval;
    1394    13238241 :         st[sp++] = res;
    1395    13238241 :         break;
    1396             :       }
    1397             :     case OCcallint:
    1398             :       {
    1399     1694462 :         entree *ep = (entree *)operand;
    1400             :         long res;
    1401     1694462 :         EVAL_f(res = ((int (*)(ANYARG))ep->value));
    1402     1694343 :         if (br_status) goto endeval;
    1403     1694343 :         st[sp++] = res;
    1404     1694343 :         break;
    1405             :       }
    1406             :     case OCcallvoid:
    1407             :       {
    1408    47751373 :         entree *ep = (entree *)operand;
    1409    47751373 :         EVAL_f(((void (*)(ANYARG))ep->value));
    1410    47751000 :         if (br_status) goto endeval;
    1411    47588965 :         break;
    1412             :       }
    1413             : #undef EVAL_f
    1414             : 
    1415             :     case OCcalluser:
    1416             :       {
    1417    34518789 :         long n=operand;
    1418    34518789 :         GEN fun = gel(st,sp-1-n);
    1419             :         long arity, isvar;
    1420             :         GEN z;
    1421    34518789 :         if (typ(fun)!=t_CLOSURE) pari_err(e_NOTFUNC, fun);
    1422    34516066 :         isvar = closure_is_variadic(fun);
    1423    34516067 :         arity = closure_arity(fun);
    1424    34516067 :         if (!isvar || n < arity)
    1425             :         {
    1426    34515997 :           st_alloc(arity-n);
    1427    34515995 :           if (n>arity)
    1428           0 :             pari_err(e_MISC,"too many parameters in user-defined function call");
    1429    34535579 :           for (j=n+1;j<=arity;j++)
    1430       19584 :             gel(st,sp++)=0;
    1431    34515995 :           if (isvar) gel(st,sp-1) = cgetg(1,t_VEC);
    1432             :         }
    1433             :         else
    1434             :         {
    1435             :           GEN v;
    1436          70 :           long j, m = n-arity+1;
    1437          70 :           v = cgetg(m+1,t_VEC);
    1438          70 :           sp-=m;
    1439         301 :           for (j=1; j<=m; j++)
    1440         231 :             gel(v,j) = gel(st,sp+j-1)? gcopy(gel(st,sp+j-1)): gen_0;
    1441          70 :           gel(st,sp++)=v;
    1442             :         }
    1443    34516065 :         z = closure_return(fun);
    1444    34512320 :         if (br_status) goto endeval;
    1445    34512320 :         gel(st, sp-1) = z;
    1446    34512320 :         break;
    1447             :       }
    1448             :     case OCnewframe:
    1449    41608881 :       if (operand>0) nbmvar+=operand;
    1450           2 :       else operand=-operand;
    1451    41608881 :       pari_stack_alloc(&s_var,operand);
    1452    41608881 :       s_var.n+=operand;
    1453   119830058 :       for(j=1;j<=operand;j++)
    1454             :       {
    1455    78221177 :         var[s_var.n-j].flag=PUSH_VAL;
    1456    78221177 :         var[s_var.n-j].value=gen_0;
    1457             :       }
    1458    41608881 :       break;
    1459             :     case OCsaveframe:
    1460             :       {
    1461        4777 :         GEN cl = (operand?gcopy:shallowcopy)(gel(st,sp-1));
    1462        4777 :         long l = lg(gel(cl,7));
    1463        4777 :         GEN  v = cgetg(l, t_VEC);
    1464       69990 :         for(j=1; j<l; j++)
    1465             :         {
    1466       65213 :           GEN val = var[s_var.n-j].value;
    1467       65213 :           gel(v,j) = operand?gcopy(val):val;
    1468             :         }
    1469        4777 :         gel(cl,7) = v;
    1470        4777 :         gel(st,sp-1) = cl;
    1471             :       }
    1472        4777 :       break;
    1473             :     case OCgetargs:
    1474    34610678 :       pari_stack_alloc(&s_var,operand);
    1475    34610653 :       s_var.n+=operand;
    1476    34610653 :       nbmvar+=operand;
    1477    34610653 :       sp-=operand;
    1478    95274108 :       for (j=0;j<operand;j++)
    1479             :       {
    1480    60663447 :         if (gel(st,sp+j))
    1481    60660262 :           pushlex(j-operand,gel(st,sp+j));
    1482             :         else
    1483             :         {
    1484        3185 :           var[s_var.n+j-operand].flag=DEFAULT_VAL;
    1485        3185 :           var[s_var.n+j-operand].value=gen_0;
    1486             :         }
    1487             :       }
    1488    34610661 :       break;
    1489             :     case OCcheckuserargs:
    1490         105 :       for (j=0; j<operand; j++)
    1491          77 :         if (var[s_var.n-operand+j].flag==DEFAULT_VAL)
    1492          21 :           pari_err(e_MISC,"missing mandatory argument"
    1493             :                    " '%s' in user function",get_arg_name(C,j+1));
    1494          28 :       break;
    1495             :     case OCcheckargs:
    1496     6154402 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1497     4909554 :         if ((operand&1L) && gel(st,j)==NULL)
    1498           0 :           pari_err(e_MISC,"missing mandatory argument");
    1499     1244848 :       break;
    1500             :     case OCcheckargs0:
    1501         882 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1502         441 :         if ((operand&1L) && gel(st,j))
    1503           0 :           pari_err(e_MISC,"argument type not implemented");
    1504         441 :       break;
    1505             :     case OCdefaultlong:
    1506       13944 :       sp--;
    1507       13944 :       if (st[sp+operand])
    1508         910 :         st[sp+operand]=gtos(gel(st,sp+operand));
    1509             :       else
    1510       13034 :         st[sp+operand]=st[sp];
    1511       13944 :       break;
    1512             :     case OCdefaultulong:
    1513           0 :       sp--;
    1514           0 :       if (st[sp+operand])
    1515           0 :         st[sp+operand]=gtou(gel(st,sp+operand));
    1516             :       else
    1517           0 :         st[sp+operand]=st[sp];
    1518           0 :       break;
    1519             :     case OCdefaultgen:
    1520           0 :       sp--;
    1521           0 :       if (!st[sp+operand])
    1522           0 :         st[sp+operand]=st[sp];
    1523           0 :       break;
    1524             :     case OCvec:
    1525     9894791 :       gel(st,sp++)=cgetg(operand,t_VEC);
    1526     9894791 :       st[sp++]=avma;
    1527     9894791 :       break;
    1528             :     case OCcol:
    1529        3374 :       gel(st,sp++)=cgetg(operand,t_COL);
    1530        3374 :       st[sp++]=avma;
    1531        3374 :       break;
    1532             :     case OCmat:
    1533             :       {
    1534             :         GEN z;
    1535       54642 :         long l=st[sp-1];
    1536       54642 :         z=cgetg(operand,t_MAT);
    1537      181349 :         for(j=1;j<operand;j++)
    1538      126707 :           gel(z,j) = cgetg(l,t_COL);
    1539       54642 :         gel(st,sp-1) = z;
    1540       54642 :         st[sp++]=avma;
    1541             :       }
    1542       54642 :       break;
    1543             :     case OCpop:
    1544    52238680 :       sp-=operand;
    1545    52238680 :       break;
    1546             :     case OCdup:
    1547             :       {
    1548    31351561 :         long i, s=st[sp-1];
    1549    31351561 :         st_alloc(operand);
    1550    62711781 :         for(i=1;i<=operand;i++)
    1551    31360220 :           st[sp++]=s;
    1552             :       }
    1553    31351561 :       break;
    1554             :     }
    1555             :   }
    1556             :   if (0)
    1557             :   {
    1558             : endeval:
    1559      305945 :     sp = saved_sp;
    1560      611890 :     for(  ; rp>saved_rp ;  )
    1561             :     {
    1562           0 :       gp_pointer *g = &ptrs[--rp];
    1563           0 :       clone_unlock_deep(g->ox);
    1564             :     }
    1565             :   }
    1566   190857034 :   s_prec.n = saved_prec;
    1567   190857034 :   s_trace.n--;
    1568   190857034 :   restore_vars(nbmvar, nblvar);
    1569   190327765 :   clone_unlock(C);
    1570   190266104 : }
    1571             : 
    1572             : GEN
    1573    23141957 : closure_evalgen(GEN C)
    1574             : {
    1575    23141957 :   pari_sp ltop=avma;
    1576    23141957 :   closure_eval(C);
    1577    23107521 :   if (br_status) return gc_NULL(ltop);
    1578    23107463 :   return gerepileupto(ltop,gel(st,--sp));
    1579             : }
    1580             : 
    1581             : void
    1582     1369867 : evalstate_save(struct pari_evalstate *state)
    1583             : {
    1584     1369867 :   state->avma = avma;
    1585     1369867 :   state->sp   = sp;
    1586     1369867 :   state->rp   = rp;
    1587     1369867 :   state->prec = s_prec.n;
    1588     1369867 :   state->var  = s_var.n;
    1589     1369867 :   state->lvars= s_lvars.n;
    1590     1369867 :   state->trace= s_trace.n;
    1591     1369867 :   compilestate_save(&state->comp);
    1592     1369871 :   mtstate_save(&state->mt);
    1593     1369869 : }
    1594             : 
    1595             : void
    1596       43636 : evalstate_restore(struct pari_evalstate *state)
    1597             : {
    1598       43636 :   set_avma(state->avma);
    1599       43636 :   mtstate_restore(&state->mt);
    1600       43636 :   sp = state->sp;
    1601       43636 :   rp = state->rp;
    1602       43636 :   s_prec.n = state->prec;
    1603       43636 :   restore_vars(s_var.n-state->var,s_lvars.n-state->lvars);
    1604       43636 :   restore_trace(s_trace.n-state->trace);
    1605       43636 :   reset_break();
    1606       43636 :   compilestate_restore(&state->comp);
    1607       43636 : }
    1608             : 
    1609             : GEN
    1610       34432 : evalstate_restore_err(struct pari_evalstate *state)
    1611             : {
    1612       34432 :   GENbin* err = copy_bin(pari_err_last());
    1613       34432 :   evalstate_restore(state);
    1614       34432 :   return bin_copy(err);
    1615             : }
    1616             : 
    1617             : void
    1618         291 : evalstate_reset(void)
    1619             : {
    1620         291 :   mtstate_reset();
    1621         291 :   sp = 0;
    1622         291 :   rp = 0;
    1623         291 :   dbg_level = 0;
    1624         291 :   restore_vars(s_var.n, s_lvars.n);
    1625         291 :   s_trace.n = 0;
    1626         291 :   reset_break();
    1627         291 :   compilestate_reset();
    1628         291 :   parsestate_reset();
    1629         291 :   set_avma(pari_mainstack->top);
    1630         291 : }
    1631             : 
    1632             : void
    1633           0 : evalstate_clone(void)
    1634             : {
    1635             :   long i;
    1636           0 :   for (i = 1; i<=s_var.n; i++) copylex(-i);
    1637           0 :   lvar_make_safe();
    1638           0 :   for (i = 0; i< s_trace.n; i++)
    1639             :   {
    1640           0 :     GEN C = trace[i].closure;
    1641           0 :     if (isonstack(C)) trace[i].closure = gclone(C);
    1642             :   }
    1643           0 : }
    1644             : 
    1645             : GEN
    1646          21 : closure_trapgen(GEN C, long numerr)
    1647             : {
    1648             :   VOLATILE GEN x;
    1649             :   struct pari_evalstate state;
    1650          21 :   evalstate_save(&state);
    1651          21 :   pari_CATCH(numerr) { x = (GEN)1L; }
    1652          21 :   pari_TRY { x = closure_evalgen(C); } pari_ENDCATCH;
    1653          14 :   if (x == (GEN)1L) evalstate_restore(&state);
    1654          14 :   return x;
    1655             : }
    1656             : 
    1657             : GEN
    1658    32669425 : closure_evalnobrk(GEN C)
    1659             : {
    1660    32669425 :   pari_sp ltop=avma;
    1661    32669425 :   closure_eval(C);
    1662    32669418 :   if (br_status) pari_err(e_MISC, "break not allowed here");
    1663    32669411 :   return gerepileupto(ltop,gel(st,--sp));
    1664             : }
    1665             : 
    1666             : void
    1667    98580872 : closure_evalvoid(GEN C)
    1668             : {
    1669    98580872 :   pari_sp ltop=avma;
    1670    98580872 :   closure_eval(C);
    1671    98532845 :   set_avma(ltop);
    1672    98514645 : }
    1673             : 
    1674             : GEN
    1675       96264 : closure_evalres(GEN C)
    1676             : {
    1677       96264 :   return closure_return(C);
    1678             : }
    1679             : 
    1680             : INLINE GEN
    1681     1345007 : closure_returnupto(GEN C)
    1682             : {
    1683     1345007 :   pari_sp av=avma;
    1684     1345007 :   return copyupto(closure_return(C),(GEN)av);
    1685             : }
    1686             : 
    1687             : GEN
    1688           4 : pareval_worker(GEN C)
    1689             : {
    1690           4 :   return closure_callgenall(C, 0);
    1691             : }
    1692             : 
    1693             : GEN
    1694           2 : pareval(GEN C)
    1695             : {
    1696           2 :   pari_sp av = avma;
    1697           2 :   long l = lg(C), i;
    1698             :   GEN worker;
    1699           2 :   if (!is_vec_t(typ(C))) pari_err_TYPE("pareval",C);
    1700           6 :   for (i=1; i<l; i++)
    1701           4 :     if (typ(gel(C,i))!=t_CLOSURE)
    1702           0 :       pari_err_TYPE("pareval",gel(C,i));
    1703           2 :   worker = snm_closure(is_entry("_pareval_worker"), NULL);
    1704           2 :   return gerepileupto(av, gen_parapply(worker, C));
    1705             : }
    1706             : 
    1707             : GEN
    1708       20382 : parvector_worker(GEN i, GEN C)
    1709             : {
    1710       20382 :   return closure_callgen1(C, i);
    1711             : }
    1712             : 
    1713             : GEN
    1714        3017 : parfor_worker(GEN i, GEN C)
    1715             : {
    1716        3017 :   retmkvec2(gcopy(i), closure_callgen1(C, i));
    1717             : }
    1718             : 
    1719             : GEN
    1720           4 : parvector(long n, GEN code)
    1721             : {
    1722           4 :   long i, pending = 0, workid;
    1723           4 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1724             :   GEN a, V, done;
    1725             :   struct pari_mt pt;
    1726           4 :   mt_queue_start_lim(&pt, worker, n);
    1727           4 :   a = mkvec(cgetipos(3)); /* left on the stack */
    1728           4 :   V = cgetg(n+1, t_VEC);
    1729         227 :   for (i=1; i<=n || pending; i++)
    1730             :   {
    1731         225 :     mael(a,1,2) = i;
    1732         225 :     mt_queue_submit(&pt, i, i<=n? a: NULL);
    1733         225 :     done = mt_queue_get(&pt, &workid, &pending);
    1734         223 :     if (done) gel(V,workid) = done;
    1735             :   }
    1736           2 :   mt_queue_end(&pt);
    1737           2 :   return V;
    1738             : }
    1739             : 
    1740             : GEN
    1741           4 : parsum(GEN a, GEN b, GEN code, GEN x)
    1742             : {
    1743           4 :   pari_sp av = avma, av2;
    1744           4 :   long pending = 0;
    1745           4 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1746             :   GEN done;
    1747             :   struct pari_mt pt;
    1748           4 :   if (typ(a) != t_INT) pari_err_TYPE("parsum",a);
    1749           4 :   if (!x) x = gen_0;
    1750           4 :   if (gcmp(b,a) < 0) return gcopy(x);
    1751             : 
    1752           4 :   mt_queue_start(&pt, worker);
    1753           4 :   b = gfloor(b);
    1754           4 :   a = mkvec(setloop(a));
    1755           4 :   av2=avma;
    1756       20328 :   for (; cmpii(gel(a,1),b) <= 0 || pending; gel(a,1) = incloop(gel(a,1)))
    1757             :   {
    1758       20324 :     mt_queue_submit(&pt, 0, cmpii(gel(a,1),b) <= 0? a: NULL);
    1759       20324 :     done = mt_queue_get(&pt, NULL, &pending);
    1760       20324 :     if (done)
    1761             :     {
    1762       20200 :       x = gadd(x, done);
    1763       20200 :       if (gc_needed(av2,1))
    1764             :       {
    1765           0 :         if (DEBUGMEM>1) pari_warn(warnmem,"sum");
    1766           0 :         x = gerepileupto(av2,x);
    1767             :       }
    1768             :     }
    1769             :   }
    1770           4 :   mt_queue_end(&pt);
    1771           4 :   return gerepilecopy(av, x);
    1772             : }
    1773             : 
    1774             : void
    1775          45 : parfor(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1776             : {
    1777          45 :   pari_sp av = avma, av2;
    1778          45 :   long running, pending = 0;
    1779          45 :   long status = br_NONE;
    1780          45 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1781          45 :   GEN done, stop = NULL;
    1782             :   struct pari_mt pt;
    1783          45 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1784          45 :   if (b)
    1785             :   {
    1786          45 :     if (gcmp(b,a) < 0) return;
    1787          45 :     if (typ(b) == t_INFINITY)
    1788             :     {
    1789           2 :       if (inf_get_sign(b) < 0) return;
    1790           2 :       b = NULL;
    1791             :     }
    1792             :     else
    1793          43 :       b = gfloor(b);
    1794             :   }
    1795          45 :   mt_queue_start(&pt, worker);
    1796          45 :   a = mkvec(setloop(a));
    1797          45 :   av2 = avma;
    1798        3646 :   while ((running = (!stop && (!b || cmpii(gel(a,1),b) <= 0))) || pending)
    1799             :   {
    1800        3558 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1801        3558 :     done = mt_queue_get(&pt, NULL, &pending);
    1802        3556 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1803        2439 :       if (call(E, gel(done,1), gel(done,2)))
    1804             :       {
    1805          14 :         status = br_status;
    1806          14 :         br_status = br_NONE;
    1807          14 :         stop = gerepileuptoint(av2, gel(done,1));
    1808             :       }
    1809        3556 :     gel(a,1) = incloop(gel(a,1));
    1810        3556 :     if (!stop) set_avma(av2);
    1811             :   }
    1812          43 :   set_avma(av2);
    1813          43 :   mt_queue_end(&pt);
    1814          43 :   br_status = status;
    1815          43 :   set_avma(av);
    1816             : }
    1817             : 
    1818             : static long
    1819        2513 : gp_evalvoid2(void *E, GEN x, GEN y)
    1820             : {
    1821        2513 :   GEN code =(GEN) E;
    1822        2513 :   push_lex(x, code);
    1823        2513 :   push_lex(y, NULL);
    1824        2513 :   closure_evalvoid(code);
    1825        2513 :   pop_lex(2);
    1826        2513 :   return loop_break();
    1827             : }
    1828             : 
    1829             : void
    1830          45 : parfor0(GEN a, GEN b, GEN code, GEN code2)
    1831             : {
    1832          45 :   parfor(a, b, code, (void*)code2, code2 ? gp_evalvoid2: NULL);
    1833          43 : }
    1834             : 
    1835             : void
    1836           2 : parforprime(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1837             : {
    1838           2 :   pari_sp av = avma, av2;
    1839           2 :   long running, pending = 0;
    1840           2 :   long status = br_NONE;
    1841           2 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1842           2 :   GEN v, done, stop = NULL;
    1843             :   struct pari_mt pt;
    1844             :   forprime_t T;
    1845             : 
    1846           2 :   if (!forprime_init(&T, a,b)) { set_avma(av); return; }
    1847           2 :   mt_queue_start(&pt, worker);
    1848           2 :   v = mkvec(gen_0);
    1849           2 :   av2 = avma;
    1850          36 :   while ((running = (!stop && forprime_next(&T))) || pending)
    1851             :   {
    1852          32 :     gel(v, 1) = T.pp;
    1853          32 :     mt_queue_submit(&pt, 0, running ? v: NULL);
    1854          32 :     done = mt_queue_get(&pt, NULL, &pending);
    1855          32 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1856          16 :       if (call(E, gel(done,1), gel(done,2)))
    1857             :       {
    1858           0 :         status = br_status;
    1859           0 :         br_status = br_NONE;
    1860           0 :         stop = gerepileuptoint(av2, gel(done,1));
    1861             :       }
    1862          32 :     if (!stop) set_avma(av2);
    1863             :   }
    1864           2 :   set_avma(av2);
    1865           2 :   mt_queue_end(&pt);
    1866           2 :   br_status = status;
    1867           2 :   set_avma(av);
    1868             : }
    1869             : 
    1870             : void
    1871           2 : parforprime0(GEN a, GEN b, GEN code, GEN code2)
    1872             : {
    1873           2 :   parforprime(a, b, code, (void*)code2, code2? gp_evalvoid2: NULL);
    1874           2 : }
    1875             : 
    1876             : void
    1877           6 : parforvec(GEN x, GEN code, long flag, void *E, long call(void*, GEN, GEN))
    1878             : {
    1879           6 :   pari_sp av = avma, av2;
    1880           6 :   long running, pending = 0;
    1881           6 :   long status = br_NONE;
    1882           6 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1883           6 :   GEN done, stop = NULL;
    1884             :   struct pari_mt pt;
    1885             :   forvec_t T;
    1886           6 :   GEN a, v = gen_0;
    1887             : 
    1888           6 :   if (!forvec_init(&T, x, flag)) { set_avma(av); return; }
    1889           6 :   mt_queue_start(&pt, worker);
    1890           6 :   a = mkvec(gen_0);
    1891           6 :   av2 = avma;
    1892         128 :   while ((running = (!stop && v && (v = forvec_next(&T)))) || pending)
    1893             :   {
    1894         116 :     gel(a, 1) = v;
    1895         116 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1896         116 :     done = mt_queue_get(&pt, NULL, &pending);
    1897         116 :     if (call && done && (!stop || lexcmp(gel(done,1),stop) < 0))
    1898          58 :       if (call(E, gel(done,1), gel(done,2)))
    1899             :       {
    1900           0 :         status = br_status;
    1901           0 :         br_status = br_NONE;
    1902           0 :         stop = gerepilecopy(av2, gel(done,1));
    1903             :       }
    1904         116 :     if (!stop) set_avma(av2);
    1905             :   }
    1906           6 :   set_avma(av2);
    1907           6 :   mt_queue_end(&pt);
    1908           6 :   br_status = status;
    1909           6 :   set_avma(av);
    1910             : }
    1911             : 
    1912             : void
    1913           6 : parforvec0(GEN x, GEN code, GEN code2, long flag)
    1914             : {
    1915           6 :   parforvec(x, code, flag, (void*)code2, code2? gp_evalvoid2: NULL);
    1916           6 : }
    1917             : 
    1918             : void
    1919           0 : closure_callvoid1(GEN C, GEN x)
    1920             : {
    1921           0 :   long i, ar = closure_arity(C);
    1922           0 :   gel(st,sp++) = x;
    1923           0 :   for(i=2; i <= ar; i++) gel(st,sp++) = NULL;
    1924           0 :   closure_evalvoid(C);
    1925           0 : }
    1926             : 
    1927             : GEN
    1928      221115 : closure_callgen1(GEN C, GEN x)
    1929             : {
    1930      221115 :   long i, ar = closure_arity(C);
    1931      221110 :   gel(st,sp++) = x;
    1932      221110 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    1933      221110 :   return closure_returnupto(C);
    1934             : }
    1935             : 
    1936             : GEN
    1937       60616 : closure_callgen1prec(GEN C, GEN x, long prec)
    1938             : {
    1939             :   GEN z;
    1940       60616 :   long i, ar = closure_arity(C);
    1941       60616 :   gel(st,sp++) = x;
    1942       60616 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    1943       60616 :   push_localprec(prec);
    1944       60616 :   z = closure_returnupto(C);
    1945       60616 :   pop_localprec();
    1946       60616 :   return z;
    1947             : }
    1948             : 
    1949             : GEN
    1950       89929 : closure_callgen2(GEN C, GEN x, GEN y)
    1951             : {
    1952       89929 :   long i, ar = closure_arity(C);
    1953       89929 :   st_alloc(ar);
    1954       89929 :   gel(st,sp++) = x;
    1955       89929 :   gel(st,sp++) = y;
    1956       89929 :   for(i=3; i<=ar; i++) gel(st,sp++) = NULL;
    1957       89929 :   return closure_returnupto(C);
    1958             : }
    1959             : 
    1960             : GEN
    1961      973576 : closure_callgenvec(GEN C, GEN args)
    1962             : {
    1963      973576 :   long i, l = lg(args)-1, ar = closure_arity(C);
    1964      973564 :   st_alloc(ar);
    1965      973533 :   if (l > ar)
    1966           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    1967      973533 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    1968           7 :     pari_err_TYPE("call", gel(args,l));
    1969      973498 :   for (i = 1; i <= l;  i++) gel(st,sp++) = gel(args,i);
    1970      973498 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    1971      973498 :   return closure_returnupto(C);
    1972             : }
    1973             : 
    1974             : GEN
    1975         147 : closure_callgenvecprec(GEN C, GEN args, long prec)
    1976             : {
    1977             :   GEN z;
    1978         147 :   push_localprec(prec);
    1979         147 :   z = closure_callgenvec(C, args);
    1980         147 :   pop_localprec();
    1981         147 :   return z;
    1982             : }
    1983             : 
    1984             : GEN
    1985           4 : closure_callgenall(GEN C, long n, ...)
    1986             : {
    1987             :   va_list ap;
    1988           4 :   long i, ar = closure_arity(C);
    1989           4 :   va_start(ap,n);
    1990           4 :   if (n > ar)
    1991           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    1992           4 :   st_alloc(ar);
    1993           4 :   for (i = 1; i <=n;  i++) gel(st,sp++) = va_arg(ap, GEN);
    1994           4 :   for(      ; i <=ar; i++) gel(st,sp++) = NULL;
    1995           4 :   va_end(ap);
    1996           4 :   return closure_returnupto(C);
    1997             : }
    1998             : 
    1999             : GEN
    2000     7690433 : gp_eval(void *E, GEN x)
    2001             : {
    2002     7690433 :   GEN code = (GEN)E;
    2003     7690433 :   set_lex(-1,x);
    2004     7690433 :   return closure_evalnobrk(code);
    2005             : }
    2006             : 
    2007             : GEN
    2008      577514 : gp_evalupto(void *E, GEN x)
    2009             : {
    2010      577514 :   pari_sp av = avma;
    2011      577514 :   return copyupto(gp_eval(E,x), (GEN)av);
    2012             : }
    2013             : 
    2014             : GEN
    2015       19145 : gp_evalprec(void *E, GEN x, long prec)
    2016             : {
    2017             :   GEN z;
    2018       19145 :   push_localprec(prec);
    2019       19145 :   z = gp_eval(E, x);
    2020       19145 :   pop_localprec();
    2021       19145 :   return z;
    2022             : }
    2023             : 
    2024             : long
    2025      167832 : gp_evalbool(void *E, GEN x)
    2026      167832 : { pari_sp av = avma; return gc_long(av, !gequal0(gp_eval(E,x))); }
    2027             : 
    2028             : long
    2029     3654644 : gp_evalvoid(void *E, GEN x)
    2030             : {
    2031     3654644 :   GEN code = (GEN)E;
    2032     3654644 :   set_lex(-1,x);
    2033     3654644 :   closure_evalvoid(code);
    2034     3654644 :   return loop_break();
    2035             : }
    2036             : 
    2037             : GEN
    2038       19187 : gp_call(void *E, GEN x)
    2039             : {
    2040       19187 :   GEN code = (GEN)E;
    2041       19187 :   return closure_callgen1(code, x);
    2042             : }
    2043             : 
    2044             : GEN
    2045        7413 : gp_callprec(void *E, GEN x, long prec)
    2046             : {
    2047        7413 :   GEN code = (GEN)E;
    2048        7413 :   return closure_callgen1prec(code, x, prec);
    2049             : }
    2050             : 
    2051             : GEN
    2052          91 : gp_call2(void *E, GEN x, GEN y)
    2053             : {
    2054          91 :   GEN code = (GEN)E;
    2055          91 :   return closure_callgen2(code, x, y);
    2056             : }
    2057             : 
    2058             : long
    2059         672 : gp_callbool(void *E, GEN x)
    2060             : {
    2061         672 :   pari_sp av = avma;
    2062         672 :   GEN code = (GEN)E;
    2063         672 :   return gc_long(av, !gequal0(closure_callgen1(code, x)));
    2064             : }
    2065             : 
    2066             : long
    2067           0 : gp_callvoid(void *E, GEN x)
    2068             : {
    2069           0 :   GEN code = (GEN)E;
    2070           0 :   closure_callvoid1(code, x);
    2071           0 :   return loop_break();
    2072             : }
    2073             : 
    2074             : INLINE const char *
    2075           0 : disassemble_cast(long mode)
    2076             : {
    2077           0 :   switch (mode)
    2078             :   {
    2079             :   case Gsmall:
    2080           0 :     return "small";
    2081             :   case Ggen:
    2082           0 :     return "gen";
    2083             :   case Gvar:
    2084           0 :     return "var";
    2085             :   case Gvoid:
    2086           0 :     return "void";
    2087             :   default:
    2088           0 :     return "unknown";
    2089             :   }
    2090             : }
    2091             : 
    2092             : void
    2093           0 : closure_disassemble(GEN C)
    2094             : {
    2095             :   const char * code;
    2096             :   GEN oper;
    2097             :   long i;
    2098           0 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("disassemble",C);
    2099           0 :   code=closure_codestr(C);
    2100           0 :   oper=closure_get_oper(C);
    2101           0 :   for(i=1;i<lg(oper);i++)
    2102             :   {
    2103           0 :     op_code opcode=(op_code) code[i];
    2104           0 :     long operand=oper[i];
    2105           0 :     pari_printf("%05ld\t",i);
    2106           0 :     switch(opcode)
    2107             :     {
    2108             :     case OCpushlong:
    2109           0 :       pari_printf("pushlong\t%ld\n",operand);
    2110           0 :       break;
    2111             :     case OCpushgnil:
    2112           0 :       pari_printf("pushgnil\n");
    2113           0 :       break;
    2114             :     case OCpushgen:
    2115           0 :       pari_printf("pushgen\t\t%ld\n",operand);
    2116           0 :       break;
    2117             :     case OCpushreal:
    2118           0 :       pari_printf("pushreal\t%ld\n",operand);
    2119           0 :       break;
    2120             :     case OCpushstoi:
    2121           0 :       pari_printf("pushstoi\t%ld\n",operand);
    2122           0 :       break;
    2123             :     case OCpushvar:
    2124             :       {
    2125           0 :         entree *ep = (entree *)operand;
    2126           0 :         pari_printf("pushvar\t%s\n",ep->name);
    2127           0 :         break;
    2128             :       }
    2129             :     case OCpushdyn:
    2130             :       {
    2131           0 :         entree *ep = (entree *)operand;
    2132           0 :         pari_printf("pushdyn\t\t%s\n",ep->name);
    2133           0 :         break;
    2134             :       }
    2135             :     case OCpushlex:
    2136           0 :       pari_printf("pushlex\t\t%ld\n",operand);
    2137           0 :       break;
    2138             :     case OCstoredyn:
    2139             :       {
    2140           0 :         entree *ep = (entree *)operand;
    2141           0 :         pari_printf("storedyn\t%s\n",ep->name);
    2142           0 :         break;
    2143             :       }
    2144             :     case OCstorelex:
    2145           0 :       pari_printf("storelex\t%ld\n",operand);
    2146           0 :       break;
    2147             :     case OCstoreptr:
    2148           0 :       pari_printf("storeptr\n");
    2149           0 :       break;
    2150             :     case OCsimpleptrdyn:
    2151             :       {
    2152           0 :         entree *ep = (entree *)operand;
    2153           0 :         pari_printf("simpleptrdyn\t%s\n",ep->name);
    2154           0 :         break;
    2155             :       }
    2156             :     case OCsimpleptrlex:
    2157           0 :       pari_printf("simpleptrlex\t%ld\n",operand);
    2158           0 :       break;
    2159             :     case OCnewptrdyn:
    2160             :       {
    2161           0 :         entree *ep = (entree *)operand;
    2162           0 :         pari_printf("newptrdyn\t%s\n",ep->name);
    2163           0 :         break;
    2164             :       }
    2165             :     case OCnewptrlex:
    2166           0 :       pari_printf("newptrlex\t%ld\n",operand);
    2167           0 :       break;
    2168             :     case OCpushptr:
    2169           0 :       pari_printf("pushptr\n");
    2170           0 :       break;
    2171             :     case OCstackgen:
    2172           0 :       pari_printf("stackgen\t%ld\n",operand);
    2173           0 :       break;
    2174             :     case OCendptr:
    2175           0 :       pari_printf("endptr\t\t%ld\n",operand);
    2176           0 :       break;
    2177             :     case OCprecreal:
    2178           0 :       pari_printf("precreal\n");
    2179           0 :       break;
    2180             :     case OCbitprecreal:
    2181           0 :       pari_printf("bitprecreal\n");
    2182           0 :       break;
    2183             :     case OCprecdl:
    2184           0 :       pari_printf("precdl\n");
    2185           0 :       break;
    2186             :     case OCstoi:
    2187           0 :       pari_printf("stoi\n");
    2188           0 :       break;
    2189             :     case OCutoi:
    2190           0 :       pari_printf("utoi\n");
    2191           0 :       break;
    2192             :     case OCitos:
    2193           0 :       pari_printf("itos\t\t%ld\n",operand);
    2194           0 :       break;
    2195             :     case OCitou:
    2196           0 :       pari_printf("itou\t\t%ld\n",operand);
    2197           0 :       break;
    2198             :     case OCtostr:
    2199           0 :       pari_printf("tostr\t\t%ld\n",operand);
    2200           0 :       break;
    2201             :     case OCvarn:
    2202           0 :       pari_printf("varn\t\t%ld\n",operand);
    2203           0 :       break;
    2204             :     case OCcopy:
    2205           0 :       pari_printf("copy\n");
    2206           0 :       break;
    2207             :     case OCcopyifclone:
    2208           0 :       pari_printf("copyifclone\n");
    2209           0 :       break;
    2210             :     case OCcompo1:
    2211           0 :       pari_printf("compo1\t\t%s\n",disassemble_cast(operand));
    2212           0 :       break;
    2213             :     case OCcompo1ptr:
    2214           0 :       pari_printf("compo1ptr\n");
    2215           0 :       break;
    2216             :     case OCcompo2:
    2217           0 :       pari_printf("compo2\t\t%s\n",disassemble_cast(operand));
    2218           0 :       break;
    2219             :     case OCcompo2ptr:
    2220           0 :       pari_printf("compo2ptr\n");
    2221           0 :       break;
    2222             :     case OCcompoC:
    2223           0 :       pari_printf("compoC\n");
    2224           0 :       break;
    2225             :     case OCcompoCptr:
    2226           0 :       pari_printf("compoCptr\n");
    2227           0 :       break;
    2228             :     case OCcompoL:
    2229           0 :       pari_printf("compoL\n");
    2230           0 :       break;
    2231             :     case OCcompoLptr:
    2232           0 :       pari_printf("compoLptr\n");
    2233           0 :       break;
    2234             :     case OCcheckargs:
    2235           0 :       pari_printf("checkargs\t0x%lx\n",operand);
    2236           0 :       break;
    2237             :     case OCcheckargs0:
    2238           0 :       pari_printf("checkargs0\t0x%lx\n",operand);
    2239           0 :       break;
    2240             :     case OCcheckuserargs:
    2241           0 :       pari_printf("checkuserargs\t%ld\n",operand);
    2242           0 :       break;
    2243             :     case OCdefaultlong:
    2244           0 :       pari_printf("defaultlong\t%ld\n",operand);
    2245           0 :       break;
    2246             :     case OCdefaultulong:
    2247           0 :       pari_printf("defaultulong\t%ld\n",operand);
    2248           0 :       break;
    2249             :     case OCdefaultgen:
    2250           0 :       pari_printf("defaultgen\t%ld\n",operand);
    2251           0 :       break;
    2252             :     case OCgetargs:
    2253           0 :       pari_printf("getargs\t\t%ld\n",operand);
    2254           0 :       break;
    2255             :     case OCdefaultarg:
    2256           0 :       pari_printf("defaultarg\t%ld\n",operand);
    2257           0 :       break;
    2258             :     case OClocalvar:
    2259             :       {
    2260           0 :         entree *ep = (entree *)operand;
    2261           0 :         pari_printf("localvar\t%s\n",ep->name);
    2262           0 :         break;
    2263             :       }
    2264             :     case OClocalvar0:
    2265             :       {
    2266           0 :         entree *ep = (entree *)operand;
    2267           0 :         pari_printf("localvar0\t%s\n",ep->name);
    2268           0 :         break;
    2269             :       }
    2270             :     case OCexportvar:
    2271             :       {
    2272           0 :         entree *ep = (entree *)operand;
    2273           0 :         pari_printf("exportvar\t%s\n",ep->name);
    2274           0 :         break;
    2275             :       }
    2276             :     case OCunexportvar:
    2277             :       {
    2278           0 :         entree *ep = (entree *)operand;
    2279           0 :         pari_printf("unexportvar\t%s\n",ep->name);
    2280           0 :         break;
    2281             :       }
    2282             :     case OCcallgen:
    2283             :       {
    2284           0 :         entree *ep = (entree *)operand;
    2285           0 :         pari_printf("callgen\t\t%s\n",ep->name);
    2286           0 :         break;
    2287             :       }
    2288             :     case OCcallgen2:
    2289             :       {
    2290           0 :         entree *ep = (entree *)operand;
    2291           0 :         pari_printf("callgen2\t%s\n",ep->name);
    2292           0 :         break;
    2293             :       }
    2294             :     case OCcalllong:
    2295             :       {
    2296           0 :         entree *ep = (entree *)operand;
    2297           0 :         pari_printf("calllong\t%s\n",ep->name);
    2298           0 :         break;
    2299             :       }
    2300             :     case OCcallint:
    2301             :       {
    2302           0 :         entree *ep = (entree *)operand;
    2303           0 :         pari_printf("callint\t\t%s\n",ep->name);
    2304           0 :         break;
    2305             :       }
    2306             :     case OCcallvoid:
    2307             :       {
    2308           0 :         entree *ep = (entree *)operand;
    2309           0 :         pari_printf("callvoid\t%s\n",ep->name);
    2310           0 :         break;
    2311             :       }
    2312             :     case OCcalluser:
    2313           0 :       pari_printf("calluser\t%ld\n",operand);
    2314           0 :       break;
    2315             :     case OCvec:
    2316           0 :       pari_printf("vec\t\t%ld\n",operand);
    2317           0 :       break;
    2318             :     case OCcol:
    2319           0 :       pari_printf("col\t\t%ld\n",operand);
    2320           0 :       break;
    2321             :     case OCmat:
    2322           0 :       pari_printf("mat\t\t%ld\n",operand);
    2323           0 :       break;
    2324             :     case OCnewframe:
    2325           0 :       pari_printf("newframe\t%ld\n",operand);
    2326           0 :       break;
    2327             :     case OCsaveframe:
    2328           0 :       pari_printf("saveframe\t%ld\n", operand);
    2329           0 :       break;
    2330             :     case OCpop:
    2331           0 :       pari_printf("pop\t\t%ld\n",operand);
    2332           0 :       break;
    2333             :     case OCdup:
    2334           0 :       pari_printf("dup\t\t%ld\n",operand);
    2335           0 :       break;
    2336             :     case OCavma:
    2337           0 :       pari_printf("avma\n",operand);
    2338           0 :       break;
    2339             :     case OCgerepile:
    2340           0 :       pari_printf("gerepile\n",operand);
    2341           0 :       break;
    2342             :     case OCcowvardyn:
    2343             :       {
    2344           0 :         entree *ep = (entree *)operand;
    2345           0 :         pari_printf("cowvardyn\t%s\n",ep->name);
    2346           0 :         break;
    2347             :       }
    2348             :     case OCcowvarlex:
    2349           0 :       pari_printf("cowvarlex\t%ld\n",operand);
    2350           0 :       break;
    2351             :     }
    2352             :   }
    2353           0 : }
    2354             : 
    2355             : static int
    2356           0 : opcode_need_relink(op_code opcode)
    2357             : {
    2358           0 :   switch(opcode)
    2359             :   {
    2360             :   case OCpushlong:
    2361             :   case OCpushgen:
    2362             :   case OCpushgnil:
    2363             :   case OCpushreal:
    2364             :   case OCpushstoi:
    2365             :   case OCpushlex:
    2366             :   case OCstorelex:
    2367             :   case OCstoreptr:
    2368             :   case OCsimpleptrlex:
    2369             :   case OCnewptrlex:
    2370             :   case OCpushptr:
    2371             :   case OCstackgen:
    2372             :   case OCendptr:
    2373             :   case OCprecreal:
    2374             :   case OCbitprecreal:
    2375             :   case OCprecdl:
    2376             :   case OCstoi:
    2377             :   case OCutoi:
    2378             :   case OCitos:
    2379             :   case OCitou:
    2380             :   case OCtostr:
    2381             :   case OCvarn:
    2382             :   case OCcopy:
    2383             :   case OCcopyifclone:
    2384             :   case OCcompo1:
    2385             :   case OCcompo1ptr:
    2386             :   case OCcompo2:
    2387             :   case OCcompo2ptr:
    2388             :   case OCcompoC:
    2389             :   case OCcompoCptr:
    2390             :   case OCcompoL:
    2391             :   case OCcompoLptr:
    2392             :   case OCcheckargs:
    2393             :   case OCcheckargs0:
    2394             :   case OCcheckuserargs:
    2395             :   case OCgetargs:
    2396             :   case OCdefaultarg:
    2397             :   case OCdefaultgen:
    2398             :   case OCdefaultlong:
    2399             :   case OCdefaultulong:
    2400             :   case OCcalluser:
    2401             :   case OCvec:
    2402             :   case OCcol:
    2403             :   case OCmat:
    2404             :   case OCnewframe:
    2405             :   case OCsaveframe:
    2406             :   case OCdup:
    2407             :   case OCpop:
    2408             :   case OCavma:
    2409             :   case OCgerepile:
    2410             :   case OCcowvarlex:
    2411           0 :     break;
    2412             :   case OCpushvar:
    2413             :   case OCpushdyn:
    2414             :   case OCstoredyn:
    2415             :   case OCsimpleptrdyn:
    2416             :   case OCnewptrdyn:
    2417             :   case OClocalvar:
    2418             :   case OClocalvar0:
    2419             :   case OCexportvar:
    2420             :   case OCunexportvar:
    2421             :   case OCcallgen:
    2422             :   case OCcallgen2:
    2423             :   case OCcalllong:
    2424             :   case OCcallint:
    2425             :   case OCcallvoid:
    2426             :   case OCcowvardyn:
    2427           0 :     return 1;
    2428             :   }
    2429           0 :   return 0;
    2430             : }
    2431             : 
    2432             : static void
    2433           0 : closure_relink(GEN C, hashtable *table)
    2434             : {
    2435           0 :   const char *code = closure_codestr(C);
    2436           0 :   GEN oper = closure_get_oper(C);
    2437           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2438             :   long i, j;
    2439           0 :   for(i=1;i<lg(oper);i++)
    2440           0 :     if (oper[i] && opcode_need_relink((op_code)code[i]))
    2441           0 :       oper[i] = (long) hash_search(table,(void*) oper[i])->val;
    2442           0 :   for (i=1;i<lg(fram);i++)
    2443           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2444           0 :       if (mael(fram,i,j))
    2445           0 :         mael(fram,i,j) = (long) hash_search(table,(void*) mael(fram,i,j))->val;
    2446           0 : }
    2447             : 
    2448             : void
    2449           0 : gen_relink(GEN x, hashtable *table)
    2450             : {
    2451           0 :   long i, lx, tx = typ(x);
    2452           0 :   switch(tx)
    2453             :   {
    2454             :     case t_CLOSURE:
    2455           0 :       closure_relink(x, table);
    2456           0 :       gen_relink(closure_get_data(x), table);
    2457           0 :       if (lg(x)==8) gen_relink(closure_get_frame(x), table);
    2458           0 :       break;
    2459             :     case t_LIST:
    2460           0 :       if (list_data(x)) gen_relink(list_data(x), table);
    2461           0 :       break;
    2462             :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2463           0 :       lx = lg(x);
    2464           0 :       for (i=lontyp[tx]; i<lx; i++) gen_relink(gel(x,i), table);
    2465             :   }
    2466           0 : }
    2467             : 
    2468             : static void
    2469           0 : closure_unlink(GEN C)
    2470             : {
    2471           0 :   const char *code = closure_codestr(C);
    2472           0 :   GEN oper = closure_get_oper(C);
    2473           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2474             :   long i, j;
    2475           0 :   for(i=1;i<lg(oper);i++)
    2476           0 :     if (oper[i] && opcode_need_relink((op_code) code[i]))
    2477             :     {
    2478           0 :       long n = pari_stack_new(&s_relocs);
    2479           0 :       relocs[n] = (entree *) oper[i];
    2480             :     }
    2481           0 :   for (i=1;i<lg(fram);i++)
    2482           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2483           0 :       if (mael(fram,i,j))
    2484             :       {
    2485           0 :         long n = pari_stack_new(&s_relocs);
    2486           0 :         relocs[n] = (entree *) mael(fram,i,j);
    2487             :       }
    2488           0 : }
    2489             : 
    2490             : static void
    2491           0 : gen_unlink(GEN x)
    2492             : {
    2493           0 :   long i, lx, tx = typ(x);
    2494           0 :   switch(tx)
    2495             :   {
    2496             :     case t_CLOSURE:
    2497           0 :       closure_unlink(x);
    2498           0 :       gen_unlink(closure_get_data(x));
    2499           0 :       if (lg(x)==8) gen_unlink(closure_get_frame(x));
    2500           0 :       break;
    2501             :     case t_LIST:
    2502           0 :       if (list_data(x)) gen_unlink(list_data(x));
    2503           0 :       break;
    2504             :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2505           0 :       lx = lg(x);
    2506           0 :       for (i = lontyp[tx]; i<lx; i++) gen_unlink(gel(x,i));
    2507             :   }
    2508           0 : }
    2509             : 
    2510             : GEN
    2511           0 : copybin_unlink(GEN C)
    2512             : {
    2513           0 :   long i, l , n, nold = s_relocs.n;
    2514             :   GEN v, w, V, res;
    2515           0 :   if (C)
    2516           0 :     gen_unlink(C);
    2517             :   else
    2518             :   { /* contents of all variables */
    2519           0 :     long v, maxv = pari_var_next();
    2520           0 :     for (v=0; v<maxv; v++)
    2521             :     {
    2522           0 :       entree *ep = varentries[v];
    2523           0 :       if (!ep || !ep->value) continue;
    2524           0 :       gen_unlink((GEN)ep->value);
    2525             :     }
    2526             :   }
    2527           0 :   n = s_relocs.n-nold;
    2528           0 :   v = cgetg(n+1, t_VECSMALL);
    2529           0 :   for(i=0; i<n; i++)
    2530           0 :     v[i+1] = (long) relocs[i];
    2531           0 :   s_relocs.n = nold;
    2532           0 :   w = vecsmall_uniq(v); l = lg(w);
    2533           0 :   res = cgetg(3,t_VEC);
    2534           0 :   V = cgetg(l, t_VEC);
    2535           0 :   for(i=1; i<l; i++)
    2536             :   {
    2537           0 :     entree *ep = (entree*) w[i];
    2538           0 :     gel(V,i) = strtoGENstr(ep->name);
    2539             :   }
    2540           0 :   gel(res,1) = vecsmall_copy(w);
    2541           0 :   gel(res,2) = V;
    2542           0 :   return res;
    2543             : }
    2544             : 
    2545             : /* e = t_VECSMALL of entree *ep [ addresses ],
    2546             :  * names = t_VEC of strtoGENstr(ep.names),
    2547             :  * Return hashtable : ep => is_entry(ep.name) */
    2548             : hashtable *
    2549           0 : hash_from_link(GEN e, GEN names, int use_stack)
    2550             : {
    2551           0 :   long i, l = lg(e);
    2552           0 :   hashtable *h = hash_create_ulong(l-1, use_stack);
    2553           0 :   if (lg(names) != l) pari_err_DIM("hash_from_link");
    2554           0 :   for (i = 1; i < l; i++)
    2555             :   {
    2556           0 :     char *s = GSTR(gel(names,i));
    2557           0 :     hash_insert(h, (void*)e[i], (void*)fetch_entry(s));
    2558             :   }
    2559           0 :   return h;
    2560             : }
    2561             : 
    2562             : void
    2563           0 : bincopy_relink(GEN C, GEN V)
    2564             : {
    2565           0 :   pari_sp av = avma;
    2566           0 :   hashtable *table = hash_from_link(gel(V,1),gel(V,2),1);
    2567           0 :   gen_relink(C, table);
    2568           0 :   set_avma(av);
    2569           0 : }

Generated by: LCOV version 1.13