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.16.2 lcov report (development 29395-ef22f77854) Lines: 1302 1888 69.0 %
Date: 2024-06-14 09:03:06 Functions: 117 155 75.5 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : #include "pari.h"
      16             : #include "paripriv.h"
      17             : #include "anal.h"
      18             : #include "opcode.h"
      19             : 
      20             : /********************************************************************/
      21             : /*                                                                  */
      22             : /*                   break/next/return handling                     */
      23             : /*                                                                  */
      24             : /********************************************************************/
      25             : 
      26             : static THREAD long br_status, br_count;
      27             : static THREAD GEN br_res;
      28             : 
      29             : long
      30   146174866 : loop_break(void)
      31             : {
      32   146174866 :   switch(br_status)
      33             :   {
      34          21 :     case br_MULTINEXT :
      35          21 :       if (! --br_count) br_status = br_NEXT;
      36          21 :       return 1;
      37       70302 :     case br_BREAK : if (! --br_count) br_status = br_NONE; /* fall through */
      38       78931 :     case br_RETURN: return 1;
      39       24866 :     case br_NEXT: br_status = br_NONE; /* fall through */
      40             :   }
      41   146095914 :   return 0;
      42             : }
      43             : 
      44             : static void
      45       90659 : reset_break(void)
      46             : {
      47       90659 :   br_status = br_NONE;
      48       90659 :   if (br_res) { gunclone_deep(br_res); br_res = NULL; }
      49       90659 : }
      50             : 
      51             : GEN
      52       40898 : return0(GEN x)
      53             : {
      54       40898 :   GEN y = br_res;
      55       40898 :   br_res = (x && x != gnil)? gcloneref(x): NULL;
      56       40898 :   guncloneNULL_deep(y);
      57       40898 :   br_status = br_RETURN; return NULL;
      58             : }
      59             : 
      60             : GEN
      61       25594 : next0(long n)
      62             : {
      63       25594 :   if (n < 1) pari_err_DOMAIN("next", "n", "<", gen_1, stoi(n));
      64       25587 :   if (n == 1) br_status = br_NEXT;
      65             :   else
      66             :   {
      67          14 :     br_count = n-1;
      68          14 :     br_status = br_MULTINEXT;
      69             :   }
      70       25587 :   return NULL;
      71             : }
      72             : 
      73             : GEN
      74       70358 : break0(long n)
      75             : {
      76       70358 :   if (n < 1) pari_err_DOMAIN("break", "n", "<", gen_1, stoi(n));
      77       70351 :   br_count = n;
      78       70351 :   br_status = br_BREAK; return NULL;
      79             : }
      80             : 
      81             : /*******************************************************************/
      82             : /*                                                                 */
      83             : /*                            VARIABLES                            */
      84             : /*                                                                 */
      85             : /*******************************************************************/
      86             : 
      87             : /* As a rule, ep->value is a clone (COPY). push_val and pop_val are private
      88             :  * functions for use in sumiter: we want a temporary ep->value, which is NOT
      89             :  * a clone (PUSH), to avoid unnecessary copies. */
      90             : 
      91             : enum {PUSH_VAL = 0, COPY_VAL = 1, DEFAULT_VAL = 2, REF_VAL = 3};
      92             : 
      93             : /* ep->args is the stack of old values (INITIAL if initial value, from
      94             :  * installep) */
      95             : typedef struct var_cell {
      96             :   struct var_cell *prev; /* cell attached to previous value on stack */
      97             :   GEN value; /* last value (not including current one, in ep->value) */
      98             :   char flag; /* status of _current_ ep->value: PUSH or COPY ? */
      99             :   long valence; /* valence of entree* attached to 'value', to be restored
     100             :                     * by pop_val */
     101             : } var_cell;
     102             : #define INITIAL NULL
     103             : 
     104             : /* Push x on value stack attached to ep. */
     105             : static void
     106       18075 : new_val_cell(entree *ep, GEN x, char flag)
     107             : {
     108       18075 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     109       18075 :   v->value  = (GEN)ep->value;
     110       18075 :   v->prev   = (var_cell*) ep->pvalue;
     111       18075 :   v->flag   = flag;
     112       18075 :   v->valence= ep->valence;
     113             : 
     114             :   /* beware: f(p) = Nv = 0
     115             :    *         Nv = p; f(Nv) --> this call would destroy p [ isclone ] */
     116       18075 :   ep->value = (flag == COPY_VAL)? gclone(x):
     117           0 :                                   (x && isclone(x))? gcopy(x): x;
     118             :   /* Do this last. In case the clone is <C-C>'ed before completion ! */
     119       18075 :   ep->pvalue= (char*)v;
     120       18075 :   ep->valence=EpVAR;
     121       18075 : }
     122             : 
     123             : /* kill ep->value and replace by preceding one, poped from value stack */
     124             : static void
     125       17620 : pop_val(entree *ep)
     126             : {
     127       17620 :   var_cell *v = (var_cell*) ep->pvalue;
     128       17620 :   if (v != INITIAL)
     129             :   {
     130       17620 :     GEN old_val = (GEN) ep->value; /* protect against SIGINT */
     131       17620 :     ep->value  = v->value;
     132       17620 :     if (v->flag == COPY_VAL) gunclone_deep(old_val);
     133       17620 :     ep->pvalue = (char*) v->prev;
     134       17620 :     ep->valence=v->valence;
     135       17620 :     pari_free((void*)v);
     136             :   }
     137       17620 : }
     138             : 
     139             : void
     140       34306 : freeep(entree *ep)
     141             : {
     142       34306 :   if (EpSTATIC(ep)) return; /* gp function loaded at init time */
     143       34306 :   if (ep->help) {pari_free((void*)ep->help); ep->help=NULL;}
     144       34306 :   if (ep->code) {pari_free((void*)ep->code); ep->code=NULL;}
     145       34306 :   switch(EpVALENCE(ep))
     146             :   {
     147       22771 :     case EpVAR:
     148       40335 :       while (ep->pvalue!=INITIAL) pop_val(ep);
     149       22771 :       break;
     150          28 :     case EpALIAS:
     151          28 :       killblock((GEN)ep->value); ep->value=NULL; break;
     152             :   }
     153             : }
     154             : 
     155             : INLINE void
     156          42 : pushvalue(entree *ep, GEN x) {
     157          42 :   new_val_cell(ep, x, COPY_VAL);
     158          42 : }
     159             : 
     160             : INLINE void
     161          14 : zerovalue(entree *ep)
     162             : {
     163          14 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     164          14 :   v->value  = (GEN)ep->value;
     165          14 :   v->prev   = (var_cell*) ep->pvalue;
     166          14 :   v->flag   = COPY_VAL;
     167          14 :   v->valence= ep->valence;
     168          14 :   ep->value = gen_0;
     169          14 :   ep->pvalue= (char*)v;
     170          14 :   ep->valence=EpVAR;
     171          14 : }
     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      348112 : pop_val_if_newer(entree *ep, long loc)
     177             : {
     178      348112 :   var_cell *v = (var_cell*) ep->pvalue;
     179             : 
     180      348112 :   if (v == INITIAL) return 0;
     181      315602 :   if (v->flag == COPY_VAL && !pop_entree_block(ep, loc)) return 0;
     182         469 :   ep->value = v->value;
     183         469 :   ep->pvalue= (char*) v->prev;
     184         469 :   ep->valence=v->valence;
     185         469 :   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    29486520 : changevalue(entree *ep, GEN x)
     192             : {
     193    29486520 :   var_cell *v = (var_cell*) ep->pvalue;
     194    29486520 :   if (v == INITIAL) new_val_cell(ep, x, COPY_VAL);
     195             :   else
     196             :   {
     197    29468487 :     GEN old_val = (GEN) ep->value; /* beware: gunclone_deep may destroy old x */
     198    29468487 :     ep->value = (void *) gclone(x);
     199    29468487 :     if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     200             :   }
     201    29486520 : }
     202             : 
     203             : INLINE GEN
     204      745367 : copyvalue(entree *ep)
     205             : {
     206      745367 :   var_cell *v = (var_cell*) ep->pvalue;
     207      745367 :   if (v && v->flag != COPY_VAL)
     208             :   {
     209           0 :     ep->value = (void*) gclone((GEN)ep->value);
     210           0 :     v->flag = COPY_VAL;
     211             :   }
     212      745367 :   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   123260856 : checkvalue(entree *ep, enum chk_VALUE flag)
     222             : {
     223   123260856 :   if (mt_is_thread())
     224          27 :     pari_err(e_MISC,"mt: attempt to change exported variable '%s'",ep->name);
     225   123260829 :   if (ep->valence==EpNEW)
     226       22309 :     switch(flag)
     227             :     {
     228        4543 :       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        4543 :         pari_var_create(ep);
     233        4543 :         ep->valence = EpVAR;
     234        4543 :         ep->value = initial_value(ep);
     235        4543 :         break;
     236       17766 :       case chk_NOCREATE:
     237       17766 :         break;
     238             :     }
     239   123238520 :   else if (ep->valence!=EpVAR)
     240           0 :     pari_err(e_MISC, "attempt to change built-in %s", ep->name);
     241   123260829 : }
     242             : 
     243             : INLINE GEN
     244    23308313 : checkvalueptr(entree *ep)
     245             : {
     246    23308313 :   checkvalue(ep, chk_NOCREATE);
     247    23308313 :   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   106067741 : check_array_index(long c, long l)
     270             : {
     271   106067741 :   if (c < 1) pari_err_COMPONENT("", "<", gen_1, stoi(c));
     272   106067735 :   if (c >= l) pari_err_COMPONENT("", ">", stoi(l-1), stoi(c));
     273   106067693 : }
     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             : /* assign res at *pt in "simple array object" p and return it, or a copy.*/
     330             : static void
     331     9699333 : change_compo(matcomp *c, GEN res)
     332             : {
     333     9699333 :   GEN p = c->parent, *pt = c->ptcell, po;
     334             :   long i, t;
     335             : 
     336     9699333 :   if (typ(p) == t_VECSMALL)
     337             :   {
     338          35 :     if (typ(res) != t_INT || is_bigint(res))
     339          14 :       pari_err_TYPE("t_VECSMALL assignment", res);
     340          21 :     *pt = (GEN)itos(res); return;
     341             :   }
     342     9699298 :   t = typ(res);
     343     9699298 :   if (c->full_row)
     344             :   {
     345      204988 :     if (t != t_VEC) pari_err_TYPE("matrix row assignment", res);
     346      204967 :     if (lg(res) != lg(p)) pari_err_DIM("matrix row assignment");
     347     2105362 :     for (i=1; i<lg(p); i++)
     348             :     {
     349     1900416 :       GEN p1 = gcoeff(p,c->full_row,i); /* Protect against SIGINT */
     350     1900416 :       gcoeff(p,c->full_row,i) = gclone(gel(res,i));
     351     1900416 :       if (isclone(p1)) gunclone_deep(p1);
     352             :     }
     353      204946 :     return;
     354             :   }
     355     9494310 :   if (c->full_col)
     356             :   {
     357      355397 :     if (t != t_COL) pari_err_TYPE("matrix col assignment", res);
     358      355383 :     if (lg(res) != lg(*pt)) pari_err_DIM("matrix col assignment");
     359             :   }
     360             : 
     361     9494289 :   po = *pt; /* Protect against SIGINT */
     362     9494289 :   *pt = gclone(res);
     363     9494289 :   gunclone_deep(po);
     364             : }
     365             : 
     366             : /***************************************************************************
     367             :  **                                                                       **
     368             :  **                           Byte-code evaluator                         **
     369             :  **                                                                       **
     370             :  ***************************************************************************/
     371             : 
     372             : struct var_lex
     373             : {
     374             :   long flag;
     375             :   GEN value;
     376             : };
     377             : 
     378             : struct trace
     379             : {
     380             :   long pc;
     381             :   GEN closure;
     382             : };
     383             : 
     384             : static THREAD long sp, rp, dbg_level;
     385             : static THREAD long *st, *precs;
     386             : static THREAD GEN *locks;
     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_trace, s_prec;
     392             : static THREAD pari_stack s_lvars, s_locks;
     393             : 
     394             : static void
     395   161791069 : changelex(long vn, GEN x)
     396             : {
     397   161791069 :   struct var_lex *v=var+s_var.n+vn;
     398   161791069 :   GEN old_val = v->value;
     399   161791069 :   v->value = gclone(x);
     400   161791069 :   if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     401   161791069 : }
     402             : 
     403             : INLINE GEN
     404     9768906 : copylex(long vn)
     405             : {
     406     9768906 :   struct var_lex *v = var+s_var.n+vn;
     407     9768906 :   if (v->flag!=COPY_VAL && v->flag!=REF_VAL)
     408             :   {
     409       52612 :     v->value = gclone(v->value);
     410       52612 :     v->flag  = COPY_VAL;
     411             :   }
     412     9768906 :   return v->value;
     413             : }
     414             : 
     415             : INLINE void
     416         504 : setreflex(long vn)
     417             : {
     418         504 :   struct var_lex *v = var+s_var.n+vn;
     419         504 :   v->flag  = REF_VAL;
     420         504 : }
     421             : 
     422             : INLINE void
     423    63461954 : pushlex(long vn, GEN x)
     424             : {
     425    63461954 :   struct var_lex *v=var+s_var.n+vn;
     426    63461954 :   v->flag  = PUSH_VAL;
     427    63461954 :   v->value = x;
     428    63461954 : }
     429             : 
     430             : INLINE void
     431   180454362 : freelex(void)
     432             : {
     433   180454362 :   struct var_lex *v=var+s_var.n-1;
     434   180454362 :   s_var.n--;
     435   180454362 :   if (v->flag == COPY_VAL) gunclone_deep(v->value);
     436   180454362 : }
     437             : 
     438             : INLINE void
     439   312047490 : restore_vars(long nbmvar, long nblvar, long nblock)
     440             : {
     441             :   long j;
     442   486762924 :   for(j=1; j<=nbmvar; j++) freelex();
     443   312047687 :   for(j=1; j<=nblvar; j++) { s_lvars.n--; pop_val(lvars[s_lvars.n]); }
     444   312048100 :   for(j=1; j<=nblock; j++) { s_locks.n--; gunclone_deep(locks[s_locks.n]); }
     445   312047631 : }
     446             : 
     447             : INLINE void
     448     5620735 : restore_trace(long nbtrace)
     449             : {
     450             :   long j;
     451    11254234 :   for(j=1; j<=nbtrace; j++)
     452             :   {
     453     5633499 :     GEN C = trace[s_trace.n-j].closure;
     454     5633499 :     clone_unlock(C);
     455             :   }
     456     5620735 :   s_trace.n -= nbtrace;
     457     5620735 : }
     458             : 
     459             : INLINE long
     460   317527371 : trace_push(long pc, GEN C)
     461             : {
     462             :   long tr;
     463   317527371 :   BLOCK_SIGINT_START
     464   318374240 :   tr = pari_stack_new(&s_trace);
     465   318092410 :   trace[tr].pc = pc;
     466   318092410 :   clone_lock(C);
     467   317762132 :   trace[tr].closure = C;
     468   317762132 :   BLOCK_SIGINT_END
     469   318418967 :   return tr;
     470             : }
     471             : 
     472             : void
     473     5739506 : push_lex(GEN a, GEN C)
     474             : {
     475     5739506 :   long vn=pari_stack_new(&s_var);
     476     5739506 :   struct var_lex *v=var+vn;
     477     5739506 :   v->flag  = PUSH_VAL;
     478     5739506 :   v->value = a;
     479     5739506 :   if (C) (void) trace_push(-1, C);
     480     5739506 : }
     481             : 
     482             : GEN
     483    99219258 : get_lex(long vn)
     484             : {
     485    99219258 :   struct var_lex *v=var+s_var.n+vn;
     486    99219258 :   return v->value;
     487             : }
     488             : 
     489             : void
     490    83000826 : set_lex(long vn, GEN x)
     491             : {
     492    83000826 :   struct var_lex *v=var+s_var.n+vn;
     493    83000826 :   if (v->flag == COPY_VAL) { gunclone_deep(v->value); v->flag = PUSH_VAL; }
     494    83000826 :   v->value = x;
     495    83000826 : }
     496             : 
     497             : void
     498     5572173 : pop_lex(long n)
     499             : {
     500             :   long j;
     501    11311376 :   for(j=1; j<=n; j++)
     502     5739203 :     freelex();
     503     5572173 :   restore_trace(1);
     504     5572173 : }
     505             : 
     506             : static THREAD pari_stack s_relocs;
     507             : static THREAD entree **relocs;
     508             : 
     509             : void
     510      324291 : pari_init_evaluator(void)
     511             : {
     512      324291 :   sp=0;
     513      324291 :   pari_stack_init(&s_st,sizeof(*st),(void**)&st);
     514      324275 :   pari_stack_alloc(&s_st,32);
     515      324332 :   s_st.n=s_st.alloc;
     516      324332 :   rp=0;
     517      324332 :   pari_stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
     518      324322 :   pari_stack_alloc(&s_ptrs,16);
     519      324354 :   s_ptrs.n=s_ptrs.alloc;
     520      324354 :   pari_stack_init(&s_var,sizeof(*var),(void**)&var);
     521      324330 :   pari_stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
     522      324309 :   pari_stack_init(&s_locks,sizeof(*locks),(void**)&locks);
     523      324294 :   pari_stack_init(&s_trace,sizeof(*trace),(void**)&trace);
     524      324270 :   br_res = NULL;
     525      324270 :   pari_stack_init(&s_relocs,sizeof(*relocs),(void**)&relocs);
     526      324268 :   pari_stack_init(&s_prec,sizeof(*precs),(void**)&precs);
     527      324269 : }
     528             : void
     529      319734 : pari_close_evaluator(void)
     530             : {
     531      319734 :   pari_stack_delete(&s_st);
     532      323256 :   pari_stack_delete(&s_ptrs);
     533      323283 :   pari_stack_delete(&s_var);
     534      323594 :   pari_stack_delete(&s_lvars);
     535      322840 :   pari_stack_delete(&s_trace);
     536      323667 :   pari_stack_delete(&s_relocs);
     537      323013 :   pari_stack_delete(&s_prec);
     538      323205 : }
     539             : 
     540             : static gp_pointer *
     541    58681799 : new_ptr(void)
     542             : {
     543    58681799 :   if (rp==s_ptrs.n-1)
     544             :   {
     545             :     long i;
     546           0 :     gp_pointer *old = ptrs;
     547           0 :     (void)pari_stack_new(&s_ptrs);
     548           0 :     if (old != ptrs)
     549           0 :       for(i=0; i<rp; i++)
     550             :       {
     551           0 :         gp_pointer *g = &ptrs[i];
     552           0 :         if(g->sp >= 0) gel(st,g->sp) = (GEN) &(g->x);
     553             :       }
     554             :   }
     555    58681799 :   return &ptrs[rp++];
     556             : }
     557             : 
     558             : void
     559      432591 : push_localbitprec(long p)
     560             : {
     561      432591 :   long n = pari_stack_new(&s_prec);
     562      432632 :   precs[n] = p;
     563      432632 : }
     564             : void
     565       99095 : push_localprec(long p) { push_localbitprec(p); }
     566             : 
     567             : void
     568       99046 : pop_localprec(void) { s_prec.n--; }
     569             : 
     570             : long
     571    22227012 : get_localbitprec(void) { return s_prec.n? precs[s_prec.n-1]: precreal; }
     572             : 
     573             : long
     574    21875531 : get_localprec(void) { return nbits2prec(get_localbitprec()); }
     575             : 
     576             : static void
     577       11113 : checkprec(const char *f, long p, long M)
     578             : {
     579       11113 :   if (p < 1) pari_err_DOMAIN(f, "p", "<", gen_1, stoi(p));
     580       11099 :   if (p > M) pari_err_DOMAIN(f, "p", ">", utoipos(M), utoi(p));
     581       11087 : }
     582             : static long
     583       11206 : _prec(GEN p, const char *f)
     584             : {
     585       11206 :   pari_sp av = avma;
     586       11206 :   if (typ(p) == t_INT) return itos(p);
     587          35 :   p = gceil(p);
     588          35 :   if (typ(p) != t_INT) pari_err_TYPE(f, p);
     589          28 :   return gc_long(av, itos(p));
     590             : }
     591             : void
     592        7847 : localprec(GEN pp)
     593             : {
     594        7847 :   long p = _prec(pp, "localprec");
     595        7839 :   checkprec("localprec", p, prec2ndec(LGBITS));
     596        7826 :   p = ndec2nbits(p); push_localbitprec(p);
     597        7826 : }
     598             : void
     599        3275 : localbitprec(GEN pp)
     600             : {
     601        3275 :   long p = _prec(pp, "localbitprec");
     602        3274 :   checkprec("localbitprec", p, (long)LGBITS);
     603        3261 :   push_localbitprec(p);
     604        3261 : }
     605             : long
     606          14 : getlocalprec(long prec) { return prec2ndec(prec); }
     607             : long
     608        3346 : getlocalbitprec(long bit) { return bit; }
     609             : 
     610             : static GEN
     611        1246 : _precision0(GEN x)
     612             : {
     613        1246 :   long a = gprecision(x);
     614        1246 :   return a? utoi(prec2ndec(a)): mkoo();
     615             : }
     616             : GEN
     617          42 : precision0(GEN x, long n)
     618          42 : { return n? gprec(x,n): _precision0(x); }
     619             : static GEN
     620         648 : _bitprecision0(GEN x)
     621             : {
     622         648 :   long a = gprecision(x);
     623         648 :   return a? utoi(a): mkoo();
     624             : }
     625             : GEN
     626        1225 : bitprecision0(GEN x, long n)
     627             : {
     628        1225 :   if (n < 0)
     629           0 :     pari_err_DOMAIN("bitprecision", "bitprecision", "<", gen_0, stoi(n));
     630        1225 :   if (n) {
     631        1225 :     pari_sp av = avma;
     632        1225 :     GEN y = gprec_w(x, nbits2prec(n));
     633        1225 :     return gerepilecopy(av, y);
     634             :   }
     635           0 :   return _bitprecision0(x);
     636             : }
     637             : GEN
     638        1288 : precision00(GEN x, GEN n)
     639             : {
     640        1288 :   if (!n) return _precision0(x);
     641          42 :   return precision0(x, _prec(n, "precision"));
     642             : }
     643             : GEN
     644         690 : bitprecision00(GEN x, GEN n)
     645             : {
     646         690 :   if (!n) return _bitprecision0(x);
     647          42 :   return bitprecision0(x, _prec(n, "bitprecision"));
     648             : }
     649             : 
     650             : INLINE GEN
     651    40791907 : copyupto(GEN z, GEN t)
     652             : {
     653    40791907 :   if (is_universal_constant(z) || (z>(GEN)pari_mainstack->bot && z<=t))
     654    39368215 :     return z;
     655             :   else
     656     1423462 :     return gcopy(z);
     657             : }
     658             : 
     659             : static void closure_eval(GEN C);
     660             : 
     661             : INLINE GEN
     662       41666 : get_and_reset_break(void)
     663             : {
     664       41666 :   GEN z = br_res? gcopy(br_res): gnil;
     665       41666 :   reset_break(); return z;
     666             : }
     667             : 
     668             : INLINE GEN
     669    49570373 : closure_return(GEN C)
     670             : {
     671    49570373 :   pari_sp av = avma;
     672    49570373 :   closure_eval(C);
     673    49543719 :   if (br_status) { set_avma(av); return get_and_reset_break(); }
     674    49502102 :   return gerepileupto(av, gel(st,--sp));
     675             : }
     676             : 
     677             : /* for the break_loop debugger. Not memory clean */
     678             : GEN
     679         175 : closure_evalbrk(GEN C, long *status)
     680             : {
     681         175 :   closure_eval(C); *status = br_status;
     682         140 :   return br_status? get_and_reset_break(): gel(st,--sp);
     683             : }
     684             : 
     685             : INLINE long
     686     1139016 : closure_varn(GEN x)
     687             : {
     688     1139016 :   if (!x) return -1;
     689     1138414 :   if (!gequalX(x)) err_var(x);
     690     1138414 :   return varn(x);
     691             : }
     692             : 
     693             : INLINE void
     694    92864575 : closure_castgen(GEN z, long mode)
     695             : {
     696    92864575 :   switch (mode)
     697             :   {
     698    92863708 :   case Ggen:
     699    92863708 :     gel(st,sp++)=z;
     700    92863708 :     break;
     701         868 :   case Gsmall:
     702         868 :     st[sp++]=gtos(z);
     703         868 :     break;
     704           0 :   case Gusmall:
     705           0 :     st[sp++]=gtou(z);
     706           0 :     break;
     707           0 :   case Gvar:
     708           0 :     st[sp++]=closure_varn(z);
     709           0 :     break;
     710           0 :   case Gvoid:
     711           0 :     break;
     712           0 :   default:
     713           0 :     pari_err_BUG("closure_castgen, type unknown");
     714             :   }
     715    92864576 : }
     716             : 
     717             : INLINE void
     718        5481 : closure_castlong(long z, long mode)
     719             : {
     720        5481 :   switch (mode)
     721             :   {
     722           0 :   case Gsmall:
     723           0 :     st[sp++]=z;
     724           0 :     break;
     725           0 :   case Gusmall:
     726           0 :     if (z < 0)
     727           0 :       pari_err_TYPE("stou [integer >=0 expected]", stoi(z));
     728           0 :     st[sp++]=(ulong) z;
     729           0 :     break;
     730        5474 :   case Ggen:
     731        5474 :     gel(st,sp++)=stoi(z);
     732        5474 :     break;
     733           0 :   case Gvar:
     734           0 :     err_var(stoi(z));
     735           7 :   case Gvoid:
     736           7 :     break;
     737           0 :   default:
     738           0 :     pari_err_BUG("closure_castlong, type unknown");
     739             :   }
     740        5481 : }
     741             : 
     742             : const char *
     743       12885 : closure_func_err(void)
     744             : {
     745       12885 :   long fun=s_trace.n-1, pc;
     746             :   const char *code;
     747             :   GEN C, oper;
     748       12885 :   if (fun < 0 || trace[fun].pc < 0) return NULL;
     749       12196 :   pc = trace[fun].pc; C  = trace[fun].closure;
     750       12196 :   code = closure_codestr(C); oper = closure_get_oper(C);
     751       12196 :   if (code[pc]==OCcallgen || code[pc]==OCcallgen2 ||
     752        3528 :       code[pc]==OCcallint || code[pc]==OCcalllong || code[pc]==OCcallvoid)
     753        9242 :     return ((entree*)oper[pc])->name;
     754        2954 :   return NULL;
     755             : }
     756             : 
     757             : /* return the next label for the call chain debugger closure_err(),
     758             :  * incorporating the name of the user of member function. Return NULL for an
     759             :  * anonymous (inline) closure. */
     760             : static char *
     761         245 : get_next_label(const char *s, int member, char **next_fun)
     762             : {
     763         245 :   const char *v, *t = s+1;
     764             :   char *u, *next_label;
     765             : 
     766         245 :   if (!is_keyword_char(*s)) return NULL;
     767        1036 :   while (is_keyword_char(*t)) t++;
     768             :   /* e.g. (x->1/x)(0) instead of (x)->1/x */
     769         224 :   if (t[0] == '-' && t[1] == '>') return NULL;
     770         217 :   next_label = (char*)pari_malloc(t - s + 32);
     771         217 :   sprintf(next_label, "in %sfunction ", member? "member ": "");
     772         217 :   u = *next_fun = next_label + strlen(next_label);
     773         217 :   v = s;
     774        1246 :   while (v < t) *u++ = *v++;
     775         217 :   *u++ = 0; return next_label;
     776             : }
     777             : 
     778             : static const char *
     779          21 : get_arg_name(GEN C, long i)
     780             : {
     781          21 :   GEN d = closure_get_dbg(C), frpc = gel(d,2), fram = gel(d,3);
     782          21 :   long j, l = lg(frpc);
     783          28 :   for (j=1; j<l; j++)
     784          28 :     if (frpc[j]==1 && i<lg(gel(fram,j)))
     785          21 :       return ((entree*)mael(fram,j,i))->name;
     786           0 :   return "(unnamed)";
     787             : }
     788             : 
     789             : void
     790       12195 : closure_err(long level)
     791             : {
     792             :   GEN base;
     793       12195 :   const long lastfun = s_trace.n - 1 - level;
     794             :   char *next_label, *next_fun;
     795       12195 :   long i = maxss(0, lastfun - 19);
     796       12195 :   if (lastfun < 0) return; /*e.g. when called by gp_main_loop's simplify */
     797       12174 :   if (i > 0) while (lg(trace[i].closure)==6) i--;
     798       12174 :   base = closure_get_text(trace[i].closure); /* gcc -Wall*/
     799       12174 :   next_label = pari_strdup(i == 0? "at top-level": "[...] at");
     800       12174 :   next_fun = next_label;
     801       12859 :   for (; i <= lastfun; i++)
     802             :   {
     803       12859 :     GEN C = trace[i].closure;
     804       12859 :     if (lg(C) >= 7) base=closure_get_text(C);
     805       12859 :     if ((i==lastfun || lg(trace[i+1].closure)>=7))
     806             :     {
     807       12419 :       GEN dbg = gel(closure_get_dbg(C),1);
     808             :       /* After a SIGINT, pc can be slightly off: ensure 0 <= pc < lg() */
     809       12419 :       long pc = minss(lg(dbg)-1, trace[i].pc>=0 ? trace[i].pc: 1);
     810       12419 :       long offset = pc? dbg[pc]: 0;
     811             :       int member;
     812             :       const char *s, *sbase;
     813       12419 :       if (typ(base)!=t_VEC) sbase = GSTR(base);
     814         189 :       else if (offset>=0)   sbase = GSTR(gel(base,2));
     815          21 :       else { sbase = GSTR(gel(base,1)); offset += strlen(sbase); }
     816       12419 :       s = sbase + offset;
     817       12419 :       member = offset>0 && (s[-1] == '.');
     818             :       /* avoid "in function foo: foo" */
     819       12419 :       if (!next_fun || strcmp(next_fun, s)) {
     820       12412 :         print_errcontext(pariErr, next_label, s, sbase);
     821       12412 :         out_putc(pariErr, '\n');
     822             :       }
     823       12419 :       pari_free(next_label);
     824       12419 :       if (i == lastfun) break;
     825             : 
     826         245 :       next_label = get_next_label(s, member, &next_fun);
     827         245 :       if (!next_label) {
     828          28 :         next_label = pari_strdup("in anonymous function");
     829          28 :         next_fun = NULL;
     830             :       }
     831             :     }
     832             :   }
     833             : }
     834             : 
     835             : GEN
     836          41 : pari_self(void)
     837             : {
     838          41 :   long fun = s_trace.n - 1;
     839          76 :   if (fun > 0) while (lg(trace[fun].closure)==6) fun--;
     840          41 :   return fun >= 0 ? trace[fun].closure: NULL;
     841             : }
     842             : 
     843             : long
     844          91 : closure_context(long start, long level)
     845             : {
     846          91 :   const long lastfun = s_trace.n - 1 - level;
     847          91 :   long i, fun = lastfun;
     848          91 :   if (fun<0) return lastfun;
     849         224 :   while (fun>start && lg(trace[fun].closure)==6) fun--;
     850         315 :   for (i=fun; i <= lastfun; i++)
     851         224 :     push_frame(trace[i].closure, trace[i].pc,0);
     852         126 :   for (  ; i < s_trace.n; i++)
     853          35 :     push_frame(trace[i].closure, trace[i].pc,1);
     854          91 :   return s_trace.n-level;
     855             : }
     856             : 
     857             : INLINE void
     858  2970733573 : st_alloc(long n)
     859             : {
     860  2970733573 :   if (sp+n>s_st.n)
     861             :   {
     862          70 :     pari_stack_alloc(&s_st,n+16);
     863          70 :     s_st.n=s_st.alloc;
     864          70 :     if (DEBUGMEM>=2) pari_warn(warner,"doubling evaluator stack");
     865             :   }
     866  2970733573 : }
     867             : 
     868             : INLINE void
     869     9904237 : ptr_proplock(gp_pointer *g, GEN C)
     870             : {
     871     9904237 :   g->x = C;
     872     9904237 :   if (isclone(g->x))
     873             :   {
     874      444500 :     clone_unlock_deep(g->ox);
     875      444500 :     g->ox = g->x;
     876      444500 :     ++bl_refc(g->ox);
     877             :   }
     878     9904237 : }
     879             : 
     880             : static void
     881   312027132 : closure_eval(GEN C)
     882             : {
     883   312027132 :   const char *code=closure_codestr(C);
     884   312010882 :   GEN oper=closure_get_oper(C);
     885   311995312 :   GEN data=closure_get_data(C);
     886   311983233 :   long loper=lg(oper);
     887   311983233 :   long saved_sp=sp-closure_arity(C);
     888   311980516 :   long saved_rp=rp, saved_prec=s_prec.n;
     889   311980516 :   long j, nbmvar=0, nblvar=0, nblock=0;
     890             :   long pc, t;
     891             : #ifdef STACK_CHECK
     892             :   GEN stackelt;
     893   311980516 :   if (PARI_stack_limit && (void*) &stackelt <= PARI_stack_limit)
     894           0 :     pari_err(e_MISC, "deep recursion");
     895             : #endif
     896   311980516 :   t = trace_push(0, C);
     897   312692388 :   if (lg(C)==8)
     898             :   {
     899    12903651 :     GEN z=closure_get_frame(C);
     900    12903334 :     long l=lg(z)-1;
     901    12903334 :     pari_stack_alloc(&s_var,l);
     902    12778506 :     s_var.n+=l;
     903    12778506 :     nbmvar+=l;
     904    44318174 :     for(j=1;j<=l;j++)
     905             :     {
     906    31539668 :       var[s_var.n-j].flag=PUSH_VAL;
     907    31539668 :       var[s_var.n-j].value=gel(z,j);
     908             :     }
     909             :   }
     910             : 
     911  3211423274 :   for(pc=1;pc<loper;pc++)
     912             :   {
     913  2899430436 :     op_code opcode=(op_code) code[pc];
     914  2899430436 :     long operand=oper[pc];
     915  2899430436 :     if (sp<0) pari_err_BUG("closure_eval, stack underflow");
     916  2899430436 :     st_alloc(16);
     917  2899288359 :     trace[t].pc = pc;
     918             :     CHECK_CTRLC
     919  2899288359 :     switch(opcode)
     920             :     {
     921   197948933 :     case OCpushlong:
     922   197948933 :       st[sp++]=operand;
     923   197948933 :       break;
     924       98923 :     case OCpushgnil:
     925       98923 :       gel(st,sp++)=gnil;
     926       98923 :       break;
     927   161675361 :     case OCpushgen:
     928   161675361 :       gel(st,sp++)=gel(data,operand);
     929   161675361 :       break;
     930       85870 :     case OCpushreal:
     931       85870 :       gel(st,sp++)=strtor(GSTR(data[operand]),get_localprec());
     932       85870 :       break;
     933   248570323 :     case OCpushstoi:
     934   248570323 :       gel(st,sp++)=stoi(operand);
     935   248570270 :       break;
     936       25548 :     case OCpushvar:
     937             :       {
     938       25548 :         entree *ep = (entree *)operand;
     939       25548 :         gel(st,sp++)=pol_x(pari_var_create(ep));
     940       25549 :         break;
     941             :       }
     942    93030336 :     case OCpushdyn:
     943             :       {
     944    93030336 :         entree *ep = (entree *)operand;
     945    93030336 :         if (!mt_is_thread())
     946             :         {
     947    93028838 :           checkvalue(ep, chk_CREATE);
     948    93028838 :           gel(st,sp++)=(GEN)ep->value;
     949             :         } else
     950             :         {
     951        1498 :           GEN val = export_get(ep->name);
     952        1498 :           if (!val)
     953           0 :             pari_err(e_MISC,"mt: please use export(%s)", ep->name);
     954        1498 :           gel(st,sp++)=val;
     955             :         }
     956    93030336 :         break;
     957             :       }
     958   626402831 :     case OCpushlex:
     959   626402831 :       gel(st,sp++)=var[s_var.n+operand].value;
     960   626402831 :       break;
     961    23308313 :     case OCsimpleptrdyn:
     962             :       {
     963    23308313 :         gp_pointer *g = new_ptr();
     964    23308313 :         g->vn=0;
     965    23308313 :         g->ep = (entree*) operand;
     966    23308313 :         g->x = checkvalueptr(g->ep);
     967    23308313 :         g->ox = g->x; clone_lock(g->ox);
     968    23308313 :         g->sp = sp;
     969    23308313 :         gel(st,sp++) = (GEN)&(g->x);
     970    23308313 :         break;
     971             :       }
     972    25674104 :     case OCsimpleptrlex:
     973             :       {
     974    25674104 :         gp_pointer *g = new_ptr();
     975    25674104 :         g->vn=operand;
     976    25674104 :         g->ep=(entree *)0x1L;
     977    25674104 :         g->x = (GEN) var[s_var.n+operand].value;
     978    25674104 :         g->ox = g->x; clone_lock(g->ox);
     979    25674104 :         g->sp = sp;
     980    25674104 :         gel(st,sp++) = (GEN)&(g->x);
     981    25674104 :         break;
     982             :       }
     983        5019 :     case OCnewptrdyn:
     984             :       {
     985        5019 :         entree *ep = (entree *)operand;
     986        5019 :         gp_pointer *g = new_ptr();
     987             :         matcomp *C;
     988        5019 :         checkvalue(ep, chk_ERROR);
     989        5019 :         g->sp = -1;
     990        5019 :         g->x = copyvalue(ep);
     991        5019 :         g->ox = g->x; clone_lock(g->ox);
     992        5019 :         g->vn=0;
     993        5019 :         g->ep=NULL;
     994        5019 :         C=&g->c;
     995        5019 :         C->full_col = C->full_row = 0;
     996        5019 :         C->parent   = (GEN)    g->x;
     997        5019 :         C->ptcell   = (GEN *) &g->x;
     998        5019 :         break;
     999             :       }
    1000     9694363 :     case OCnewptrlex:
    1001             :       {
    1002     9694363 :         gp_pointer *g = new_ptr();
    1003             :         matcomp *C;
    1004     9694363 :         g->sp = -1;
    1005     9694363 :         g->x = copylex(operand);
    1006     9694363 :         g->ox = g->x; clone_lock(g->ox);
    1007     9694363 :         g->vn=0;
    1008     9694363 :         g->ep=NULL;
    1009     9694363 :         C=&g->c;
    1010     9694363 :         C->full_col = C->full_row = 0;
    1011     9694363 :         C->parent   = (GEN)     g->x;
    1012     9694363 :         C->ptcell   = (GEN *) &(g->x);
    1013     9694363 :         break;
    1014             :       }
    1015      557648 :     case OCpushptr:
    1016             :       {
    1017      557648 :         gp_pointer *g = &ptrs[rp-1];
    1018      557648 :         g->sp = sp;
    1019      557648 :         gel(st,sp++) = (GEN)&(g->x);
    1020             :       }
    1021      557648 :       break;
    1022    49540009 :     case OCendptr:
    1023    99080018 :       for(j=0;j<operand;j++)
    1024             :       {
    1025    49540009 :         gp_pointer *g = &ptrs[--rp];
    1026    49540009 :         if (g->ep)
    1027             :         {
    1028    48982361 :           if (g->vn)
    1029    25674104 :             changelex(g->vn, g->x);
    1030             :           else
    1031    23308257 :             changevalue(g->ep, g->x);
    1032             :         }
    1033      557648 :         else change_compo(&(g->c), g->x);
    1034    49540009 :         clone_unlock_deep(g->ox);
    1035             :       }
    1036    49540009 :       break;
    1037     6178264 :     case OCstoredyn:
    1038             :       {
    1039     6178264 :         entree *ep = (entree *)operand;
    1040     6178264 :         checkvalue(ep, chk_NOCREATE);
    1041     6178255 :         changevalue(ep, gel(st,--sp));
    1042     6178255 :         break;
    1043             :       }
    1044   136116965 :     case OCstorelex:
    1045   136116965 :       changelex(operand,gel(st,--sp));
    1046   136116965 :       break;
    1047     9141685 :     case OCstoreptr:
    1048             :       {
    1049     9141685 :         gp_pointer *g = &ptrs[--rp];
    1050     9141685 :         change_compo(&(g->c), gel(st,--sp));
    1051     9141608 :         clone_unlock_deep(g->ox);
    1052     9141608 :         break;
    1053             :       }
    1054    25712509 :     case OCstackgen:
    1055             :       {
    1056    25712509 :         GEN z = gerepileupto(st[sp-2],gel(st,sp-1));
    1057    25712520 :         gmael(st,sp-3,operand) = copyupto(z,gel(st,sp-2));
    1058    25712520 :         st[sp-2] = avma;
    1059    25712520 :         sp--;
    1060    25712520 :         break;
    1061             :       }
    1062    21789661 :     case OCprecreal:
    1063    21789661 :       st[sp++]=get_localprec();
    1064    21789661 :       break;
    1065       28868 :     case OCbitprecreal:
    1066       28868 :       st[sp++]=get_localbitprec();
    1067       28868 :       break;
    1068         952 :     case OCprecdl:
    1069         952 :       st[sp++]=precdl;
    1070         952 :       break;
    1071        2933 :     case OCavma:
    1072        2933 :       st[sp++]=avma;
    1073        2933 :       break;
    1074      740348 :     case OCcowvardyn:
    1075             :       {
    1076      740348 :         entree *ep = (entree *)operand;
    1077      740348 :         checkvalue(ep, chk_ERROR);
    1078      740348 :         (void)copyvalue(ep);
    1079      740348 :         break;
    1080             :       }
    1081       73486 :     case OCcowvarlex:
    1082       73486 :       (void)copylex(operand);
    1083       73486 :       break;
    1084         504 :     case OCsetref:
    1085         504 :       setreflex(operand);
    1086         504 :       break;
    1087         483 :     case OClock:
    1088             :     {
    1089         483 :       GEN v = gel(st,sp-1);
    1090         483 :       if (isclone(v))
    1091             :       {
    1092         469 :         long n = pari_stack_new(&s_locks);
    1093         469 :         locks[n] = v;
    1094         469 :         nblock++;
    1095         469 :         ++bl_refc(v);
    1096             :       }
    1097         483 :       break;
    1098             :     }
    1099           0 :     case OCevalmnem:
    1100             :     {
    1101           0 :       entree *ep = (entree*) operand;
    1102           0 :       const char *flags = ep->code;
    1103           0 :       flags = strchr(flags, '\n'); /* Skip to the following '\n' */
    1104           0 :       st[sp-1] = eval_mnemonic(gel(st,sp-1), flags+1);
    1105           0 :       break;
    1106             :     }
    1107    19993630 :     case OCstoi:
    1108    19993630 :       gel(st,sp-1)=stoi(st[sp-1]);
    1109    19993662 :       break;
    1110           0 :     case OCutoi:
    1111           0 :       gel(st,sp-1)=utoi(st[sp-1]);
    1112           0 :       break;
    1113    72873772 :     case OCitos:
    1114    72873772 :       st[sp+operand]=gtos(gel(st,sp+operand));
    1115    72873734 :       break;
    1116      101497 :     case OCitou:
    1117      101497 :       st[sp+operand]=gtou(gel(st,sp+operand));
    1118      101495 :       break;
    1119        5131 :     case OCtostr:
    1120             :       {
    1121        5131 :         GEN z = gel(st,sp+operand);
    1122        5131 :         st[sp+operand] = (long) (z ? GENtostr_unquoted(z): NULL);
    1123        5131 :         break;
    1124             :       }
    1125     1139016 :     case OCvarn:
    1126     1139016 :       st[sp+operand] = closure_varn(gel(st,sp+operand));
    1127     1139016 :       break;
    1128    26200629 :     case OCcopy:
    1129    26200629 :       gel(st,sp-1) = gcopy(gel(st,sp-1));
    1130    26200632 :       break;
    1131        2933 :     case OCgerepile:
    1132             :     {
    1133             :       pari_sp av;
    1134             :       GEN x;
    1135        2933 :       sp--;
    1136        2933 :       av = st[sp-1];
    1137        2933 :       x = gel(st,sp);
    1138        2933 :       if (isonstack(x))
    1139             :       {
    1140        2933 :         pari_sp av2 = (pari_sp)(x + lg(x));
    1141        2933 :         if ((long) (av - av2) > 1000000L)
    1142             :         {
    1143           7 :           if (DEBUGMEM>=2)
    1144           0 :             pari_warn(warnmem,"eval: recovering %ld bytes", av - av2);
    1145           7 :           x = gerepileupto(av, x);
    1146             :         }
    1147           0 :       } else set_avma(av);
    1148        2933 :       gel(st,sp-1) = x;
    1149        2933 :       break;
    1150             :     }
    1151           0 :     case OCcopyifclone:
    1152           0 :       if (isclone(gel(st,sp-1)))
    1153           0 :         gel(st,sp-1) = gcopy(gel(st,sp-1));
    1154           0 :       break;
    1155    91199324 :     case OCcompo1:
    1156             :       {
    1157    91199324 :         GEN  p=gel(st,sp-2);
    1158    91199324 :         long c=st[sp-1];
    1159    91199324 :         sp-=2;
    1160    91199324 :         switch(typ(p))
    1161             :         {
    1162    91193797 :         case t_VEC: case t_COL:
    1163    91193797 :           check_array_index(c, lg(p));
    1164    91193797 :           closure_castgen(gel(p,c),operand);
    1165    91193800 :           break;
    1166          25 :         case t_LIST:
    1167             :           {
    1168             :             long lx;
    1169          25 :             if (list_typ(p)!=t_LIST_RAW)
    1170           0 :               pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1171          25 :             p = list_data(p); lx = p? lg(p): 1;
    1172          25 :             check_array_index(c, lx);
    1173          25 :             closure_castgen(gel(p,c),operand);
    1174          25 :             break;
    1175             :           }
    1176        5495 :         case t_VECSMALL:
    1177        5495 :           check_array_index(c,lg(p));
    1178        5481 :           closure_castlong(p[c],operand);
    1179        5482 :           break;
    1180           7 :         default:
    1181           7 :           pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1182           0 :           break;
    1183             :         }
    1184    91199307 :         break;
    1185             :       }
    1186     9424961 :     case OCcompo1ptr:
    1187             :       {
    1188     9424961 :         long c=st[sp-1];
    1189             :         long lx;
    1190     9424961 :         gp_pointer *g = &ptrs[rp-1];
    1191     9424961 :         matcomp *C=&g->c;
    1192     9424961 :         GEN p = g->x;
    1193     9424961 :         sp--;
    1194     9424961 :         switch(typ(p))
    1195             :         {
    1196     9424884 :         case t_VEC: case t_COL:
    1197     9424884 :           check_array_index(c, lg(p));
    1198     9424884 :           C->ptcell = (GEN *) p+c;
    1199     9424884 :           ptr_proplock(g, *(C->ptcell));
    1200     9424884 :           break;
    1201          42 :         case t_VECSMALL:
    1202          42 :           check_array_index(c, lg(p));
    1203          35 :           C->ptcell = (GEN *) p+c;
    1204          35 :           g->x = stoi(p[c]);
    1205          35 :           break;
    1206          28 :         case t_LIST:
    1207          28 :           if (list_typ(p)!=t_LIST_RAW)
    1208           0 :             pari_err_TYPE("&_[_] OCcompo1 [not a vector]", p);
    1209          28 :           p = list_data(p); lx = p? lg(p): 1;
    1210          28 :           check_array_index(c,lx);
    1211          28 :           C->ptcell = (GEN *) p+c;
    1212          28 :           ptr_proplock(g, *(C->ptcell));
    1213          28 :           break;
    1214           7 :         default:
    1215           7 :           pari_err_TYPE("&_[_] OCcompo1ptr [not a vector]", p);
    1216             :         }
    1217     9424947 :         C->parent   = p;
    1218     9424947 :         break;
    1219             :       }
    1220     1670760 :     case OCcompo2:
    1221             :       {
    1222     1670760 :         GEN  p=gel(st,sp-3);
    1223     1670760 :         long c=st[sp-2];
    1224     1670760 :         long d=st[sp-1];
    1225     1670760 :         if (typ(p)!=t_MAT) pari_err_TYPE("_[_,_] OCcompo2 [not a matrix]", p);
    1226     1670753 :         check_array_index(d, lg(p));
    1227     1670753 :         check_array_index(c, lg(gel(p,d)));
    1228     1670753 :         sp-=3;
    1229     1670753 :         closure_castgen(gcoeff(p,c,d),operand);
    1230     1670753 :         break;
    1231             :       }
    1232      123928 :     case OCcompo2ptr:
    1233             :       {
    1234      123928 :         long c=st[sp-2];
    1235      123928 :         long d=st[sp-1];
    1236      123928 :         gp_pointer *g = &ptrs[rp-1];
    1237      123928 :         matcomp *C=&g->c;
    1238      123928 :         GEN p = g->x;
    1239      123928 :         sp-=2;
    1240      123928 :         if (typ(p)!=t_MAT)
    1241           0 :           pari_err_TYPE("&_[_,_] OCcompo2ptr [not a matrix]", p);
    1242      123928 :         check_array_index(d, lg(p));
    1243      123928 :         check_array_index(c, lg(gel(p,d)));
    1244      123928 :         C->ptcell = (GEN *) gel(p,d)+c;
    1245      123928 :         C->parent   = p;
    1246      123928 :         ptr_proplock(g, *(C->ptcell));
    1247      123928 :         break;
    1248             :       }
    1249     1020696 :     case OCcompoC:
    1250             :       {
    1251     1020696 :         GEN  p=gel(st,sp-2);
    1252     1020696 :         long c=st[sp-1];
    1253     1020696 :         if (typ(p)!=t_MAT)
    1254           7 :           pari_err_TYPE("_[,_] OCcompoC [not a matrix]", p);
    1255     1020689 :         check_array_index(c, lg(p));
    1256     1020682 :         sp--;
    1257     1020682 :         gel(st,sp-1) = gel(p,c);
    1258     1020682 :         break;
    1259             :       }
    1260      355411 :     case OCcompoCptr:
    1261             :       {
    1262      355411 :         long c=st[sp-1];
    1263      355411 :         gp_pointer *g = &ptrs[rp-1];
    1264      355411 :         matcomp *C=&g->c;
    1265      355411 :         GEN p = g->x;
    1266      355411 :         sp--;
    1267      355411 :         if (typ(p)!=t_MAT)
    1268           7 :           pari_err_TYPE("&_[,_] OCcompoCptr [not a matrix]", p);
    1269      355404 :         check_array_index(c, lg(p));
    1270      355397 :         C->ptcell = (GEN *) p+c;
    1271      355397 :         C->full_col = c;
    1272      355397 :         C->parent   = p;
    1273      355397 :         ptr_proplock(g, *(C->ptcell));
    1274      355397 :         break;
    1275             :       }
    1276      273028 :     case OCcompoL:
    1277             :       {
    1278      273028 :         GEN  p=gel(st,sp-2);
    1279      273028 :         long r=st[sp-1];
    1280      273028 :         sp--;
    1281      273028 :         if (typ(p)!=t_MAT)
    1282           7 :           pari_err_TYPE("_[_,] OCcompoL [not a matrix]", p);
    1283      273021 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1284      273014 :         gel(st,sp-1) = row(p,r);
    1285      273014 :         break;
    1286             :       }
    1287      205002 :     case OCcompoLptr:
    1288             :       {
    1289      205002 :         long r=st[sp-1];
    1290      205002 :         gp_pointer *g = &ptrs[rp-1];
    1291      205002 :         matcomp *C=&g->c;
    1292      205002 :         GEN p = g->x, p2;
    1293      205002 :         sp--;
    1294      205002 :         if (typ(p)!=t_MAT)
    1295           7 :           pari_err_TYPE("&_[_,] OCcompoLptr [not a matrix]", p);
    1296      204995 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1297      204988 :         p2 = rowcopy(p,r);
    1298      204988 :         C->full_row = r; /* record row number */
    1299      204988 :         C->ptcell = &p2;
    1300      204988 :         C->parent   = p;
    1301      204988 :         g->x = p2;
    1302      204988 :         break;
    1303             :       }
    1304      102732 :     case OCdefaultarg:
    1305      102732 :       if (var[s_var.n+operand].flag==DEFAULT_VAL)
    1306             :       {
    1307        3353 :         GEN z = gel(st,sp-1);
    1308        3353 :         if (typ(z)==t_CLOSURE)
    1309             :         {
    1310        1057 :           pushlex(operand, closure_evalnobrk(z));
    1311        1057 :           copylex(operand);
    1312             :         }
    1313             :         else
    1314        2296 :           pushlex(operand, z);
    1315             :       }
    1316      102732 :       sp--;
    1317      102732 :       break;
    1318          51 :     case OClocalvar:
    1319             :       {
    1320             :         long n;
    1321          51 :         entree *ep = (entree *)operand;
    1322          51 :         checkvalue(ep, chk_NOCREATE);
    1323          42 :         n = pari_stack_new(&s_lvars);
    1324          42 :         lvars[n] = ep;
    1325          42 :         nblvar++;
    1326          42 :         pushvalue(ep,gel(st,--sp));
    1327          42 :         break;
    1328             :       }
    1329          23 :     case OClocalvar0:
    1330             :       {
    1331             :         long n;
    1332          23 :         entree *ep = (entree *)operand;
    1333          23 :         checkvalue(ep, chk_NOCREATE);
    1334          14 :         n = pari_stack_new(&s_lvars);
    1335          14 :         lvars[n] = ep;
    1336          14 :         nblvar++;
    1337          14 :         zerovalue(ep);
    1338          12 :         break;
    1339             :       }
    1340          41 :     case OCexportvar:
    1341             :       {
    1342          41 :         entree *ep = (entree *)operand;
    1343          41 :         mt_export_add(ep->name, gel(st,--sp));
    1344          41 :         break;
    1345             :       }
    1346           6 :     case OCunexportvar:
    1347             :       {
    1348           6 :         entree *ep = (entree *)operand;
    1349           6 :         mt_export_del(ep->name);
    1350           6 :         break;
    1351             :       }
    1352             : 
    1353             : #define EVAL_f(f, type, resEQ) \
    1354             :   switch (ep->arity) \
    1355             :   { \
    1356             :     case 0: resEQ ((type (*)(void))f)(); break; \
    1357             :     case 1: sp--;  resEQ ((type (*)(long))f)(st[sp]); break; \
    1358             :     case 2: sp-=2; resEQ((type (*)(long,long))f)(st[sp],st[sp+1]); break; \
    1359             :     case 3: sp-=3; resEQ((type (*)(long,long,long))f)(st[sp],st[sp+1],st[sp+2]); break; \
    1360             :     case 4: sp-=4; resEQ((type (*)(long,long,long,long))f)(st[sp],st[sp+1],st[sp+2],st[sp+3]); break; \
    1361             :     case 5: sp-=5; resEQ((type (*)(long,long,long,long,long))f)(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4]); break; \
    1362             :     case 6: sp-=6; resEQ((type (*)(long,long,long,long,long,long))f)(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5]); break; \
    1363             :     case 7: sp-=7; resEQ((type (*)(long,long,long,long,long,long,long))f)(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6]); break; \
    1364             :     case 8: sp-=8; resEQ((type (*)(long,long,long,long,long,long,long,long))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; \
    1365             :     case 9: sp-=9; resEQ((type (*)(long,long,long,long,long,long,long,long,long))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; \
    1366             :     case 10: sp-=10; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long))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; \
    1367             :     case 11: sp-=11; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long))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; \
    1368             :     case 12: sp-=12; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1369             :     case 13: sp-=13; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1370             :     case 14: sp-=14; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1371             :     case 15: sp-=15; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1372             :     case 16: sp-=16; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1373             :     case 17: sp-=17; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1374             :     case 18: sp-=18; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1375             :     case 19: sp-=19; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1376             :     case 20: sp-=20; resEQ((type (*)(long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long,long))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; \
    1377             :     default: \
    1378             :       pari_err_IMPL("functions with more than 20 parameters");\
    1379             :       goto endeval; /*LCOV_EXCL_LINE*/ \
    1380             :   }
    1381             : 
    1382             : 
    1383   104778954 :     case OCcallgen:
    1384             :       {
    1385   104778954 :         entree *ep = (entree *)operand;
    1386             :         GEN res;
    1387             :         /* Macro Madness : evaluate function ep->value on arguments
    1388             :          * st[sp-ep->arity .. sp]. Set res = result. */
    1389   104778954 :         EVAL_f(ep->value, GEN, res=);
    1390   104761572 :         if (br_status) goto endeval;
    1391   104624702 :         gel(st,sp++)=res;
    1392   104624702 :         break;
    1393             :       }
    1394   607872415 :     case OCcallgen2: /*same for ep->arity = 2. Is this optimization worth it ?*/
    1395             :       {
    1396   607872415 :         entree *ep = (entree *)operand;
    1397             :         GEN res;
    1398   607872415 :         sp-=2;
    1399   607872415 :         res = ((GEN (*)(GEN,GEN))ep->value)(gel(st,sp),gel(st,sp+1));
    1400   607963845 :         if (br_status) goto endeval;
    1401   607963817 :         gel(st,sp++)=res;
    1402   607963817 :         break;
    1403             :       }
    1404    18294865 :     case OCcalllong:
    1405             :       {
    1406    18294865 :         entree *ep = (entree *)operand;
    1407             :         long res;
    1408    18294865 :         EVAL_f(ep->value, long, res=);
    1409    18295873 :         if (br_status) goto endeval;
    1410    18295873 :         st[sp++] = res;
    1411    18295873 :         break;
    1412             :       }
    1413     1700936 :     case OCcallint:
    1414             :       {
    1415     1700936 :         entree *ep = (entree *)operand;
    1416             :         long res;
    1417     1700936 :         EVAL_f(ep->value, int, res=);
    1418     1700810 :         if (br_status) goto endeval;
    1419     1700810 :         st[sp++] = res;
    1420     1700810 :         break;
    1421             :       }
    1422    48832501 :     case OCcallvoid:
    1423             :       {
    1424    48832501 :         entree *ep = (entree *)operand;
    1425    48832501 :         EVAL_f(ep->value, void,(void));
    1426    48832033 :         if (br_status) goto endeval;
    1427    48673892 :         break;
    1428             :       }
    1429             : #undef EVAL_f
    1430             : 
    1431    35437884 :     case OCcalluser:
    1432             :       {
    1433    35437884 :         long n=operand;
    1434    35437884 :         GEN fun = gel(st,sp-1-n);
    1435             :         long arity, isvar;
    1436             :         GEN z;
    1437    35437884 :         if (typ(fun)!=t_CLOSURE) pari_err(e_NOTFUNC, fun);
    1438    35435175 :         isvar = closure_is_variadic(fun);
    1439    35435145 :         arity = closure_arity(fun);
    1440    35435185 :         if (!isvar || n < arity)
    1441             :         {
    1442    35435115 :           st_alloc(arity-n);
    1443    35435094 :           if (n>arity)
    1444           0 :             pari_err(e_MISC,"too many parameters in user-defined function call");
    1445    35461334 :           for (j=n+1;j<=arity;j++)
    1446       26239 :             gel(st,sp++)=0;
    1447    35435095 :           if (isvar) gel(st,sp-1) = cgetg(1,t_VEC);
    1448             :         }
    1449             :         else
    1450             :         {
    1451             :           GEN v;
    1452          70 :           long j, m = n-arity+1;
    1453          70 :           v = cgetg(m+1,t_VEC);
    1454          70 :           sp-=m;
    1455         301 :           for (j=1; j<=m; j++)
    1456         231 :             gel(v,j) = gel(st,sp+j-1)? gcopy(gel(st,sp+j-1)): gen_0;
    1457          70 :           gel(st,sp++)=v;
    1458             :         }
    1459    35435165 :         z = closure_return(fun);
    1460    35430449 :         if (br_status) goto endeval;
    1461    35430449 :         gel(st, sp-1) = z;
    1462    35430449 :         break;
    1463             :       }
    1464    42555425 :     case OCnewframe:
    1465    42555425 :       if (operand>0) nbmvar+=operand;
    1466          13 :       else operand=-operand;
    1467    42555425 :       pari_stack_alloc(&s_var,operand);
    1468    42555425 :       s_var.n+=operand;
    1469   122269170 :       for(j=1;j<=operand;j++)
    1470             :       {
    1471    79713745 :         var[s_var.n-j].flag=PUSH_VAL;
    1472    79713745 :         var[s_var.n-j].value=gen_0;
    1473             :       }
    1474    42555425 :       break;
    1475        6732 :     case OCsaveframe:
    1476             :       {
    1477        6732 :         GEN cl = (operand?gcopy:shallowcopy)(gel(st,sp-1));
    1478        6732 :         GEN f = gel(cl, 7);
    1479        6732 :         long j, l = lg(f);
    1480        6732 :         GEN v = cgetg(l, t_VEC);
    1481       75835 :         for (j = 1; j < l; j++)
    1482       69103 :           if (signe(gel(f,l-j))==0)
    1483             :           {
    1484       10080 :             GEN val = var[s_var.n-j].value;
    1485       10080 :             gel(v,j) = operand?gcopy(val):val;
    1486             :           } else
    1487       59023 :             gel(v,j) = gnil;
    1488        6732 :         gel(cl,7) = v;
    1489        6732 :         gel(st,sp-1) = cl;
    1490             :       }
    1491        6732 :       break;
    1492         105 :     case OCpackargs:
    1493             :     {
    1494         105 :       GEN def = cgetg(operand+1, t_VECSMALL);
    1495         105 :       GEN args = cgetg(operand+1, t_VEC);
    1496         105 :       pari_stack_alloc(&s_var,operand);
    1497         105 :       sp-=operand;
    1498         210 :       for (j=0;j<operand;j++)
    1499             :       {
    1500         105 :         if (gel(st,sp+j))
    1501             :         {
    1502         105 :           gel(args,j+1) = gel(st,sp+j);
    1503         105 :           uel(def ,j+1) = 1;
    1504             :         }
    1505             :         else
    1506             :         {
    1507           0 :           gel(args,j+1) = gen_0;
    1508           0 :           uel(def ,j+1) = 0;
    1509             :         }
    1510             :       }
    1511         105 :       gel(st, sp++) = args;
    1512         105 :       gel(st, sp++) = def;
    1513         105 :       break;
    1514             :     }
    1515    36485000 :     case OCgetargs:
    1516    36485000 :       pari_stack_alloc(&s_var,operand);
    1517    36483964 :       s_var.n+=operand;
    1518    36483964 :       nbmvar+=operand;
    1519    36483964 :       sp-=operand;
    1520    99950947 :       for (j=0;j<operand;j++)
    1521             :       {
    1522    63467339 :         if (gel(st,sp+j))
    1523    63458694 :           pushlex(j-operand,gel(st,sp+j));
    1524             :         else
    1525             :         {
    1526        8645 :           var[s_var.n+j-operand].flag=DEFAULT_VAL;
    1527        8645 :           var[s_var.n+j-operand].value=gen_0;
    1528             :         }
    1529             :       }
    1530    36483608 :       break;
    1531          49 :     case OCcheckuserargs:
    1532         105 :       for (j=0; j<operand; j++)
    1533          77 :         if (var[s_var.n-operand+j].flag==DEFAULT_VAL)
    1534          21 :           pari_err(e_MISC,"missing mandatory argument"
    1535             :                    " '%s' in user function",get_arg_name(C,j+1));
    1536          28 :       break;
    1537    12152283 :     case OCcheckargs:
    1538    53467606 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1539    41315278 :         if ((operand&1L) && gel(st,j)==NULL)
    1540           0 :           pari_err(e_MISC,"missing mandatory argument");
    1541    12152328 :       break;
    1542         441 :     case OCcheckargs0:
    1543         882 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1544         441 :         if ((operand&1L) && gel(st,j))
    1545           0 :           pari_err(e_MISC,"argument type not implemented");
    1546         441 :       break;
    1547       23429 :     case OCdefaultlong:
    1548       23429 :       sp--;
    1549       23429 :       if (st[sp+operand])
    1550        1050 :         st[sp+operand]=gtos(gel(st,sp+operand));
    1551             :       else
    1552       22379 :         st[sp+operand]=st[sp];
    1553       23429 :       break;
    1554           0 :     case OCdefaultulong:
    1555           0 :       sp--;
    1556           0 :       if (st[sp+operand])
    1557           0 :         st[sp+operand]=gtou(gel(st,sp+operand));
    1558             :       else
    1559           0 :         st[sp+operand]=st[sp];
    1560           0 :       break;
    1561           0 :     case OCdefaultgen:
    1562           0 :       sp--;
    1563           0 :       if (!st[sp+operand])
    1564           0 :         st[sp+operand]=st[sp];
    1565           0 :       break;
    1566    10723976 :     case OCvec:
    1567    10723976 :       gel(st,sp++)=cgetg(operand,t_VEC);
    1568    10723977 :       st[sp++]=avma;
    1569    10723977 :       break;
    1570        4515 :     case OCcol:
    1571        4515 :       gel(st,sp++)=cgetg(operand,t_COL);
    1572        4515 :       st[sp++]=avma;
    1573        4515 :       break;
    1574       55629 :     case OCmat:
    1575             :       {
    1576             :         GEN z;
    1577       55629 :         long l=st[sp-1];
    1578       55629 :         z=cgetg(operand,t_MAT);
    1579      185164 :         for(j=1;j<operand;j++)
    1580      129535 :           gel(z,j) = cgetg(l,t_COL);
    1581       55629 :         gel(st,sp-1) = z;
    1582       55629 :         st[sp++]=avma;
    1583             :       }
    1584       55629 :       break;
    1585    89200380 :     case OCpop:
    1586    89200380 :       sp-=operand;
    1587    89200380 :       break;
    1588    31388296 :     case OCdup:
    1589             :       {
    1590    31388296 :         long i, s=st[sp-1];
    1591    31388296 :         st_alloc(operand);
    1592    62786172 :         for(i=1;i<=operand;i++)
    1593    31397876 :           st[sp++]=s;
    1594             :       }
    1595    31388296 :       break;
    1596             :     }
    1597             :   }
    1598             :   if (0)
    1599             :   {
    1600      295039 : endeval:
    1601      295039 :     sp = saved_sp;
    1602      295039 :     for(  ; rp>saved_rp ;  )
    1603             :     {
    1604           0 :       gp_pointer *g = &ptrs[--rp];
    1605           0 :       clone_unlock_deep(g->ox);
    1606             :     }
    1607             :   }
    1608   312287877 :   s_prec.n = saved_prec;
    1609   312287877 :   s_trace.n--;
    1610   312287877 :   restore_vars(nbmvar, nblvar, nblock);
    1611   311977143 :   clone_unlock(C);
    1612   311945173 : }
    1613             : 
    1614             : GEN
    1615    34028660 : closure_evalgen(GEN C)
    1616             : {
    1617    34028660 :   pari_sp ltop=avma;
    1618    34028660 :   closure_eval(C);
    1619    33992445 :   if (br_status) return gc_NULL(ltop);
    1620    33992383 :   return gerepileupto(ltop,gel(st,--sp));
    1621             : }
    1622             : 
    1623             : long
    1624      885695 : evalstate_get_trace(void)
    1625      885695 : { return s_trace.n; }
    1626             : 
    1627             : void
    1628          18 : evalstate_set_trace(long lvl)
    1629          18 : { s_trace.n = lvl; }
    1630             : 
    1631             : void
    1632     1414953 : evalstate_save(struct pari_evalstate *state)
    1633             : {
    1634     1414953 :   state->avma = avma;
    1635     1414953 :   state->sp   = sp;
    1636     1414953 :   state->rp   = rp;
    1637     1414953 :   state->prec = s_prec.n;
    1638     1414953 :   state->var  = s_var.n;
    1639     1414953 :   state->lvars= s_lvars.n;
    1640     1414953 :   state->locks= s_locks.n;
    1641     1414953 :   state->trace= s_trace.n;
    1642     1414953 :   compilestate_save(&state->comp);
    1643     1414953 :   mtstate_save(&state->mt);
    1644     1414953 : }
    1645             : 
    1646             : void
    1647       48562 : evalstate_restore(struct pari_evalstate *state)
    1648             : {
    1649       48562 :   set_avma(state->avma);
    1650       48562 :   mtstate_restore(&state->mt);
    1651       48562 :   sp = state->sp;
    1652       48562 :   rp = state->rp;
    1653       48562 :   s_prec.n = state->prec;
    1654       48562 :   restore_vars(s_var.n-state->var, s_lvars.n-state->lvars,
    1655       48562 :                s_locks.n-state->locks);
    1656       48562 :   restore_trace(s_trace.n-state->trace);
    1657       48562 :   reset_break();
    1658       48562 :   compilestate_restore(&state->comp);
    1659       48562 : }
    1660             : 
    1661             : GEN
    1662       36201 : evalstate_restore_err(struct pari_evalstate *state)
    1663             : {
    1664       36201 :   GENbin* err = copy_bin(pari_err_last());
    1665       36201 :   evalstate_restore(state);
    1666       36201 :   return bin_copy(err);
    1667             : }
    1668             : 
    1669             : void
    1670         431 : evalstate_reset(void)
    1671             : {
    1672         431 :   mtstate_reset();
    1673         431 :   restore_vars(s_var.n, s_lvars.n, s_locks.n);
    1674         431 :   sp = rp = dbg_level = s_trace.n = 0;
    1675         431 :   reset_break();
    1676         431 :   compilestate_reset();
    1677         431 :   parsestate_reset();
    1678         431 :   set_avma(pari_mainstack->top);
    1679         431 : }
    1680             : 
    1681             : void
    1682           0 : evalstate_clone(void)
    1683             : {
    1684             :   long i;
    1685           0 :   for (i = 1; i<=s_var.n; i++) copylex(-i);
    1686           0 :   lvar_make_safe();
    1687           0 :   for (i = 0; i< s_trace.n; i++)
    1688             :   {
    1689           0 :     GEN C = trace[i].closure;
    1690           0 :     if (isonstack(C)) trace[i].closure = gclone(C);
    1691             :   }
    1692           0 : }
    1693             : 
    1694             : GEN
    1695          21 : closure_trapgen(GEN C, long numerr)
    1696             : {
    1697             :   VOLATILE GEN x;
    1698             :   struct pari_evalstate state;
    1699          21 :   evalstate_save(&state);
    1700          21 :   pari_CATCH(numerr) { x = (GEN)1L; }
    1701          21 :   pari_TRY { x = closure_evalgen(C); } pari_ENDCATCH;
    1702          14 :   if (x == (GEN)1L) evalstate_restore(&state);
    1703          14 :   return x;
    1704             : }
    1705             : 
    1706             : GEN
    1707    75793444 : closure_evalnobrk(GEN C)
    1708             : {
    1709    75793444 :   pari_sp ltop=avma;
    1710    75793444 :   closure_eval(C);
    1711    75793423 :   if (br_status) pari_err(e_MISC, "break not allowed here");
    1712    75793416 :   return gerepileupto(ltop,gel(st,--sp));
    1713             : }
    1714             : 
    1715             : void
    1716   152611045 : closure_evalvoid(GEN C)
    1717             : {
    1718   152611045 :   pari_sp ltop=avma;
    1719   152611045 :   closure_eval(C);
    1720   152615350 :   set_avma(ltop);
    1721   152592513 : }
    1722             : 
    1723             : GEN
    1724      928112 : closure_evalres(GEN C)
    1725             : {
    1726      928112 :   return closure_return(C);
    1727             : }
    1728             : 
    1729             : INLINE GEN
    1730    13206171 : closure_returnupto(GEN C)
    1731             : {
    1732    13206171 :   pari_sp av=avma;
    1733    13206171 :   return copyupto(closure_return(C),(GEN)av);
    1734             : }
    1735             : 
    1736             : GEN
    1737          12 : pareval_worker(GEN C)
    1738             : {
    1739          12 :   return closure_callgenall(C, 0);
    1740             : }
    1741             : 
    1742             : GEN
    1743           6 : pareval(GEN C)
    1744             : {
    1745           6 :   pari_sp av = avma;
    1746           6 :   long l = lg(C), i;
    1747             :   GEN worker;
    1748           6 :   if (!is_vec_t(typ(C))) pari_err_TYPE("pareval",C);
    1749          18 :   for (i=1; i<l; i++)
    1750          12 :     if (typ(gel(C,i))!=t_CLOSURE)
    1751           0 :       pari_err_TYPE("pareval",gel(C,i));
    1752           6 :   worker = snm_closure(is_entry("_pareval_worker"), NULL);
    1753           6 :   return gerepileupto(av, gen_parapply(worker, C));
    1754             : }
    1755             : 
    1756             : GEN
    1757         630 : parvector_worker(GEN i, GEN C)
    1758             : {
    1759         630 :   return closure_callgen1(C, i);
    1760             : }
    1761             : 
    1762             : GEN
    1763        9608 : parfor_worker(GEN i, GEN C)
    1764             : {
    1765        9608 :   retmkvec2(gcopy(i), closure_callgen1(C, i));
    1766             : }
    1767             : 
    1768             : GEN
    1769          31 : parvector(long n, GEN code)
    1770             : {
    1771          31 :   long i, pending = 0, workid;
    1772          31 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1773             :   GEN a, V, done;
    1774             :   struct pari_mt pt;
    1775          31 :   mt_queue_start_lim(&pt, worker, n);
    1776          31 :   a = mkvec(cgetipos(3)); /* left on the stack */
    1777          31 :   V = cgetg(n+1, t_VEC);
    1778         622 :   for (i=1; i<=n || pending; i++)
    1779             :   {
    1780         597 :     mael(a,1,2) = i;
    1781         597 :     mt_queue_submit(&pt, i, i<=n? a: NULL);
    1782         593 :     done = mt_queue_get(&pt, &workid, &pending);
    1783         591 :     if (done) gel(V,workid) = done;
    1784             :   }
    1785          25 :   mt_queue_end(&pt);
    1786          25 :   return V;
    1787             : }
    1788             : 
    1789             : /* suitable for gerepileupto */
    1790             : GEN
    1791        7452 : parsum_slice_worker(GEN a, GEN b, GEN m, GEN worker)
    1792             : {
    1793        7452 :   pari_sp av = avma;
    1794        7452 :   GEN s = gen_0;
    1795      135056 :   while (gcmp(a,b)<=0)
    1796             :   {
    1797      127400 :     s = gadd(s, closure_callgen1(worker, a));
    1798      127430 :     a = addii(a, m);
    1799      127604 :     if (gc_needed(av,1))
    1800             :     {
    1801           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"parsum_slice");
    1802           0 :       gerepileall(av,2,&a,&s);
    1803             :     }
    1804             :   }
    1805        7376 :   return gerepileupto(av,s);
    1806             : }
    1807             : 
    1808             : GEN
    1809        2034 : parsum(GEN a, GEN b, GEN code)
    1810             : {
    1811        2034 :   pari_sp av = avma;
    1812             :   GEN worker, mG, v, s, N;
    1813             :   long r, m, pending;
    1814             :   struct pari_mt pt;
    1815             :   pari_sp av2;
    1816             : 
    1817        2034 :   if (typ(a) != t_INT) pari_err_TYPE("parsum",a);
    1818        2034 :   if (gcmp(b,a) < 0) return gen_0;
    1819        2034 :   b = gfloor(b);
    1820        2034 :   N = addiu(subii(b, a), 1);
    1821        2034 :   mG = sqrti(N);
    1822        2034 :   m = itou(mG);
    1823        2034 :   worker = snm_closure(is_entry("_parsum_slice_worker"), mkvec3(b,mG,code));
    1824        2034 :   mt_queue_start_lim(&pt, worker, m);
    1825        2034 :   s = gen_0; a = setloop(a); v = mkvec(a); pending = 0; av2 = avma;
    1826       12003 :   for (r = 1; r <= m || pending; r++)
    1827             :   {
    1828             :     long workid;
    1829             :     GEN done;
    1830        9990 :     mt_queue_submit(&pt, 0, r <= m? v: NULL);
    1831        9972 :     done = mt_queue_get(&pt, &workid, &pending);
    1832        9969 :     if (done)
    1833             :     {
    1834        7476 :       s = gadd(s, done);
    1835        7476 :       if (gc_needed(av2,1))
    1836             :       {
    1837           0 :         if (DEBUGMEM>1) pari_warn(warnmem,"parsum");
    1838           0 :         s = gerepileupto(av2,s);
    1839             :       }
    1840             :     }
    1841        9969 :     a = incloop(a); gel(v,1) = a;
    1842             :   }
    1843        2013 :   mt_queue_end(&pt); return gerepileupto(av, s);
    1844             : }
    1845             : 
    1846             : void
    1847         346 : parfor(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1848             : {
    1849         346 :   pari_sp av = avma, av2;
    1850         346 :   long running, pending = 0, lim;
    1851         346 :   long status = br_NONE;
    1852         346 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1853         346 :   GEN done, stop = NULL;
    1854             :   struct pari_mt pt;
    1855         346 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1856         346 :   if (b)
    1857             :   {
    1858         346 :     if (gcmp(b,a) < 0) return;
    1859         346 :     if (typ(b) == t_INFINITY)
    1860             :     {
    1861           6 :       if (inf_get_sign(b) < 0) return;
    1862           6 :       b = NULL;
    1863             :     }
    1864             :     else
    1865         340 :       b = gfloor(b);
    1866             :   }
    1867         346 :   lim = b ? itos_or_0(subii(addis(b,1),a)): 0;
    1868         346 :   mt_queue_start_lim(&pt, worker, lim);
    1869         346 :   a = mkvec(setloop(a));
    1870         346 :   av2 = avma;
    1871        7498 :   while ((running = (!stop && (!b || cmpii(gel(a,1),b) <= 0))) || pending)
    1872             :   {
    1873        7158 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1874        7154 :     done = mt_queue_get(&pt, NULL, &pending);
    1875        7152 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1876        5443 :       if (call(E, gel(done,1), gel(done,2)))
    1877             :       {
    1878         223 :         status = br_status;
    1879         223 :         br_status = br_NONE;
    1880         223 :         stop = gerepileuptoint(av2, gel(done,1));
    1881             :       }
    1882        7152 :     gel(a,1) = incloop(gel(a,1));
    1883        7152 :     if (!stop) set_avma(av2);
    1884             :   }
    1885         340 :   set_avma(av2);
    1886         340 :   mt_queue_end(&pt);
    1887         340 :   br_status = status;
    1888         340 :   set_avma(av);
    1889             : }
    1890             : 
    1891             : static void
    1892           0 : parforiter_init(struct parfor_iter *T, GEN code)
    1893             : {
    1894           0 :   T->pending = 0;
    1895           0 :   T->worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1896           0 :   mt_queue_start(&T->pt, T->worker);
    1897           0 : }
    1898             : 
    1899             : static GEN
    1900           0 : parforiter_next(struct parfor_iter *T, GEN v)
    1901             : {
    1902           0 :   mt_queue_submit(&T->pt, 0, v);
    1903           0 :   return mt_queue_get(&T->pt, NULL, &T->pending);
    1904             : }
    1905             : 
    1906             : static void
    1907           0 : parforiter_stop(struct parfor_iter *T)
    1908             : {
    1909           0 :   while (T->pending)
    1910             :   {
    1911           0 :     mt_queue_submit(&T->pt, 0, NULL);
    1912           0 :     (void) mt_queue_get(&T->pt, NULL, &T->pending);
    1913             :   }
    1914           0 :   mt_queue_end(&T->pt);
    1915           0 : }
    1916             : 
    1917             : void
    1918           0 : parfor_init(parfor_t *T, GEN a, GEN b, GEN code)
    1919             : {
    1920           0 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1921           0 :   T->b = b ? gfloor(b): NULL;
    1922           0 :   T->a = mkvec(setloop(a));
    1923           0 :   parforiter_init(&T->iter, code);
    1924           0 : }
    1925             : 
    1926             : GEN
    1927           0 : parfor_next(parfor_t *T)
    1928             : {
    1929             :   long running;
    1930           0 :   while ((running=((!T->b || cmpii(gel(T->a,1),T->b) <= 0))) || T->iter.pending)
    1931             :   {
    1932           0 :     GEN done = parforiter_next(&T->iter, running ? T->a: NULL);
    1933           0 :     gel(T->a,1) = incloop(gel(T->a,1));
    1934           0 :     if (done) return done;
    1935             :   }
    1936           0 :   mt_queue_end(&T->iter.pt);
    1937           0 :   return NULL;
    1938             : }
    1939             : 
    1940             : void
    1941           0 : parfor_stop(parfor_t *T) { parforiter_stop(&T->iter); }
    1942             : 
    1943             : static long
    1944        8445 : gp_evalvoid2(void *E, GEN x, GEN y)
    1945             : {
    1946        8445 :   GEN code =(GEN) E;
    1947        8445 :   push_lex(x, code);
    1948        8445 :   push_lex(y, NULL);
    1949        8445 :   closure_evalvoid(code);
    1950        8445 :   pop_lex(2);
    1951        8445 :   return loop_break();
    1952             : }
    1953             : 
    1954             : void
    1955         346 : parfor0(GEN a, GEN b, GEN code, GEN code2)
    1956             : {
    1957         346 :   parfor(a, b, code, (void*)code2, code2 ? gp_evalvoid2: NULL);
    1958         340 : }
    1959             : 
    1960           0 : static int negcmp(GEN x, GEN y) { return gcmp(y,x); }
    1961             : 
    1962             : void
    1963          39 : parforstep(GEN a, GEN b, GEN s, GEN code, void *E, long call(void*, GEN, GEN))
    1964             : {
    1965          39 :   pari_sp av = avma;
    1966          39 :   long running, pending = 0;
    1967          39 :   long status = br_NONE;
    1968          39 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1969          39 :   GEN done, stop = NULL;
    1970             :   struct pari_mt pt;
    1971             :   long i, ss;
    1972          39 :   GEN v = NULL, lim;
    1973             :   int (*cmp)(GEN,GEN);
    1974             : 
    1975          39 :   b = gcopy(b);
    1976          39 :   s = gcopy(s); av = avma;
    1977          39 :   switch(typ(s))
    1978             :   {
    1979          13 :     case t_VEC: case t_COL:
    1980             :     {
    1981          13 :       GEN vs = vecsum(s);
    1982          13 :       ss = gsigne(vs); v = s;
    1983          13 :       lim = gdiv(gmulgs(gadd(gsub(b,a),vs),lg(vs)-1),vs);
    1984          13 :       break;
    1985             :     }
    1986          13 :     case t_INTMOD:
    1987          13 :       if (typ(a) != t_INT) a = gceil(a);
    1988          13 :       a = addii(a, modii(subii(gel(s,2),a), gel(s,1)));
    1989          13 :       s = gel(s,1); /* FALL THROUGH */
    1990          26 :     default:
    1991          26 :       ss = gsigne(s);
    1992          26 :       lim = gdiv(gadd(gsub(b,a),s),s);
    1993             :   }
    1994          39 :   lim = ceil_safe(lim);
    1995          39 :   if (!ss || typ(lim)!=t_INT) pari_err_DOMAIN("parforstep","step","=",gen_0,s);
    1996          39 :   if (signe(lim)<=0) { set_avma(av); return; }
    1997          39 :   cmp = (ss > 0)? &gcmp: &negcmp;
    1998          39 :   i = 0;
    1999          39 :   a = mkvec(a);
    2000          39 :   mt_queue_start_lim(&pt, worker, itou_or_0(lim));
    2001        2695 :   while ((running = (!stop && (!b || cmp(gel(a,1),b) <= 0))) || pending)
    2002             :   {
    2003        2656 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    2004        2656 :     done = mt_queue_get(&pt, NULL, &pending);
    2005        2656 :     if (call && done && (!stop || cmp(gel(done,1),stop) < 0))
    2006        2521 :       if (call(E, gel(done,1), gel(done,2)))
    2007             :       {
    2008           0 :         status = br_status;
    2009           0 :         br_status = br_NONE;
    2010           0 :         stop = gel(done,1);
    2011             :       }
    2012        2656 :     if (running)
    2013             :     {
    2014        2521 :       if (v)
    2015             :       {
    2016        1637 :         if (++i >= lg(v)) i = 1;
    2017        1637 :         s = gel(v,i);
    2018             :       }
    2019        2521 :       gel(a,1) = gadd(gel(a,1),s);
    2020             :     }
    2021             :   }
    2022          39 :   mt_queue_end(&pt);
    2023          39 :   br_status = status;
    2024          39 :   set_avma(av);
    2025             : }
    2026             : 
    2027             : void
    2028          39 : parforstep0(GEN a, GEN b, GEN s, GEN code, GEN code2)
    2029             : {
    2030          39 :   parforstep(a, b, s, code, (void*)code2, code2 ? gp_evalvoid2: NULL);
    2031          39 : }
    2032             : 
    2033             : void
    2034           0 : parforstep_init(parforstep_t *T, GEN a, GEN b, GEN s, GEN code)
    2035             : {
    2036             :   long ss;
    2037           0 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    2038           0 :   switch(typ(s))
    2039             :   {
    2040           0 :     case t_VEC: case t_COL:
    2041           0 :       ss = gsigne(vecsum(s));
    2042           0 :       break;
    2043           0 :     case t_INTMOD:
    2044           0 :       if (typ(a) != t_INT) a = gceil(a);
    2045           0 :       a = addii(a, modii(subii(gel(s,2),a), gel(s,1)));
    2046           0 :       s = gel(s,1);
    2047           0 :     default: /* FALL THROUGH */
    2048           0 :       ss = gsigne(s);
    2049             :   }
    2050           0 :   T->cmp = (ss > 0)? &gcmp: &negcmp;
    2051           0 :   T->s = s;
    2052           0 :   T->i = 0;
    2053           0 :   T->b = b;
    2054           0 :   T->a = mkvec(a);
    2055           0 :   parforiter_init(&T->iter, code);
    2056           0 : }
    2057             : 
    2058             : GEN
    2059           0 : parforstep_next(parforstep_t *T)
    2060             : {
    2061             :   long running;
    2062           0 :   while ((running=((!T->b || T->cmp(gel(T->a,1),T->b) <= 0))) || T->iter.pending)
    2063             :   {
    2064           0 :     GEN done = parforiter_next(&T->iter, running ? T->a: NULL);
    2065           0 :     if (running)
    2066             :     {
    2067           0 :       if (is_vec_t(typ(T->s)))
    2068             :       {
    2069           0 :         if (++(T->i) >= lg(T->s)) T->i = 1;
    2070           0 :         gel(T->a,1) = gadd(gel(T->a,1), gel(T->s,T->i));
    2071             :       }
    2072           0 :       else gel(T->a,1) = gadd(gel(T->a,1), T->s);
    2073             :     }
    2074           0 :     if (done) return done;
    2075             :   }
    2076           0 :   mt_queue_end(&T->iter.pt);
    2077           0 :   return NULL;
    2078             : }
    2079             : 
    2080             : void
    2081           0 : parforstep_stop(parforstep_t *T) { parforiter_stop(&T->iter); }
    2082             : 
    2083             : void
    2084           0 : parforprimestep_init(parforprime_t *T, GEN a, GEN b, GEN q, GEN code)
    2085             : {
    2086           0 :   forprimestep_init(&T->forprime, a, b, q);
    2087           0 :   T->v = mkvec(gen_0);
    2088           0 :   parforiter_init(&T->iter, code);
    2089           0 : }
    2090             : 
    2091             : void
    2092           0 : parforprime_init(parforprime_t *T, GEN a, GEN b, GEN code)
    2093           0 : { parforprimestep_init(T, a, b, NULL, code); }
    2094             : 
    2095             : GEN
    2096           0 : parforprime_next(parforprime_t *T)
    2097             : {
    2098             :   long running;
    2099           0 :   while ((running = !!forprime_next(&T->forprime)) || T->iter.pending)
    2100             :   {
    2101             :     GEN done;
    2102           0 :     gel(T->v, 1) = T->forprime.pp;
    2103           0 :     done = parforiter_next(&T->iter, running ? T->v: NULL);
    2104           0 :     if (done) return done;
    2105             :   }
    2106           0 :   mt_queue_end(&T->iter.pt);
    2107           0 :   return NULL;
    2108             : }
    2109             : 
    2110             : void
    2111           0 : parforprime_stop(parforprime_t *T) { parforiter_stop(&T->iter); }
    2112             : 
    2113             : void
    2114          20 : parforprimestep(GEN a, GEN b, GEN q, GEN code, void *E, long call(void*, GEN, GEN))
    2115             : {
    2116          20 :   pari_sp av = avma, av2;
    2117          20 :   long running, pending = 0;
    2118          20 :   long status = br_NONE;
    2119          20 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    2120          20 :   GEN v, done, stop = NULL;
    2121             :   struct pari_mt pt;
    2122             :   forprime_t T;
    2123             : 
    2124          20 :   if (!forprimestep_init(&T, a,b,q)) { set_avma(av); return; }
    2125          20 :   mt_queue_start(&pt, worker);
    2126          20 :   v = mkvec(gen_0);
    2127          20 :   av2 = avma;
    2128         172 :   while ((running = (!stop && forprime_next(&T))) || pending)
    2129             :   {
    2130         152 :     gel(v, 1) = T.pp;
    2131         152 :     mt_queue_submit(&pt, 0, running ? v: NULL);
    2132         152 :     done = mt_queue_get(&pt, NULL, &pending);
    2133         152 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    2134         125 :       if (call(E, gel(done,1), gel(done,2)))
    2135             :       {
    2136           0 :         status = br_status;
    2137           0 :         br_status = br_NONE;
    2138           0 :         stop = gerepileuptoint(av2, gel(done,1));
    2139             :       }
    2140         152 :     if (!stop) set_avma(av2);
    2141             :   }
    2142          20 :   set_avma(av2);
    2143          20 :   mt_queue_end(&pt);
    2144          20 :   br_status = status;
    2145          20 :   set_avma(av);
    2146             : }
    2147             : 
    2148             : void
    2149          13 : parforprime(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    2150             : {
    2151          13 :   parforprimestep(a, b, NULL, code, E, call);
    2152          13 : }
    2153             : 
    2154             : void
    2155          13 : parforprime0(GEN a, GEN b, GEN code, GEN code2)
    2156             : {
    2157          13 :   parforprime(a, b, code, (void*)code2, code2? gp_evalvoid2: NULL);
    2158          13 : }
    2159             : 
    2160             : void
    2161           7 : parforprimestep0(GEN a, GEN b, GEN q, GEN code, GEN code2)
    2162             : {
    2163           7 :   parforprimestep(a, b, q, code, (void*)code2, code2? gp_evalvoid2: NULL);
    2164           7 : }
    2165             : 
    2166             : void
    2167           0 : parforvec_init(parforvec_t *T, GEN x, GEN code, long flag)
    2168             : {
    2169           0 :   forvec_init(&T->forvec, x, flag);
    2170           0 :   T->v = mkvec(gen_0);
    2171           0 :   parforiter_init(&T->iter, code);
    2172           0 : }
    2173             : 
    2174             : GEN
    2175           0 : parforvec_next(parforvec_t *T)
    2176             : {
    2177           0 :   GEN v = gen_0;
    2178           0 :   while ((v = forvec_next(&T->forvec)) || T->iter.pending)
    2179             :   {
    2180             :     GEN done;
    2181           0 :     if (v) gel(T->v, 1) = v;
    2182           0 :     done = parforiter_next(&T->iter, v ? T->v: NULL);
    2183           0 :     if (done) return done;
    2184             :   }
    2185           0 :   mt_queue_end(&T->iter.pt);
    2186           0 :   return NULL;
    2187             : }
    2188             : 
    2189             : void
    2190           0 : parforvec_stop(parforvec_t *T) { parforiter_stop(&T->iter); }
    2191             : 
    2192             : void
    2193          39 : parforvec(GEN x, GEN code, long flag, void *E, long call(void*, GEN, GEN))
    2194             : {
    2195          39 :   pari_sp av = avma, av2;
    2196          39 :   long running, pending = 0;
    2197          39 :   long status = br_NONE;
    2198          39 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    2199          39 :   GEN done, stop = NULL;
    2200             :   struct pari_mt pt;
    2201             :   forvec_t T;
    2202          39 :   GEN a, v = gen_0;
    2203             : 
    2204          39 :   if (!forvec_init(&T, x, flag)) { set_avma(av); return; }
    2205          39 :   mt_queue_start(&pt, worker);
    2206          39 :   a = mkvec(gen_0);
    2207          39 :   av2 = avma;
    2208         415 :   while ((running = (!stop && v && (v = forvec_next(&T)))) || pending)
    2209             :   {
    2210         376 :     gel(a, 1) = v;
    2211         376 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    2212         376 :     done = mt_queue_get(&pt, NULL, &pending);
    2213         376 :     if (call && done && (!stop || lexcmp(gel(done,1),stop) < 0))
    2214         300 :       if (call(E, gel(done,1), gel(done,2)))
    2215             :       {
    2216           0 :         status = br_status;
    2217           0 :         br_status = br_NONE;
    2218           0 :         stop = gerepilecopy(av2, gel(done,1));
    2219             :       }
    2220         376 :     if (!stop) set_avma(av2);
    2221             :   }
    2222          39 :   set_avma(av2);
    2223          39 :   mt_queue_end(&pt);
    2224          39 :   br_status = status;
    2225          39 :   set_avma(av);
    2226             : }
    2227             : 
    2228             : void
    2229          39 : parforvec0(GEN x, GEN code, GEN code2, long flag)
    2230             : {
    2231          39 :   parforvec(x, code, flag, (void*)code2, code2? gp_evalvoid2: NULL);
    2232          39 : }
    2233             : 
    2234             : void
    2235           0 : parforeach_init(parforeach_t *T, GEN x, GEN code)
    2236             : {
    2237           0 :   switch(typ(x))
    2238             :   {
    2239           0 :     case t_LIST:
    2240           0 :       x = list_data(x); /* FALL THROUGH */
    2241           0 :       if (!x) return;
    2242             :     case t_MAT: case t_VEC: case t_COL:
    2243           0 :       break;
    2244           0 :     default:
    2245           0 :       pari_err_TYPE("foreach",x);
    2246             :       return; /*LCOV_EXCL_LINE*/
    2247             :   }
    2248           0 :   T->x = x; T->i = 1; T->l = lg(x);
    2249           0 :   T->W = mkvec(gen_0);
    2250           0 :   T->iter.pending = 0;
    2251           0 :   T->iter.worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    2252           0 :   mt_queue_start(&T->iter.pt, T->iter.worker);
    2253             : }
    2254             : 
    2255             : GEN
    2256           0 : parforeach_next(parforeach_t *T)
    2257             : {
    2258           0 :   while (T->i < T->l || T->iter.pending)
    2259             :   {
    2260             :     GEN done;
    2261             :     long workid;
    2262           0 :     if (T->i < T->l) gel(T->W,1) = gel(T->x, T->i);
    2263           0 :     mt_queue_submit(&T->iter.pt, T->i, T->i < T->l ? T->W: NULL);
    2264           0 :     T->i = minss(T->i+1, T->l);
    2265           0 :     done = mt_queue_get(&T->iter.pt, &workid, &T->iter.pending);
    2266           0 :     if (done) return mkvec2(gel(T->x,workid),done);
    2267             :   }
    2268           0 :   mt_queue_end(&T->iter.pt);
    2269           0 :   return NULL;
    2270             : }
    2271             : 
    2272             : void
    2273           0 : parforeach_stop(parforeach_t *T) { parforiter_stop(&T->iter); }
    2274             : 
    2275             : void
    2276           7 : parforeach(GEN x, GEN code, void *E, long call(void*, GEN, GEN))
    2277             : {
    2278           7 :   pari_sp av = avma, av2;
    2279           7 :   long pending = 0, n, i, stop = 0;
    2280           7 :   long status = br_NONE, workid;
    2281           7 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    2282             :   GEN done, W;
    2283             :   struct pari_mt pt;
    2284           7 :   switch(typ(x))
    2285             :   {
    2286           0 :     case t_LIST:
    2287           0 :       x = list_data(x); /* FALL THROUGH */
    2288           0 :       if (!x) return;
    2289             :     case t_MAT: case t_VEC: case t_COL:
    2290           7 :       break;
    2291           0 :     default:
    2292           0 :       pari_err_TYPE("foreach",x);
    2293             :       return; /*LCOV_EXCL_LINE*/
    2294             :   }
    2295           7 :   clone_lock(x); n = lg(x)-1;
    2296           7 :   mt_queue_start_lim(&pt, worker, n);
    2297           7 :   W = cgetg(2, t_VEC);
    2298           7 :   av2 = avma;
    2299          70 :   for (i=1; i<=n || pending; i++)
    2300             :   {
    2301          63 :     if (!stop && i <= n) gel(W,1) = gel(x,i);
    2302          63 :     mt_queue_submit(&pt, i, !stop && i<=n? W: NULL);
    2303          63 :     done = mt_queue_get(&pt, &workid, &pending);
    2304          63 :     if (call && done && (!stop || workid < stop))
    2305          56 :       if (call(E, gel(x, workid), done))
    2306             :       {
    2307           0 :         status = br_status;
    2308           0 :         br_status = br_NONE;
    2309           0 :         stop = workid;
    2310             :       }
    2311             :   }
    2312           7 :   set_avma(av2);
    2313           7 :   mt_queue_end(&pt);
    2314           7 :   clone_unlock_deep(x);
    2315           7 :   br_status = status;
    2316           7 :   set_avma(av);
    2317             : }
    2318             : 
    2319             : void
    2320           7 : parforeach0(GEN x, GEN code, GEN code2)
    2321             : {
    2322           7 :   parforeach(x, code, (void*)code2, code2? gp_evalvoid2: NULL);
    2323           7 : }
    2324             : 
    2325             : void
    2326           0 : closure_callvoid1(GEN C, GEN x)
    2327             : {
    2328           0 :   long i, ar = closure_arity(C);
    2329           0 :   gel(st,sp++) = x;
    2330           0 :   for(i=2; i <= ar; i++) gel(st,sp++) = NULL;
    2331           0 :   closure_evalvoid(C);
    2332           0 : }
    2333             : 
    2334             : GEN
    2335           7 : closure_callgen0(GEN C)
    2336             : {
    2337             :   GEN z;
    2338           7 :   long i, ar = closure_arity(C);
    2339           7 :   for(i=1; i<= ar; i++) gel(st,sp++) = NULL;
    2340           7 :   z = closure_returnupto(C);
    2341           7 :   return z;
    2342             : }
    2343             : 
    2344             : GEN
    2345         168 : closure_callgen0prec(GEN C, long prec)
    2346             : {
    2347             :   GEN z;
    2348         168 :   long i, ar = closure_arity(C);
    2349         168 :   for(i=1; i<= ar; i++) gel(st,sp++) = NULL;
    2350         168 :   push_localprec(prec);
    2351         168 :   z = closure_returnupto(C);
    2352         168 :   pop_localprec();
    2353         168 :   return z;
    2354             : }
    2355             : 
    2356             : GEN
    2357     8535098 : closure_callgen1(GEN C, GEN x)
    2358             : {
    2359     8535098 :   long i, ar = closure_arity(C);
    2360     8534902 :   gel(st,sp++) = x;
    2361     8624621 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    2362     8534902 :   return closure_returnupto(C);
    2363             : }
    2364             : 
    2365             : GEN
    2366       76751 : closure_callgen1prec(GEN C, GEN x, long prec)
    2367             : {
    2368             :   GEN z;
    2369       76751 :   long i, ar = closure_arity(C);
    2370       76751 :   gel(st,sp++) = x;
    2371       76765 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    2372       76751 :   push_localprec(prec);
    2373       76751 :   z = closure_returnupto(C);
    2374       76751 :   pop_localprec();
    2375       76751 :   return z;
    2376             : }
    2377             : 
    2378             : GEN
    2379       67073 : closure_callgen2(GEN C, GEN x, GEN y)
    2380             : {
    2381       67073 :   long i, ar = closure_arity(C);
    2382       67073 :   st_alloc(ar);
    2383       67073 :   gel(st,sp++) = x;
    2384       67073 :   gel(st,sp++) = y;
    2385       67073 :   for(i=3; i<=ar; i++) gel(st,sp++) = NULL;
    2386       67073 :   return closure_returnupto(C);
    2387             : }
    2388             : 
    2389             : GEN
    2390     4528111 : closure_callgenvec(GEN C, GEN args)
    2391             : {
    2392     4528111 :   long i, l = lg(args)-1, ar = closure_arity(C);
    2393     4527989 :   st_alloc(ar);
    2394     4527940 :   if (l > ar)
    2395           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2396     4527940 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    2397           7 :     pari_err_TYPE("call", gel(args,l));
    2398     9093119 :   for (i = 1; i <= l;  i++) gel(st,sp++) = gel(args,i);
    2399     4539839 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    2400     4527820 :   return closure_returnupto(C);
    2401             : }
    2402             : 
    2403             : GEN
    2404           0 : closure_callgenvecprec(GEN C, GEN args, long prec)
    2405             : {
    2406             :   GEN z;
    2407           0 :   push_localprec(prec);
    2408           0 :   z = closure_callgenvec(C, args);
    2409           0 :   pop_localprec();
    2410           0 :   return z;
    2411             : }
    2412             : 
    2413             : GEN
    2414         322 : closure_callgenvecdef(GEN C, GEN args, GEN def)
    2415             : {
    2416         322 :   long i, l = lg(args)-1, ar = closure_arity(C);
    2417         322 :   st_alloc(ar);
    2418         322 :   if (l > ar)
    2419           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2420         322 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    2421           0 :     pari_err_TYPE("call", gel(args,l));
    2422         644 :   for (i = 1; i <= l;  i++) gel(st,sp++) = def[i] ? gel(args,i): NULL;
    2423         322 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    2424         322 :   return closure_returnupto(C);
    2425             : }
    2426             : 
    2427             : GEN
    2428         322 : closure_callgenvecdefprec(GEN C, GEN args, GEN def, long prec)
    2429             : {
    2430             :   GEN z;
    2431         322 :   push_localprec(prec);
    2432         322 :   z = closure_callgenvecdef(C, args, def);
    2433         322 :   pop_localprec();
    2434         322 :   return z;
    2435             : }
    2436             : GEN
    2437          12 : closure_callgenall(GEN C, long n, ...)
    2438             : {
    2439             :   va_list ap;
    2440          12 :   long i, ar = closure_arity(C);
    2441          12 :   va_start(ap,n);
    2442          12 :   if (n > ar)
    2443           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    2444          12 :   st_alloc(ar);
    2445          12 :   for (i = 1; i <=n;  i++) gel(st,sp++) = va_arg(ap, GEN);
    2446          12 :   for(      ; i <=ar; i++) gel(st,sp++) = NULL;
    2447          12 :   va_end(ap);
    2448          12 :   return closure_returnupto(C);
    2449             : }
    2450             : 
    2451             : GEN
    2452    39500634 : gp_eval(void *E, GEN x)
    2453             : {
    2454    39500634 :   GEN code = (GEN)E;
    2455    39500634 :   set_lex(-1,x);
    2456    39500634 :   return closure_evalnobrk(code);
    2457             : }
    2458             : 
    2459             : GEN
    2460     1873723 : gp_evalupto(void *E, GEN x)
    2461             : {
    2462     1873723 :   pari_sp av = avma;
    2463     1873723 :   return copyupto(gp_eval(E,x), (GEN)av);
    2464             : }
    2465             : 
    2466             : GEN
    2467       20734 : gp_evalprec(void *E, GEN x, long prec)
    2468             : {
    2469             :   GEN z;
    2470       20734 :   push_localprec(prec);
    2471       20734 :   z = gp_eval(E, x);
    2472       20734 :   pop_localprec();
    2473       20734 :   return z;
    2474             : }
    2475             : 
    2476             : long
    2477    26165027 : gp_evalbool(void *E, GEN x)
    2478    26165027 : { pari_sp av = avma; return gc_long(av, !gequal0(gp_eval(E,x))); }
    2479             : 
    2480             : long
    2481     3693816 : gp_evalvoid(void *E, GEN x)
    2482             : {
    2483     3693816 :   GEN code = (GEN)E;
    2484     3693816 :   set_lex(-1,x);
    2485     3693816 :   closure_evalvoid(code);
    2486     3693816 :   return loop_break();
    2487             : }
    2488             : 
    2489             : GEN
    2490      111994 : gp_call(void *E, GEN x)
    2491             : {
    2492      111994 :   GEN code = (GEN)E;
    2493      111994 :   return closure_callgen1(code, x);
    2494             : }
    2495             : 
    2496             : GEN
    2497       23548 : gp_callprec(void *E, GEN x, long prec)
    2498             : {
    2499       23548 :   GEN code = (GEN)E;
    2500       23548 :   return closure_callgen1prec(code, x, prec);
    2501             : }
    2502             : 
    2503             : GEN
    2504          91 : gp_call2(void *E, GEN x, GEN y)
    2505             : {
    2506          91 :   GEN code = (GEN)E;
    2507          91 :   return closure_callgen2(code, x, y);
    2508             : }
    2509             : 
    2510             : long
    2511      872130 : gp_callbool(void *E, GEN x)
    2512             : {
    2513      872130 :   pari_sp av = avma;
    2514      872130 :   GEN code = (GEN)E;
    2515      872130 :   return gc_long(av, !gequal0(closure_callgen1(code, x)));
    2516             : }
    2517             : 
    2518             : long
    2519           0 : gp_callvoid(void *E, GEN x)
    2520             : {
    2521           0 :   GEN code = (GEN)E;
    2522           0 :   closure_callvoid1(code, x);
    2523           0 :   return loop_break();
    2524             : }
    2525             : 
    2526             : INLINE const char *
    2527           0 : disassemble_cast(long mode)
    2528             : {
    2529           0 :   switch (mode)
    2530             :   {
    2531           0 :   case Gsmall:
    2532           0 :     return "small";
    2533           0 :   case Ggen:
    2534           0 :     return "gen";
    2535           0 :   case Gvar:
    2536           0 :     return "var";
    2537           0 :   case Gvoid:
    2538           0 :     return "void";
    2539           0 :   default:
    2540           0 :     return "unknown";
    2541             :   }
    2542             : }
    2543             : 
    2544             : void
    2545           0 : closure_disassemble(GEN C)
    2546             : {
    2547             :   const char * code;
    2548             :   GEN oper;
    2549             :   long i;
    2550           0 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("disassemble",C);
    2551           0 :   code=closure_codestr(C);
    2552           0 :   oper=closure_get_oper(C);
    2553           0 :   for(i=1;i<lg(oper);i++)
    2554             :   {
    2555           0 :     op_code opcode=(op_code) code[i];
    2556           0 :     long operand=oper[i];
    2557           0 :     pari_printf("%05ld\t",i);
    2558           0 :     switch(opcode)
    2559             :     {
    2560           0 :     case OCpushlong:
    2561           0 :       pari_printf("pushlong\t%ld\n",operand);
    2562           0 :       break;
    2563           0 :     case OCpushgnil:
    2564           0 :       pari_printf("pushgnil\n");
    2565           0 :       break;
    2566           0 :     case OCpushgen:
    2567           0 :       pari_printf("pushgen\t\t%ld\n",operand);
    2568           0 :       break;
    2569           0 :     case OCpushreal:
    2570           0 :       pari_printf("pushreal\t%ld\n",operand);
    2571           0 :       break;
    2572           0 :     case OCpushstoi:
    2573           0 :       pari_printf("pushstoi\t%ld\n",operand);
    2574           0 :       break;
    2575           0 :     case OCpushvar:
    2576             :       {
    2577           0 :         entree *ep = (entree *)operand;
    2578           0 :         pari_printf("pushvar\t%s\n",ep->name);
    2579           0 :         break;
    2580             :       }
    2581           0 :     case OCpushdyn:
    2582             :       {
    2583           0 :         entree *ep = (entree *)operand;
    2584           0 :         pari_printf("pushdyn\t\t%s\n",ep->name);
    2585           0 :         break;
    2586             :       }
    2587           0 :     case OCpushlex:
    2588           0 :       pari_printf("pushlex\t\t%ld\n",operand);
    2589           0 :       break;
    2590           0 :     case OCstoredyn:
    2591             :       {
    2592           0 :         entree *ep = (entree *)operand;
    2593           0 :         pari_printf("storedyn\t%s\n",ep->name);
    2594           0 :         break;
    2595             :       }
    2596           0 :     case OCstorelex:
    2597           0 :       pari_printf("storelex\t%ld\n",operand);
    2598           0 :       break;
    2599           0 :     case OCstoreptr:
    2600           0 :       pari_printf("storeptr\n");
    2601           0 :       break;
    2602           0 :     case OCsimpleptrdyn:
    2603             :       {
    2604           0 :         entree *ep = (entree *)operand;
    2605           0 :         pari_printf("simpleptrdyn\t%s\n",ep->name);
    2606           0 :         break;
    2607             :       }
    2608           0 :     case OCsimpleptrlex:
    2609           0 :       pari_printf("simpleptrlex\t%ld\n",operand);
    2610           0 :       break;
    2611           0 :     case OCnewptrdyn:
    2612             :       {
    2613           0 :         entree *ep = (entree *)operand;
    2614           0 :         pari_printf("newptrdyn\t%s\n",ep->name);
    2615           0 :         break;
    2616             :       }
    2617           0 :     case OCnewptrlex:
    2618           0 :       pari_printf("newptrlex\t%ld\n",operand);
    2619           0 :       break;
    2620           0 :     case OCpushptr:
    2621           0 :       pari_printf("pushptr\n");
    2622           0 :       break;
    2623           0 :     case OCstackgen:
    2624           0 :       pari_printf("stackgen\t%ld\n",operand);
    2625           0 :       break;
    2626           0 :     case OCendptr:
    2627           0 :       pari_printf("endptr\t\t%ld\n",operand);
    2628           0 :       break;
    2629           0 :     case OCprecreal:
    2630           0 :       pari_printf("precreal\n");
    2631           0 :       break;
    2632           0 :     case OCbitprecreal:
    2633           0 :       pari_printf("bitprecreal\n");
    2634           0 :       break;
    2635           0 :     case OCprecdl:
    2636           0 :       pari_printf("precdl\n");
    2637           0 :       break;
    2638           0 :     case OCstoi:
    2639           0 :       pari_printf("stoi\n");
    2640           0 :       break;
    2641           0 :     case OCutoi:
    2642           0 :       pari_printf("utoi\n");
    2643           0 :       break;
    2644           0 :     case OCitos:
    2645           0 :       pari_printf("itos\t\t%ld\n",operand);
    2646           0 :       break;
    2647           0 :     case OCitou:
    2648           0 :       pari_printf("itou\t\t%ld\n",operand);
    2649           0 :       break;
    2650           0 :     case OCtostr:
    2651           0 :       pari_printf("tostr\t\t%ld\n",operand);
    2652           0 :       break;
    2653           0 :     case OCvarn:
    2654           0 :       pari_printf("varn\t\t%ld\n",operand);
    2655           0 :       break;
    2656           0 :     case OCcopy:
    2657           0 :       pari_printf("copy\n");
    2658           0 :       break;
    2659           0 :     case OCcopyifclone:
    2660           0 :       pari_printf("copyifclone\n");
    2661           0 :       break;
    2662           0 :     case OCcompo1:
    2663           0 :       pari_printf("compo1\t\t%s\n",disassemble_cast(operand));
    2664           0 :       break;
    2665           0 :     case OCcompo1ptr:
    2666           0 :       pari_printf("compo1ptr\n");
    2667           0 :       break;
    2668           0 :     case OCcompo2:
    2669           0 :       pari_printf("compo2\t\t%s\n",disassemble_cast(operand));
    2670           0 :       break;
    2671           0 :     case OCcompo2ptr:
    2672           0 :       pari_printf("compo2ptr\n");
    2673           0 :       break;
    2674           0 :     case OCcompoC:
    2675           0 :       pari_printf("compoC\n");
    2676           0 :       break;
    2677           0 :     case OCcompoCptr:
    2678           0 :       pari_printf("compoCptr\n");
    2679           0 :       break;
    2680           0 :     case OCcompoL:
    2681           0 :       pari_printf("compoL\n");
    2682           0 :       break;
    2683           0 :     case OCcompoLptr:
    2684           0 :       pari_printf("compoLptr\n");
    2685           0 :       break;
    2686           0 :     case OCcheckargs:
    2687           0 :       pari_printf("checkargs\t0x%lx\n",operand);
    2688           0 :       break;
    2689           0 :     case OCcheckargs0:
    2690           0 :       pari_printf("checkargs0\t0x%lx\n",operand);
    2691           0 :       break;
    2692           0 :     case OCcheckuserargs:
    2693           0 :       pari_printf("checkuserargs\t%ld\n",operand);
    2694           0 :       break;
    2695           0 :     case OCdefaultlong:
    2696           0 :       pari_printf("defaultlong\t%ld\n",operand);
    2697           0 :       break;
    2698           0 :     case OCdefaultulong:
    2699           0 :       pari_printf("defaultulong\t%ld\n",operand);
    2700           0 :       break;
    2701           0 :     case OCdefaultgen:
    2702           0 :       pari_printf("defaultgen\t%ld\n",operand);
    2703           0 :       break;
    2704           0 :     case OCpackargs:
    2705           0 :       pari_printf("packargs\t%ld\n",operand);
    2706           0 :       break;
    2707           0 :     case OCgetargs:
    2708           0 :       pari_printf("getargs\t\t%ld\n",operand);
    2709           0 :       break;
    2710           0 :     case OCdefaultarg:
    2711           0 :       pari_printf("defaultarg\t%ld\n",operand);
    2712           0 :       break;
    2713           0 :     case OClocalvar:
    2714             :       {
    2715           0 :         entree *ep = (entree *)operand;
    2716           0 :         pari_printf("localvar\t%s\n",ep->name);
    2717           0 :         break;
    2718             :       }
    2719           0 :     case OClocalvar0:
    2720             :       {
    2721           0 :         entree *ep = (entree *)operand;
    2722           0 :         pari_printf("localvar0\t%s\n",ep->name);
    2723           0 :         break;
    2724             :       }
    2725           0 :     case OCexportvar:
    2726             :       {
    2727           0 :         entree *ep = (entree *)operand;
    2728           0 :         pari_printf("exportvar\t%s\n",ep->name);
    2729           0 :         break;
    2730             :       }
    2731           0 :     case OCunexportvar:
    2732             :       {
    2733           0 :         entree *ep = (entree *)operand;
    2734           0 :         pari_printf("unexportvar\t%s\n",ep->name);
    2735           0 :         break;
    2736             :       }
    2737           0 :     case OCcallgen:
    2738             :       {
    2739           0 :         entree *ep = (entree *)operand;
    2740           0 :         pari_printf("callgen\t\t%s\n",ep->name);
    2741           0 :         break;
    2742             :       }
    2743           0 :     case OCcallgen2:
    2744             :       {
    2745           0 :         entree *ep = (entree *)operand;
    2746           0 :         pari_printf("callgen2\t%s\n",ep->name);
    2747           0 :         break;
    2748             :       }
    2749           0 :     case OCcalllong:
    2750             :       {
    2751           0 :         entree *ep = (entree *)operand;
    2752           0 :         pari_printf("calllong\t%s\n",ep->name);
    2753           0 :         break;
    2754             :       }
    2755           0 :     case OCcallint:
    2756             :       {
    2757           0 :         entree *ep = (entree *)operand;
    2758           0 :         pari_printf("callint\t\t%s\n",ep->name);
    2759           0 :         break;
    2760             :       }
    2761           0 :     case OCcallvoid:
    2762             :       {
    2763           0 :         entree *ep = (entree *)operand;
    2764           0 :         pari_printf("callvoid\t%s\n",ep->name);
    2765           0 :         break;
    2766             :       }
    2767           0 :     case OCcalluser:
    2768           0 :       pari_printf("calluser\t%ld\n",operand);
    2769           0 :       break;
    2770           0 :     case OCvec:
    2771           0 :       pari_printf("vec\t\t%ld\n",operand);
    2772           0 :       break;
    2773           0 :     case OCcol:
    2774           0 :       pari_printf("col\t\t%ld\n",operand);
    2775           0 :       break;
    2776           0 :     case OCmat:
    2777           0 :       pari_printf("mat\t\t%ld\n",operand);
    2778           0 :       break;
    2779           0 :     case OCnewframe:
    2780           0 :       pari_printf("newframe\t%ld\n",operand);
    2781           0 :       break;
    2782           0 :     case OCsaveframe:
    2783           0 :       pari_printf("saveframe\t%ld\n", operand);
    2784           0 :       break;
    2785           0 :     case OCpop:
    2786           0 :       pari_printf("pop\t\t%ld\n",operand);
    2787           0 :       break;
    2788           0 :     case OCdup:
    2789           0 :       pari_printf("dup\t\t%ld\n",operand);
    2790           0 :       break;
    2791           0 :     case OCavma:
    2792           0 :       pari_printf("avma\n",operand);
    2793           0 :       break;
    2794           0 :     case OCgerepile:
    2795           0 :       pari_printf("gerepile\n",operand);
    2796           0 :       break;
    2797           0 :     case OCcowvardyn:
    2798             :       {
    2799           0 :         entree *ep = (entree *)operand;
    2800           0 :         pari_printf("cowvardyn\t%s\n",ep->name);
    2801           0 :         break;
    2802             :       }
    2803           0 :     case OCcowvarlex:
    2804           0 :       pari_printf("cowvarlex\t%ld\n",operand);
    2805           0 :       break;
    2806           0 :     case OCsetref:
    2807           0 :       pari_printf("setref\t\t%ld\n",operand);
    2808           0 :       break;
    2809           0 :     case OClock:
    2810           0 :       pari_printf("lock\t\t%ld\n",operand);
    2811           0 :       break;
    2812           0 :     case OCevalmnem:
    2813             :       {
    2814           0 :         entree *ep = (entree *)operand;
    2815           0 :         pari_printf("evalmnem\t%s\n",ep->name);
    2816           0 :         break;
    2817             :       }
    2818             :     }
    2819             :   }
    2820           0 : }
    2821             : 
    2822             : static int
    2823           0 : opcode_need_relink(op_code opcode)
    2824             : {
    2825           0 :   switch(opcode)
    2826             :   {
    2827           0 :   case OCpushlong:
    2828             :   case OCpushgen:
    2829             :   case OCpushgnil:
    2830             :   case OCpushreal:
    2831             :   case OCpushstoi:
    2832             :   case OCpushlex:
    2833             :   case OCstorelex:
    2834             :   case OCstoreptr:
    2835             :   case OCsimpleptrlex:
    2836             :   case OCnewptrlex:
    2837             :   case OCpushptr:
    2838             :   case OCstackgen:
    2839             :   case OCendptr:
    2840             :   case OCprecreal:
    2841             :   case OCbitprecreal:
    2842             :   case OCprecdl:
    2843             :   case OCstoi:
    2844             :   case OCutoi:
    2845             :   case OCitos:
    2846             :   case OCitou:
    2847             :   case OCtostr:
    2848             :   case OCvarn:
    2849             :   case OCcopy:
    2850             :   case OCcopyifclone:
    2851             :   case OCcompo1:
    2852             :   case OCcompo1ptr:
    2853             :   case OCcompo2:
    2854             :   case OCcompo2ptr:
    2855             :   case OCcompoC:
    2856             :   case OCcompoCptr:
    2857             :   case OCcompoL:
    2858             :   case OCcompoLptr:
    2859             :   case OCcheckargs:
    2860             :   case OCcheckargs0:
    2861             :   case OCcheckuserargs:
    2862             :   case OCpackargs:
    2863             :   case OCgetargs:
    2864             :   case OCdefaultarg:
    2865             :   case OCdefaultgen:
    2866             :   case OCdefaultlong:
    2867             :   case OCdefaultulong:
    2868             :   case OCcalluser:
    2869             :   case OCvec:
    2870             :   case OCcol:
    2871             :   case OCmat:
    2872             :   case OCnewframe:
    2873             :   case OCsaveframe:
    2874             :   case OCdup:
    2875             :   case OCpop:
    2876             :   case OCavma:
    2877             :   case OCgerepile:
    2878             :   case OCcowvarlex:
    2879             :   case OCsetref:
    2880             :   case OClock:
    2881           0 :     break;
    2882           0 :   case OCpushvar:
    2883             :   case OCpushdyn:
    2884             :   case OCstoredyn:
    2885             :   case OCsimpleptrdyn:
    2886             :   case OCnewptrdyn:
    2887             :   case OClocalvar:
    2888             :   case OClocalvar0:
    2889             :   case OCexportvar:
    2890             :   case OCunexportvar:
    2891             :   case OCcallgen:
    2892             :   case OCcallgen2:
    2893             :   case OCcalllong:
    2894             :   case OCcallint:
    2895             :   case OCcallvoid:
    2896             :   case OCcowvardyn:
    2897             :   case OCevalmnem:
    2898           0 :     return 1;
    2899             :   }
    2900           0 :   return 0;
    2901             : }
    2902             : 
    2903             : static void
    2904           0 : closure_relink(GEN C, hashtable *table)
    2905             : {
    2906           0 :   const char *code = closure_codestr(C);
    2907           0 :   GEN oper = closure_get_oper(C);
    2908           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2909             :   long i, j;
    2910           0 :   for(i=1;i<lg(oper);i++)
    2911           0 :     if (oper[i] && opcode_need_relink((op_code)code[i]))
    2912           0 :       oper[i] = (long) hash_search(table,(void*) oper[i])->val;
    2913           0 :   for (i=1;i<lg(fram);i++)
    2914           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2915           0 :       if (mael(fram,i,j))
    2916           0 :         mael(fram,i,j) = (long) hash_search(table,(void*) mael(fram,i,j))->val;
    2917           0 : }
    2918             : 
    2919             : void
    2920           0 : gen_relink(GEN x, hashtable *table)
    2921             : {
    2922           0 :   long i, lx, tx = typ(x);
    2923           0 :   switch(tx)
    2924             :   {
    2925           0 :     case t_CLOSURE:
    2926           0 :       closure_relink(x, table);
    2927           0 :       gen_relink(closure_get_data(x), table);
    2928           0 :       if (lg(x)==8) gen_relink(closure_get_frame(x), table);
    2929           0 :       break;
    2930           0 :     case t_LIST:
    2931           0 :       if (list_data(x)) gen_relink(list_data(x), table);
    2932           0 :       break;
    2933           0 :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2934           0 :       lx = lg(x);
    2935           0 :       for (i=lontyp[tx]; i<lx; i++) gen_relink(gel(x,i), table);
    2936             :   }
    2937           0 : }
    2938             : 
    2939             : static void
    2940           0 : closure_unlink(GEN C)
    2941             : {
    2942           0 :   const char *code = closure_codestr(C);
    2943           0 :   GEN oper = closure_get_oper(C);
    2944           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2945             :   long i, j;
    2946           0 :   for(i=1;i<lg(oper);i++)
    2947           0 :     if (oper[i] && opcode_need_relink((op_code) code[i]))
    2948             :     {
    2949           0 :       long n = pari_stack_new(&s_relocs);
    2950           0 :       relocs[n] = (entree *) oper[i];
    2951             :     }
    2952           0 :   for (i=1;i<lg(fram);i++)
    2953           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2954           0 :       if (mael(fram,i,j))
    2955             :       {
    2956           0 :         long n = pari_stack_new(&s_relocs);
    2957           0 :         relocs[n] = (entree *) mael(fram,i,j);
    2958             :       }
    2959           0 : }
    2960             : 
    2961             : static void
    2962          16 : gen_unlink(GEN x)
    2963             : {
    2964          16 :   long i, lx, tx = typ(x);
    2965          16 :   switch(tx)
    2966             :   {
    2967           0 :     case t_CLOSURE:
    2968           0 :       closure_unlink(x);
    2969           0 :       gen_unlink(closure_get_data(x));
    2970           0 :       if (lg(x)==8) gen_unlink(closure_get_frame(x));
    2971           0 :       break;
    2972           4 :     case t_LIST:
    2973           4 :       if (list_data(x)) gen_unlink(list_data(x));
    2974           4 :       break;
    2975           0 :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2976           0 :       lx = lg(x);
    2977           0 :       for (i = lontyp[tx]; i<lx; i++) gen_unlink(gel(x,i));
    2978             :   }
    2979          16 : }
    2980             : 
    2981             : GEN
    2982          12 : copybin_unlink(GEN C)
    2983             : {
    2984          12 :   long i, l , n, nold = s_relocs.n;
    2985             :   GEN v, w, V, res;
    2986          12 :   if (C)
    2987           8 :     gen_unlink(C);
    2988             :   else
    2989             :   { /* contents of all variables */
    2990           4 :     long v, maxv = pari_var_next();
    2991          44 :     for (v=0; v<maxv; v++)
    2992             :     {
    2993          40 :       entree *ep = varentries[v];
    2994          40 :       if (!ep || !ep->value) continue;
    2995           8 :       gen_unlink((GEN)ep->value);
    2996             :     }
    2997             :   }
    2998          12 :   n = s_relocs.n-nold;
    2999          12 :   v = cgetg(n+1, t_VECSMALL);
    3000          12 :   for(i=0; i<n; i++)
    3001           0 :     v[i+1] = (long) relocs[i];
    3002          12 :   s_relocs.n = nold;
    3003          12 :   w = vecsmall_uniq(v); l = lg(w);
    3004          12 :   res = cgetg(3,t_VEC);
    3005          12 :   V = cgetg(l, t_VEC);
    3006          12 :   for(i=1; i<l; i++)
    3007             :   {
    3008           0 :     entree *ep = (entree*) w[i];
    3009           0 :     gel(V,i) = strtoGENstr(ep->name);
    3010             :   }
    3011          12 :   gel(res,1) = vecsmall_copy(w);
    3012          12 :   gel(res,2) = V;
    3013          12 :   return res;
    3014             : }
    3015             : 
    3016             : /* e = t_VECSMALL of entree *ep [ addresses ],
    3017             :  * names = t_VEC of strtoGENstr(ep.names),
    3018             :  * Return hashtable : ep => is_entry(ep.name) */
    3019             : hashtable *
    3020           0 : hash_from_link(GEN e, GEN names, int use_stack)
    3021             : {
    3022           0 :   long i, l = lg(e);
    3023           0 :   hashtable *h = hash_create_ulong(l-1, use_stack);
    3024           0 :   if (lg(names) != l) pari_err_DIM("hash_from_link");
    3025           0 :   for (i = 1; i < l; i++)
    3026             :   {
    3027           0 :     char *s = GSTR(gel(names,i));
    3028           0 :     hash_insert(h, (void*)e[i], (void*)fetch_entry(s));
    3029             :   }
    3030           0 :   return h;
    3031             : }
    3032             : 
    3033             : void
    3034           0 : bincopy_relink(GEN C, GEN V)
    3035             : {
    3036           0 :   pari_sp av = avma;
    3037           0 :   hashtable *table = hash_from_link(gel(V,1),gel(V,2),1);
    3038           0 :   gen_relink(C, table);
    3039           0 :   set_avma(av);
    3040           0 : }

Generated by: LCOV version 1.16