Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - eval.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.10.0 lcov report (development 21196-f12677d) Lines: 1057 1397 75.7 %
Date: 2017-10-22 06:23:24 Functions: 93 110 84.5 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : #include "anal.h"
      17             : #include "opcode.h"
      18             : 
      19             : /********************************************************************/
      20             : /*                                                                  */
      21             : /*                   break/next/return handling                     */
      22             : /*                                                                  */
      23             : /********************************************************************/
      24             : 
      25             : static THREAD long br_status, br_count;
      26             : static THREAD GEN br_res;
      27             : 
      28             : long
      29   117442860 : loop_break(void)
      30             : {
      31   117442860 :   switch(br_status)
      32             :   {
      33             :     case br_MULTINEXT :
      34          21 :       if (! --br_count) br_status = br_NEXT;
      35          21 :       return 1;
      36       70240 :     case br_BREAK : if (! --br_count) br_status = br_NONE; /* fall through */
      37       74935 :     case br_RETURN: return 1;
      38       17066 :     case br_NEXT: br_status = br_NONE; /* fall through */
      39             :   }
      40   117367904 :   return 0;
      41             : }
      42             : 
      43             : static void
      44       93257 : reset_break(void)
      45             : {
      46       93257 :   br_status = br_NONE;
      47       93257 :   if (br_res) { gunclone_deep(br_res); br_res = NULL; }
      48       93257 : }
      49             : 
      50             : GEN
      51       50572 : return0(GEN x)
      52             : {
      53       50572 :   GEN y = br_res;
      54       50572 :   br_res = (x && x != gnil)? gcloneref(x): NULL;
      55       50572 :   if (y) gunclone_deep(y);
      56       50572 :   br_status = br_RETURN; return NULL;
      57             : }
      58             : 
      59             : GEN
      60       17794 : next0(long n)
      61             : {
      62       17794 :   if (n < 1) pari_err_DOMAIN("next", "n", "<", gen_1, stoi(n));
      63       17787 :   if (n == 1) br_status = br_NEXT;
      64             :   else
      65             :   {
      66          14 :     br_count = n-1;
      67          14 :     br_status = br_MULTINEXT;
      68             :   }
      69       17787 :   return NULL;
      70             : }
      71             : 
      72             : GEN
      73       70296 : break0(long n)
      74             : {
      75       70296 :   if (n < 1) pari_err_DOMAIN("break", "n", "<", gen_1, stoi(n));
      76       70289 :   br_count = n;
      77       70289 :   br_status = br_BREAK; return NULL;
      78             : }
      79             : 
      80             : /*******************************************************************/
      81             : /*                                                                 */
      82             : /*                            VARIABLES                            */
      83             : /*                                                                 */
      84             : /*******************************************************************/
      85             : 
      86             : /* As a rule, ep->value is a clone (COPY). push_val and pop_val are private
      87             :  * functions for use in sumiter: we want a temporary ep->value, which is NOT
      88             :  * a clone (PUSH), to avoid unnecessary copies. */
      89             : 
      90             : enum {PUSH_VAL = 0, COPY_VAL = 1, DEFAULT_VAL = 2};
      91             : 
      92             : /* ep->args is the stack of old values (INITIAL if initial value, from
      93             :  * installep) */
      94             : typedef struct var_cell {
      95             :   struct var_cell *prev; /* cell attached to previous value on stack */
      96             :   GEN value; /* last value (not including current one, in ep->value) */
      97             :   char flag; /* status of _current_ ep->value: PUSH or COPY ? */
      98             :   long valence; /* valence of entree* attached to 'value', to be restored
      99             :                     * by pop_val */
     100             : } var_cell;
     101             : #define INITIAL NULL
     102             : 
     103             : /* Push x on value stack attached to ep. */
     104             : static void
     105       11937 : new_val_cell(entree *ep, GEN x, char flag)
     106             : {
     107       11937 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     108       11937 :   v->value  = (GEN)ep->value;
     109       11937 :   v->prev   = (var_cell*) ep->pvalue;
     110       11937 :   v->flag   = flag;
     111       11937 :   v->valence= ep->valence;
     112             : 
     113             :   /* beware: f(p) = Nv = 0
     114             :    *         Nv = p; f(Nv) --> this call would destroy p [ isclone ] */
     115       11937 :   ep->value = (flag == COPY_VAL)? gclone(x):
     116           0 :                                   (x && isclone(x))? gcopy(x): x;
     117             :   /* Do this last. In case the clone is <C-C>'ed before completion ! */
     118       11937 :   ep->pvalue= (char*)v;
     119       11937 :   ep->valence=EpVAR;
     120       11937 : }
     121             : 
     122             : /* kill ep->value and replace by preceding one, poped from value stack */
     123             : static void
     124       11804 : pop_val(entree *ep)
     125             : {
     126       11804 :   var_cell *v = (var_cell*) ep->pvalue;
     127       11804 :   if (v != INITIAL)
     128             :   {
     129       11804 :     GEN old_val = (GEN) ep->value; /* protect against SIGINT */
     130       11804 :     ep->value  = v->value;
     131       11804 :     if (v->flag == COPY_VAL) gunclone_deep(old_val);
     132       11804 :     ep->pvalue = (char*) v->prev;
     133       11804 :     ep->valence=v->valence;
     134       11804 :     pari_free((void*)v);
     135             :   }
     136       11804 : }
     137             : 
     138             : void
     139       25433 : freeep(entree *ep)
     140             : {
     141       50866 :   if (EpSTATIC(ep)) return; /* gp function loaded at init time */
     142       25433 :   if (ep->help) {pari_free((void*)ep->help); ep->help=NULL;}
     143       25433 :   if (ep->code) {pari_free((void*)ep->code); ep->code=NULL;}
     144       25433 :   switch(EpVALENCE(ep))
     145             :   {
     146             :     case EpVAR:
     147       16282 :       while (ep->pvalue!=INITIAL) pop_val(ep);
     148       16282 :       break;
     149             :     case EpALIAS:
     150          28 :       killblock((GEN)ep->value); ep->value=NULL; break;
     151             :   }
     152             : }
     153             : 
     154             : INLINE void
     155          28 : pushvalue(entree *ep, GEN x) {
     156          28 :   new_val_cell(ep, x, COPY_VAL);
     157          28 : }
     158             : 
     159             : INLINE void
     160          14 : zerovalue (entree *ep)
     161             : {
     162          14 :   var_cell *v = (var_cell*) pari_malloc(sizeof(var_cell));
     163          14 :   v->value  = (GEN)ep->value;
     164          14 :   v->prev   = (var_cell*) ep->pvalue;
     165          14 :   v->flag   = PUSH_VAL;
     166          14 :   v->valence= ep->valence;
     167          14 :   ep->value = gen_0;
     168          14 :   ep->pvalue= (char*)v;
     169          14 :   ep->valence=EpVAR;
     170          14 : }
     171             : 
     172             : 
     173             : /* as above IF ep->value was PUSHed, or was created after block number 'loc'
     174             :    return 0 if not deleted, 1 otherwise [for recover()] */
     175             : int
     176      152786 : pop_val_if_newer(entree *ep, long loc)
     177             : {
     178      152786 :   var_cell *v = (var_cell*) ep->pvalue;
     179             : 
     180      152786 :   if (v == INITIAL) return 0;
     181      131249 :   if (v->flag == COPY_VAL && !pop_entree_block(ep, loc)) return 0;
     182         147 :   ep->value = v->value;
     183         147 :   ep->pvalue= (char*) v->prev;
     184         147 :   ep->valence=v->valence;
     185         147 :   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    20538788 : changevalue(entree *ep, GEN x)
     192             : {
     193    20538788 :   var_cell *v = (var_cell*) ep->pvalue;
     194    20538788 :   if (v == INITIAL) new_val_cell(ep, x, COPY_VAL);
     195             :   else
     196             :   {
     197    20526879 :     GEN old_val = (GEN) ep->value; /* beware: gunclone_deep may destroy old x */
     198    20526879 :     ep->value = (void *) gclone(x);
     199    20526879 :     if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     200             :   }
     201    20538788 : }
     202             : 
     203             : INLINE GEN
     204      737961 : copyvalue(entree *ep)
     205             : {
     206      737961 :   var_cell *v = (var_cell*) ep->pvalue;
     207      737961 :   if (v && v->flag != COPY_VAL)
     208             :   {
     209           0 :     ep->value = (void*) gclone((GEN)ep->value);
     210           0 :     v->flag = COPY_VAL;
     211             :   }
     212      737961 :   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   103227667 : checkvalue(entree *ep, enum chk_VALUE flag)
     222             : {
     223    14746836 :   if (MT_IS_THREAD)
     224           0 :     pari_err(e_MISC,"mt: global variable not supported: %s",ep->name);
     225   103227667 :   if (ep->valence==EpNEW)
     226       16101 :     switch(flag)
     227             :     {
     228             :       case chk_ERROR:
     229             :         /* Do nothing until we can report a meaningful error message
     230             :            The extra variable will be cleaned-up anyway */
     231             :       case chk_CREATE:
     232        4347 :         pari_var_create(ep);
     233        4347 :         ep->valence = EpVAR;
     234        4347 :         ep->value = initial_value(ep);
     235        4347 :         break;
     236             :       case chk_NOCREATE:
     237       11754 :         break;
     238             :     }
     239   103211566 :   else if (ep->valence!=EpVAR)
     240           0 :     err_var(strtoGENstr(ep->name));
     241   103227667 : }
     242             : 
     243             : INLINE GEN
     244    14599851 : checkvalueptr(entree *ep)
     245             : {
     246    14599851 :   checkvalue(ep, chk_NOCREATE);
     247    14599851 :   return ep->valence==EpNEW? gen_0: (GEN)ep->value;
     248             : }
     249             : 
     250             : /* make GP variables safe for 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    81715647 : check_array_index(long c, long l)
     270             : {
     271    81715647 :   if (c < 1) pari_err_COMPONENT("", "<", gen_1, stoi(c));
     272    81715642 :   if (c >= l) pari_err_COMPONENT("", ">", stoi(l-1), stoi(c));
     273    81715600 : }
     274             : 
     275             : GEN*
     276           0 : safegel(GEN x, long l)
     277             : {
     278           0 :   if (!is_matvec_t(typ(x)))
     279           0 :     pari_err_TYPE("safegel",x);
     280           0 :   check_array_index(l, lg(x));
     281           0 :   return &(gel(x,l));
     282             : }
     283             : 
     284             : GEN*
     285           0 : safelistel(GEN x, long l)
     286             : {
     287             :   GEN d;
     288           0 :   if (typ(x)!=t_LIST || list_typ(x)!=t_LIST_RAW)
     289           0 :     pari_err_TYPE("safelistel",x);
     290           0 :   d = list_data(x);
     291           0 :   check_array_index(l, lg(d));
     292           0 :   return &(gel(d,l));
     293             : }
     294             : 
     295             : long*
     296           0 : safeel(GEN x, long l)
     297             : {
     298           0 :   if (typ(x)!=t_VECSMALL)
     299           0 :     pari_err_TYPE("safeel",x);
     300           0 :   check_array_index(l, lg(x));
     301           0 :   return &(x[l]);
     302             : }
     303             : 
     304             : GEN*
     305           0 : safegcoeff(GEN x, long a, long b)
     306             : {
     307           0 :   if (typ(x)!=t_MAT) pari_err_TYPE("safegcoeff", x);
     308           0 :   check_array_index(b, lg(x));
     309           0 :   check_array_index(a, lg(gel(x,b)));
     310           0 :   return &(gcoeff(x,a,b));
     311             : }
     312             : 
     313             : typedef struct matcomp
     314             : {
     315             :   GEN *ptcell;
     316             :   GEN parent;
     317             :   int full_col, full_row;
     318             : } matcomp;
     319             : 
     320             : typedef struct gp_pointer
     321             : {
     322             :   matcomp c;
     323             :   GEN x, ox;
     324             :   entree *ep;
     325             :   long vn;
     326             :   long sp;
     327             : } gp_pointer;
     328             : 
     329             : 
     330             : /* assign res at *pt in "simple array object" p and return it, or a copy.*/
     331             : static void
     332     8544522 : change_compo(matcomp *c, GEN res)
     333             : {
     334     8544522 :   GEN p = c->parent, *pt = c->ptcell;
     335             :   long i, t;
     336             : 
     337     8544522 :   if (typ(p) == t_VECSMALL)
     338             :   {
     339          21 :     if (typ(res) != t_INT || is_bigint(res))
     340          14 :       pari_err_TYPE("t_VECSMALL assignment", res);
     341           7 :     *pt = (GEN)itos(res); return;
     342             :   }
     343     8544501 :   t = typ(res);
     344     8544501 :   if (c->full_row)
     345             :   {
     346          63 :     if (t != t_VEC) pari_err_TYPE("matrix row assignment", res);
     347          42 :     if (lg(res) != lg(p)) pari_err_DIM("matrix row assignment");
     348          98 :     for (i=1; i<lg(p); i++)
     349             :     {
     350          77 :       GEN p1 = gcoeff(p,c->full_row,i); /* Protect against SIGINT */
     351          77 :       gcoeff(p,c->full_row,i) = gclone(gel(res,i));
     352          77 :       if (isclone(p1)) gunclone_deep(p1);
     353             :     }
     354          21 :     return;
     355             :   }
     356     8544438 :   if (c->full_col)
     357             :   {
     358      150584 :     if (t != t_COL) pari_err_TYPE("matrix col assignment", res);
     359      150570 :     if (lg(res) != lg(*pt)) pari_err_DIM("matrix col assignment");
     360             :   }
     361             : 
     362     8544417 :   res = gclone(res);
     363     8544417 :   gunclone_deep(*pt);
     364     8544417 :   *pt = res;
     365             : }
     366             : 
     367             : /***************************************************************************
     368             :  **                                                                       **
     369             :  **                           Byte-code evaluator                         **
     370             :  **                                                                       **
     371             :  ***************************************************************************/
     372             : 
     373             : struct var_lex
     374             : {
     375             :   long flag;
     376             :   GEN value;
     377             : };
     378             : 
     379             : struct trace
     380             : {
     381             :   long pc;
     382             :   GEN closure;
     383             : };
     384             : 
     385             : static THREAD long sp, rp, dbg_level;
     386             : static THREAD long *st, *precs;
     387             : static THREAD gp_pointer *ptrs;
     388             : static THREAD entree **lvars;
     389             : static THREAD struct var_lex *var;
     390             : static THREAD struct trace *trace;
     391             : static THREAD pari_stack s_st, s_ptrs, s_var, s_lvars, s_trace, s_prec;
     392             : 
     393             : static void
     394   146149265 : changelex(long vn, GEN x)
     395             : {
     396   146149265 :   struct var_lex *v=var+s_var.n+vn;
     397   146149265 :   GEN old_val = v->value;
     398   146149265 :   v->value = gclone(x);
     399   146149265 :   if (v->flag == COPY_VAL) gunclone_deep(old_val); else v->flag = COPY_VAL;
     400   146149265 : }
     401             : 
     402             : INLINE GEN
     403     8593431 : copylex(long vn)
     404             : {
     405     8593431 :   struct var_lex *v = var+s_var.n+vn;
     406     8593431 :   if (v->flag!=COPY_VAL)
     407             :   {
     408        4557 :     v->value = gclone(v->value);
     409        4557 :     v->flag  = COPY_VAL;
     410             :   }
     411     8593431 :   return v->value;
     412             : }
     413             : 
     414             : INLINE void
     415    60342327 : pushlex(long vn, GEN x)
     416             : {
     417    60342327 :   struct var_lex *v=var+s_var.n+vn;
     418    60342327 :   v->flag  = PUSH_VAL;
     419    60342327 :   v->value = x;
     420    60342327 : }
     421             : 
     422             : INLINE void
     423   130712581 : freelex(void)
     424             : {
     425   130712581 :   struct var_lex *v=var+s_var.n-1;
     426   130712581 :   s_var.n--;
     427   130712581 :   if (v->flag == COPY_VAL) gunclone_deep(v->value);
     428   130712581 : }
     429             : 
     430             : INLINE void
     431   217517262 : restore_vars(long nbmvar, long nblvar)
     432             : {
     433             :   long j;
     434   343437683 :   for(j=1;j<=nbmvar;j++)
     435   125919614 :     freelex();
     436   217518111 :   for(j=1;j<=nblvar;j++)
     437          42 :     { s_lvars.n--; pop_val(lvars[s_lvars.n]); }
     438   217518069 : }
     439             : 
     440             : INLINE void
     441       41660 : restore_trace(long nbtrace)
     442             : {
     443             :   long j;
     444       94388 :   for(j=1;j<=nbtrace;j++)
     445             :   {
     446       52728 :     GEN C = trace[s_trace.n-j].closure;
     447       52728 :     if (isclone(C)) gunclone(C);
     448             :   }
     449       41660 :   s_trace.n-=nbtrace;
     450       41660 : }
     451             : 
     452             : INLINE long
     453   221824275 : trace_push(long pc, GEN C)
     454             : {
     455             :   long tr;
     456   221824275 :   BLOCK_SIGINT_START
     457   222353892 :   tr = pari_stack_new(&s_trace);
     458   222209983 :   trace[tr].pc = pc;
     459   222209983 :   trace[tr].closure = C;
     460   222209983 :   BLOCK_SIGINT_END
     461   222383064 :   return tr;
     462             : }
     463             : 
     464             : void
     465     4792949 : push_lex(GEN a, GEN C)
     466             : {
     467     4792949 :   long vn=pari_stack_new(&s_var);
     468     4792951 :   struct var_lex *v=var+vn;
     469     4792951 :   v->flag  = PUSH_VAL;
     470     4792951 :   v->value = a;
     471     4792951 :   if (C) (void) trace_push(-1, C);
     472     4792951 : }
     473             : 
     474             : GEN
     475    79247291 : get_lex(long vn)
     476             : {
     477    79247291 :   struct var_lex *v=var+s_var.n+vn;
     478    79247291 :   return v->value;
     479             : }
     480             : 
     481             : void
     482    32371738 : set_lex(long vn, GEN x)
     483             : {
     484    32371738 :   struct var_lex *v=var+s_var.n+vn;
     485    32371738 :   if (v->flag == COPY_VAL) { gunclone_deep(v->value); v->flag = PUSH_VAL; }
     486    32371738 :   v->value = x;
     487    32371738 : }
     488             : 
     489             : void
     490     4652801 : pop_lex(long n)
     491             : {
     492             :   long j;
     493     9445498 :   for(j=1; j<=n; j++)
     494     4792693 :     freelex();
     495     4652805 :   s_trace.n--;
     496     4652805 : }
     497             : 
     498             : static THREAD pari_stack s_relocs;
     499             : static THREAD entree **relocs;
     500             : 
     501             : void
     502      122035 : pari_init_evaluator(void)
     503             : {
     504      122035 :   sp=0;
     505      122035 :   pari_stack_init(&s_st,sizeof(*st),(void**)&st);
     506      121187 :   pari_stack_alloc(&s_st,32);
     507      122329 :   s_st.n=s_st.alloc;
     508      122329 :   rp=0;
     509      122329 :   pari_stack_init(&s_ptrs,sizeof(*ptrs),(void**)&ptrs);
     510      122362 :   pari_stack_alloc(&s_ptrs,16);
     511      122539 :   s_ptrs.n=s_ptrs.alloc;
     512      122539 :   pari_stack_init(&s_var,sizeof(*var),(void**)&var);
     513      121908 :   pari_stack_init(&s_lvars,sizeof(*lvars),(void**)&lvars);
     514      121867 :   pari_stack_init(&s_trace,sizeof(*trace),(void**)&trace);
     515      121575 :   br_res = NULL;
     516      121575 :   pari_stack_init(&s_relocs,sizeof(*relocs),(void**)&relocs);
     517      121625 :   pari_stack_init(&s_prec,sizeof(*precs),(void**)&precs);
     518      121635 : }
     519             : void
     520      122341 : pari_close_evaluator(void)
     521             : {
     522      122341 :   pari_stack_delete(&s_st);
     523      122497 :   pari_stack_delete(&s_ptrs);
     524      122594 :   pari_stack_delete(&s_var);
     525      122618 :   pari_stack_delete(&s_lvars);
     526      122557 :   pari_stack_delete(&s_trace);
     527      122594 :   pari_stack_delete(&s_relocs);
     528      122529 :   pari_stack_delete(&s_prec);
     529      122468 : }
     530             : 
     531             : static gp_pointer *
     532    50953618 : new_ptr(void)
     533             : {
     534    50953618 :   if (rp==s_ptrs.n-1)
     535             :   {
     536             :     long i;
     537           0 :     gp_pointer *old = ptrs;
     538           0 :     (void)pari_stack_new(&s_ptrs);
     539           0 :     if (old != ptrs)
     540           0 :       for(i=0; i<rp; i++)
     541             :       {
     542           0 :         gp_pointer *g = &ptrs[i];
     543           0 :         if(g->sp >= 0) gel(st,g->sp) = (GEN) &(g->x);
     544             :       }
     545             :   }
     546    50953618 :   return &ptrs[rp++];
     547             : }
     548             : 
     549             : void
     550       84346 : push_localprec(long p)
     551             : {
     552       84346 :   long n = pari_stack_new(&s_prec);
     553       84346 :   precs[n] = prec2nbits(p);
     554       84346 : }
     555             : 
     556             : void
     557          84 : push_localbitprec(long p)
     558             : {
     559          84 :   long n = pari_stack_new(&s_prec);
     560          84 :   precs[n] = p;
     561          84 : }
     562             : 
     563             : void
     564       76394 : pop_localprec(void)
     565             : {
     566       76394 :   s_prec.n--;
     567       76394 : }
     568             : 
     569             : long
     570    14130546 : get_localbitprec(void)
     571             : {
     572    14130546 :   return s_prec.n? precs[s_prec.n-1]: precreal;
     573             : }
     574             : 
     575             : long
     576    14114501 : get_localprec(void)
     577             : {
     578    14114501 :   return nbits2prec(get_localbitprec());
     579             : }
     580             : 
     581             : void
     582        7952 : localprec(long p)
     583             : {
     584        7952 :   long pmax = prec2ndec(LGBITS);
     585        7952 :   if (p < 1) pari_err_DOMAIN("localprec", "p", "<", gen_1, stoi(p));
     586        7952 :   if (p > pmax)
     587           0 :     pari_err_DOMAIN("localprec", "p", ">", utoi(pmax), stoi(p));
     588        7952 :   push_localprec(ndec2prec(p));
     589        7952 : }
     590             : 
     591             : void
     592          84 : localbitprec(long p)
     593             : {
     594          84 :   if (p < 1) pari_err_DOMAIN("localprec", "p", "<", gen_1, stoi(p));
     595          84 :   if (p > (long)LGBITS)
     596           0 :     pari_err_DOMAIN("localbitprec", "p", ">", utoi(LGBITS), stoi(p));
     597          84 :   push_localbitprec(p);
     598          84 : }
     599             : 
     600             : INLINE GEN
     601    21099932 : copyupto(GEN z, GEN t)
     602             : {
     603    21099932 :   if (is_universal_constant(z) || (z>(GEN)pari_mainstack->bot && z<=t))
     604    19509668 :     return z;
     605             :   else
     606     1590199 :     return gcopy(z);
     607             : }
     608             : 
     609             : static void closure_eval(GEN C);
     610             : 
     611             : INLINE GEN
     612    36047077 : closure_return(GEN C)
     613             : {
     614    36047077 :   pari_sp ltop=avma;
     615    36047077 :   closure_eval(C);
     616    36028163 :   if (br_status)
     617             :   {
     618             :     GEN z;
     619       51292 :     avma=ltop;
     620       51292 :     z=br_res?gcopy(br_res):gnil;
     621       51292 :     reset_break();
     622       51292 :     return z;
     623             :   }
     624    35976871 :   return gerepileupto(ltop,gel(st,--sp));
     625             : }
     626             : 
     627             : /* for the break_loop debugger. Not memory clean */
     628             : GEN
     629         161 : closure_evalbrk(GEN C, long *status)
     630             : {
     631         161 :   closure_eval(C);
     632         133 :   *status = br_status;
     633         133 :   if (br_status)
     634             :   {
     635          49 :     GEN z = br_res? gcopy(br_res): gnil;
     636          49 :     reset_break();
     637          49 :     return z;
     638             :   }
     639          84 :   return gel(st,--sp);
     640             : }
     641             : 
     642             : INLINE long
     643      996940 : closure_varn(GEN x)
     644             : {
     645      996940 :   if (!x) return -1;
     646      996422 :   if (!gequalX(x)) err_var(x);
     647      996422 :   return varn(x);
     648             : }
     649             : 
     650             : INLINE void
     651    72408793 : closure_castgen(GEN z, long mode)
     652             : {
     653    72408793 :   switch (mode)
     654             :   {
     655             :   case Ggen:
     656    72408135 :     gel(st,sp++)=z;
     657    72408135 :     break;
     658             :   case Gsmall:
     659         658 :     st[sp++]=gtos(z);
     660         658 :     break;
     661             :   case Gusmall:
     662           0 :     st[sp++]=gtou(z);
     663           0 :     break;
     664             :   case Gvar:
     665           0 :     st[sp++]=closure_varn(z);
     666           0 :     break;
     667             :   case Gvoid:
     668           0 :     break;
     669             :   default:
     670           0 :     pari_err_BUG("closure_castgen, type unknown");
     671             :   }
     672    72408793 : }
     673             : 
     674             : INLINE void
     675         665 : closure_castlong(long z, long mode)
     676             : {
     677         665 :   switch (mode)
     678             :   {
     679             :   case Gsmall:
     680           0 :     st[sp++]=z;
     681           0 :     break;
     682             :   case Gusmall:
     683           0 :     if (z < 0)
     684           0 :       pari_err_TYPE("stou [integer >=0 expected]", stoi(z));
     685           0 :     st[sp++]=(ulong) z;
     686           0 :     break;
     687             :   case Ggen:
     688         658 :     gel(st,sp++)=stoi(z);
     689         658 :     break;
     690             :   case Gvar:
     691           0 :     err_var(stoi(z));
     692             :   case Gvoid:
     693           7 :     break;
     694             :   default:
     695           0 :     pari_err_BUG("closure_castlong, type unknown");
     696             :   }
     697         665 : }
     698             : 
     699             : const char *
     700        8396 : closure_func_err(void)
     701             : {
     702        8396 :   long fun=s_trace.n-1, pc;
     703             :   const char *code;
     704             :   GEN C, oper;
     705        8396 :   if (fun < 0 || trace[fun].pc < 0) return NULL;
     706        7935 :   pc = trace[fun].pc; C  = trace[fun].closure;
     707        7935 :   code = closure_codestr(C); oper = closure_get_oper(C);
     708       11271 :   if (code[pc]==OCcallgen || code[pc]==OCcallgen2 ||
     709        6602 :       code[pc]==OCcallint || code[pc]==OCcalllong || code[pc]==OCcallvoid)
     710        4988 :     return ((entree*)oper[pc])->name;
     711        2947 :   return NULL;
     712             : }
     713             : 
     714             : /* return the next label for the call chain debugger closure_err(),
     715             :  * incorporating the name of the user of member function. Return NULL for an
     716             :  * anonymous (inline) closure. */
     717             : static char *
     718         161 : get_next_label(const char *s, int member, char **next_fun)
     719             : {
     720         161 :   const char *v, *t = s+1;
     721             :   char *u, *next_label;
     722             : 
     723         161 :   if (!is_keyword_char(*s)) return NULL;
     724         154 :   while (is_keyword_char(*t)) t++;
     725             :   /* e.g. (x->1/x)(0) instead of (x)->1/x */
     726         154 :   if (t[0] == '-' && t[1] == '>') return NULL;
     727         147 :   next_label = (char*)pari_malloc(t - s + 32);
     728         147 :   sprintf(next_label, "in %sfunction ", member? "member ": "");
     729         147 :   u = *next_fun = next_label + strlen(next_label);
     730         147 :   v = s;
     731         147 :   while (v < t) *u++ = *v++;
     732         147 :   *u++ = 0; return next_label;
     733             : }
     734             : 
     735             : static const char *
     736          14 : get_arg_name(GEN C, long i)
     737             : {
     738          14 :   GEN e = gmael(closure_get_dbg(C), 3, 1);
     739          14 :   return ((entree*)e[i])->name;
     740             : }
     741             : 
     742             : void
     743        7937 : closure_err(long level)
     744             : {
     745             :   GEN base;
     746        7937 :   const long lastfun = s_trace.n - 1 - level;
     747             :   char *next_label, *next_fun;
     748        7937 :   long i = maxss(0, lastfun - 19);
     749       15874 :   if (lastfun < 0) return; /*e.g. when called by gp_main_loop's simplify */
     750        7937 :   if (i > 0) while (lg(trace[i].closure)==6) i--;
     751        7937 :   base = closure_get_text(trace[i].closure); /* gcc -Wall*/
     752        7937 :   next_label = pari_strdup(i == 0? "at top-level": "[...] at");
     753        7937 :   next_fun = next_label;
     754        8457 :   for (; i <= lastfun; i++)
     755             :   {
     756        8457 :     GEN C = trace[i].closure;
     757        8457 :     if (lg(C) >= 7) base=closure_get_text(C);
     758        8457 :     if ((i==lastfun || lg(trace[i+1].closure)>=7))
     759             :     {
     760        8098 :       GEN dbg = gel(closure_get_dbg(C),1);
     761             :       /* After a SIGINT, pc can be slightly off: ensure 0 <= pc < lg() */
     762        8098 :       long pc = minss(lg(dbg)-1, trace[i].pc>=0 ? trace[i].pc: 1);
     763        8098 :       long offset = pc? dbg[pc]: 0;
     764             :       int member;
     765             :       const char *s, *sbase;
     766        8098 :       if (typ(base)!=t_VEC) sbase = GSTR(base);
     767         126 :       else if (offset>=0)   sbase = GSTR(gel(base,2));
     768          14 :       else { sbase = GSTR(gel(base,1)); offset += strlen(sbase); }
     769        8098 :       s = sbase + offset;
     770        8098 :       member = offset>0 && (s[-1] == '.');
     771             :       /* avoid "in function foo: foo" */
     772        8098 :       if (!next_fun || strcmp(next_fun, s)) {
     773        8091 :         print_errcontext(pariErr, next_label, s, sbase);
     774        8091 :         out_putc(pariErr, '\n');
     775             :       }
     776        8098 :       pari_free(next_label);
     777        8098 :       if (i == lastfun) break;
     778             : 
     779         161 :       next_label = get_next_label(s, member, &next_fun);
     780         161 :       if (!next_label) {
     781          14 :         next_label = pari_strdup("in anonymous function");
     782          14 :         next_fun = NULL;
     783             :       }
     784             :     }
     785             :   }
     786             : }
     787             : 
     788             : GEN
     789          35 : pari_self(void)
     790             : {
     791          35 :   long fun = s_trace.n - 1;
     792          35 :   if (fun > 0) while (lg(trace[fun].closure)==6) fun--;
     793          35 :   return fun >= 0 ? trace[fun].closure: NULL;
     794             : }
     795             : 
     796             : long
     797          84 : closure_context(long start, long level)
     798             : {
     799          84 :   const long lastfun = s_trace.n - 1 - level;
     800          84 :   long i, fun = lastfun;
     801          84 :   if (fun<0) return lastfun;
     802          84 :   while (fun>start && lg(trace[fun].closure)==6) fun--;
     803         280 :   for (i=fun; i <= lastfun; i++)
     804         196 :     push_frame(trace[i].closure, trace[i].pc,0);
     805         119 :   for (  ; i < s_trace.n; i++)
     806          35 :     push_frame(trace[i].closure, trace[i].pc,1);
     807          84 :   return s_trace.n-level;
     808             : }
     809             : 
     810             : INLINE void
     811  2168973999 : st_alloc(long n)
     812             : {
     813  2168973999 :   if (sp+n>s_st.n)
     814             :   {
     815          42 :     pari_stack_alloc(&s_st,n+16);
     816          42 :     s_st.n=s_st.alloc;
     817          42 :     if (DEBUGMEM>=2) pari_warn(warner,"doubling evaluator stack");
     818             :   }
     819  2168973999 : }
     820             : 
     821             : INLINE void
     822     8544739 : ptr_proplock(gp_pointer *g, GEN C)
     823             : {
     824     8544739 :   g->x = C;
     825     8544739 :   if (isclone(g->x))
     826             :   {
     827      432747 :     clone_unlock(g->ox);
     828      432747 :     g->ox = g->x;
     829      432747 :     ++bl_refc(g->ox);
     830             :   }
     831     8544739 : }
     832             : 
     833             : static void
     834   217281902 : closure_eval(GEN C)
     835             : {
     836   217281902 :   const char *code=closure_codestr(C);
     837   217232170 :   GEN oper=closure_get_oper(C);
     838   217236323 :   GEN data=closure_get_data(C);
     839   217239009 :   long loper=lg(oper);
     840   217239009 :   long saved_sp=sp-closure_arity(C);
     841   217358320 :   long saved_rp=rp, saved_prec=s_prec.n;
     842   217358320 :   long j, nbmvar=0, nblvar=0;
     843             :   long pc, t;
     844             : #ifdef STACK_CHECK
     845             :   GEN stackelt;
     846   217358320 :   if (PARI_stack_limit && (void*) &stackelt <= PARI_stack_limit)
     847           0 :     pari_err(e_MISC, "deep recursion");
     848             : #endif
     849   217358320 :   clone_lock(C);
     850   217253934 :   t = trace_push(0, C);
     851   217588421 :   if (lg(C)==8)
     852             :   {
     853     1376182 :     GEN z=closure_get_frame(C);
     854     1375635 :     long l=lg(z)-1;
     855     1375635 :     pari_stack_alloc(&s_var,l);
     856     1376360 :     s_var.n+=l;
     857     1376360 :     nbmvar+=l;
     858     5662314 :     for(j=1;j<=l;j++)
     859             :     {
     860     4285954 :       var[s_var.n-j].flag=PUSH_VAL;
     861     4285954 :       var[s_var.n-j].value=gel(z,j);
     862             :     }
     863             :   }
     864             : 
     865  2328336072 :   for(pc=1;pc<loper;pc++)
     866             :   {
     867  2110533427 :     op_code opcode=(op_code) code[pc];
     868  2110533427 :     long operand=oper[pc];
     869  2110533427 :     if (sp<0) pari_err_BUG("closure_eval, stack underflow");
     870  2110533427 :     st_alloc(16);
     871  2110587332 :     trace[t].pc = pc;
     872             :     CHECK_CTRLC
     873  2110587332 :     switch(opcode)
     874             :     {
     875             :     case OCpushlong:
     876   144608629 :       st[sp++]=operand;
     877   144608629 :       break;
     878             :     case OCpushgnil:
     879       88095 :       gel(st,sp++)=gnil;
     880       88095 :       break;
     881             :     case OCpushgen:
     882    85754638 :       gel(st,sp++)=gel(data,operand);
     883    85754638 :       break;
     884             :     case OCpushreal:
     885       82595 :       gel(st,sp++)=strtor(GSTR(data[operand]),get_localprec());
     886       82595 :       break;
     887             :     case OCpushstoi:
     888   158825971 :       gel(st,sp++)=stoi(operand);
     889   158825972 :       break;
     890             :     case OCpushvar:
     891             :       {
     892       14756 :         entree *ep = (entree *)operand;
     893       14756 :         gel(st,sp++)=pol_x(pari_var_create(ep));
     894       14756 :         break;
     895             :       }
     896             :     case OCpushdyn:
     897             :       {
     898    81950828 :         entree *ep = (entree *)operand;
     899    81950828 :         checkvalue(ep, chk_CREATE);
     900    81950828 :         gel(st,sp++)=(GEN)ep->value;
     901    81950828 :         break;
     902             :       }
     903             :     case OCpushlex:
     904   469688438 :       gel(st,sp++)=var[s_var.n+operand].value;
     905   469688438 :       break;
     906             :     case OCsimpleptrdyn:
     907             :       {
     908    14599851 :         gp_pointer *g = new_ptr();
     909    14599851 :         g->vn=0;
     910    14599851 :         g->ep = (entree*) operand;
     911    14599851 :         g->x = checkvalueptr(g->ep);
     912    14599851 :         g->ox = g->x; clone_lock(g->ox);
     913    14599851 :         g->sp = sp;
     914    14599851 :         gel(st,sp++) = (GEN)&(g->x);
     915    14599851 :         break;
     916             :       }
     917             :     case OCsimpleptrlex:
     918             :       {
     919    27809196 :         gp_pointer *g = new_ptr();
     920    27809196 :         g->vn=operand;
     921    27809196 :         g->ep=(entree *)0x1L;
     922    27809196 :         g->x = (GEN) var[s_var.n+operand].value;
     923    27809196 :         g->ox = g->x; clone_lock(g->ox);
     924    27809196 :         g->sp = sp;
     925    27809196 :         gel(st,sp++) = (GEN)&(g->x);
     926    27809196 :         break;
     927             :       }
     928             :     case OCnewptrdyn:
     929             :       {
     930        2618 :         entree *ep = (entree *)operand;
     931        2618 :         gp_pointer *g = new_ptr();
     932             :         matcomp *C;
     933        2618 :         checkvalue(ep, chk_ERROR);
     934        2618 :         g->sp = -1;
     935        2618 :         g->x = copyvalue(ep);
     936        2618 :         g->ox = g->x; clone_lock(g->ox);
     937        2618 :         g->vn=0;
     938        2618 :         g->ep=NULL;
     939        2618 :         C=&g->c;
     940        2618 :         C->full_col = C->full_row = 0;
     941        2618 :         C->parent   = (GEN)    g->x;
     942        2618 :         C->ptcell   = (GEN *) &g->x;
     943        2618 :         break;
     944             :       }
     945             :     case OCnewptrlex:
     946             :       {
     947     8541953 :         gp_pointer *g = new_ptr();
     948             :         matcomp *C;
     949     8541953 :         g->sp = -1;
     950     8541953 :         g->x = copylex(operand);
     951     8541953 :         g->ox = g->x; clone_lock(g->ox);
     952     8541953 :         g->vn=0;
     953     8541953 :         g->ep=NULL;
     954     8541953 :         C=&g->c;
     955     8541953 :         C->full_col = C->full_row = 0;
     956     8541953 :         C->parent   = (GEN)     g->x;
     957     8541953 :         C->ptcell   = (GEN *) &(g->x);
     958     8541953 :         break;
     959             :       }
     960             :     case OCpushptr:
     961             :       {
     962          77 :         gp_pointer *g = &ptrs[rp-1];
     963          77 :         g->sp = sp;
     964          77 :         gel(st,sp++) = (GEN)&(g->x);
     965             :       }
     966          77 :       break;
     967             :     case OCendptr:
     968    84818136 :       for(j=0;j<operand;j++)
     969             :       {
     970    42409068 :         gp_pointer *g = &ptrs[--rp];
     971    42409068 :         if (g->ep)
     972             :         {
     973    42408991 :           if (g->vn)
     974    27809196 :             changelex(g->vn, g->x);
     975             :           else
     976    14599795 :             changevalue(g->ep, g->x);
     977             :         }
     978          77 :         else change_compo(&(g->c), g->x);
     979    42409068 :         clone_unlock(g->ox);
     980             :       }
     981    42409068 :       break;
     982             :     case OCstoredyn:
     983             :       {
     984     5938985 :         entree *ep = (entree *)operand;
     985     5938985 :         checkvalue(ep, chk_NOCREATE);
     986     5938985 :         changevalue(ep, gel(st,--sp));
     987     5938985 :         break;
     988             :       }
     989             :     case OCstorelex:
     990   118340069 :       changelex(operand,gel(st,--sp));
     991   118340069 :       break;
     992             :     case OCstoreptr:
     993             :       {
     994     8544445 :         gp_pointer *g = &ptrs[--rp];
     995     8544445 :         change_compo(&(g->c), gel(st,--sp));
     996     8544368 :         clone_unlock(g->ox);
     997     8544368 :         break;
     998             :       }
     999             :     case OCstackgen:
    1000             :       {
    1001    18994541 :         GEN z = gerepileupto(st[sp-2],gel(st,sp-1));
    1002    18994543 :         gmael(st,sp-3,operand) = copyupto(z,gel(st,sp-2));
    1003    18994545 :         st[sp-2] = avma;
    1004    18994545 :         sp--;
    1005    18994545 :         break;
    1006             :       }
    1007             :     case OCprecreal:
    1008    14031907 :       st[sp++]=get_localprec();
    1009    14031906 :       break;
    1010             :     case OCbitprecreal:
    1011       16044 :       st[sp++]=get_localbitprec();
    1012       16044 :       break;
    1013             :     case OCprecdl:
    1014        1708 :       st[sp++]=precdl;
    1015        1708 :       break;
    1016             :     case OCavma:
    1017        1673 :       st[sp++]=avma;
    1018        1673 :       break;
    1019             :     case OCcowvardyn:
    1020             :       {
    1021      735343 :         entree *ep = (entree *)operand;
    1022      735343 :         checkvalue(ep, chk_ERROR);
    1023      735343 :         (void)copyvalue(ep);
    1024      735343 :         break;
    1025             :       }
    1026             :     case OCcowvarlex:
    1027       50778 :       (void)copylex(operand);
    1028       50778 :       break;
    1029             :     case OCstoi:
    1030    14497911 :       gel(st,sp-1)=stoi(st[sp-1]);
    1031    14497979 :       break;
    1032             :     case OCutoi:
    1033           0 :       gel(st,sp-1)=utoi(st[sp-1]);
    1034           0 :       break;
    1035             :     case OCitos:
    1036    65537800 :       st[sp+operand]=gtos(gel(st,sp+operand));
    1037    65537783 :       break;
    1038             :     case OCitou:
    1039      112500 :       st[sp+operand]=gtou(gel(st,sp+operand));
    1040      112553 :       break;
    1041             :     case OCtostr:
    1042             :       {
    1043        4726 :         GEN z = gel(st,sp+operand);
    1044        4726 :         st[sp+operand] = (long)GENtostr_unquoted(z);
    1045        4726 :         break;
    1046             :       }
    1047             :     case OCvarn:
    1048      996940 :       st[sp+operand] = closure_varn(gel(st,sp+operand));
    1049      996940 :       break;
    1050             :     case OCcopy:
    1051    24722015 :       gel(st,sp-1) = gcopy(gel(st,sp-1));
    1052    24722016 :       break;
    1053             :     case OCgerepile:
    1054             :     {
    1055             :       pari_sp av;
    1056             :       GEN x;
    1057        1673 :       sp--;
    1058        1673 :       av = st[sp-1];
    1059        1673 :       x = gel(st,sp);
    1060        1673 :       if (isonstack(x))
    1061             :       {
    1062        1673 :         pari_sp av2 = (pari_sp)(x + lg(x));
    1063        1673 :         if ((long) (av - av2) > 1000000L)
    1064             :         {
    1065           0 :           if (DEBUGMEM>=2)
    1066           0 :             pari_warn(warnmem,"eval: recovering %ld bytes", av - av2);
    1067           0 :           x = gerepileupto(av, x);
    1068             :         }
    1069           0 :       } else avma = av;
    1070        1673 :       gel(st,sp-1) = x;
    1071        1673 :       break;
    1072             :     }
    1073             :     case OCcopyifclone:
    1074           0 :       if (isclone(gel(st,sp-1)))
    1075           0 :         gel(st,sp-1) = gcopy(gel(st,sp-1));
    1076           0 :       break;
    1077             :     case OCcompo1:
    1078             :       {
    1079    72401671 :         GEN  p=gel(st,sp-2);
    1080    72401671 :         long c=st[sp-1];
    1081    72401671 :         sp-=2;
    1082    72401671 :         switch(typ(p))
    1083             :         {
    1084             :         case t_VEC: case t_COL:
    1085    72400978 :           check_array_index(c, lg(p));
    1086    72400978 :           closure_castgen(gel(p,c),operand);
    1087    72400973 :           break;
    1088             :         case t_LIST:
    1089             :           {
    1090             :             long lx;
    1091           7 :             if (list_typ(p)!=t_LIST_RAW)
    1092           0 :               pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1093           7 :             p = list_data(p); lx = p? lg(p): 1;
    1094           7 :             check_array_index(c, lx);
    1095           7 :             closure_castgen(gel(p,c),operand);
    1096           7 :             break;
    1097             :           }
    1098             :         case t_VECSMALL:
    1099         679 :           check_array_index(c,lg(p));
    1100         665 :           closure_castlong(p[c],operand);
    1101         665 :           break;
    1102             :         default:
    1103           7 :           pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
    1104           0 :           break;
    1105             :         }
    1106    72401645 :         break;
    1107             :       }
    1108             :     case OCcompo1ptr:
    1109             :       {
    1110     8393847 :         long c=st[sp-1];
    1111             :         long lx;
    1112     8393847 :         gp_pointer *g = &ptrs[rp-1];
    1113     8393847 :         matcomp *C=&g->c;
    1114     8393847 :         GEN p = g->x;
    1115     8393847 :         sp--;
    1116     8393847 :         switch(typ(p))
    1117             :         {
    1118             :         case t_VEC: case t_COL:
    1119     8393784 :           check_array_index(c, lg(p));
    1120     8393784 :           C->ptcell = (GEN *) p+c;
    1121     8393784 :           ptr_proplock(g, *(C->ptcell));
    1122     8393784 :           break;
    1123             :         case t_VECSMALL:
    1124          28 :           check_array_index(c, lg(p));
    1125          21 :           C->ptcell = (GEN *) p+c;
    1126          21 :           g->x = stoi(p[c]);
    1127          21 :           break;
    1128             :         case t_LIST:
    1129          28 :           if (list_typ(p)!=t_LIST_RAW)
    1130           0 :             pari_err_TYPE("&_[_] OCcompo1 [not a vector]", p);
    1131          28 :           p = list_data(p); lx = p? lg(p): 1;
    1132          28 :           check_array_index(c,lx);
    1133          28 :           C->ptcell = (GEN *) p+c;
    1134          28 :           ptr_proplock(g, *(C->ptcell));
    1135          28 :           break;
    1136             :         default:
    1137           7 :           pari_err_TYPE("&_[_] OCcompo1ptr [not a vector]", p);
    1138             :         }
    1139     8393833 :         C->parent   = p;
    1140     8393833 :         break;
    1141             :       }
    1142             :     case OCcompo2:
    1143             :       {
    1144        7819 :         GEN  p=gel(st,sp-3);
    1145        7819 :         long c=st[sp-2];
    1146        7819 :         long d=st[sp-1];
    1147        7819 :         if (typ(p)!=t_MAT) pari_err_TYPE("_[_,_] OCcompo2 [not a matrix]", p);
    1148        7812 :         check_array_index(d, lg(p));
    1149        7812 :         check_array_index(c, lg(gel(p,d)));
    1150        7812 :         sp-=3;
    1151        7812 :         closure_castgen(gcoeff(p,c,d),operand);
    1152        7812 :         break;
    1153             :       }
    1154             :     case OCcompo2ptr:
    1155             :       {
    1156         343 :         long c=st[sp-2];
    1157         343 :         long d=st[sp-1];
    1158         343 :         gp_pointer *g = &ptrs[rp-1];
    1159         343 :         matcomp *C=&g->c;
    1160         343 :         GEN p = g->x;
    1161         343 :         sp-=2;
    1162         343 :         if (typ(p)!=t_MAT)
    1163           0 :           pari_err_TYPE("&_[_,_] OCcompo2ptr [not a matrix]", p);
    1164         343 :         check_array_index(d, lg(p));
    1165         343 :         check_array_index(c, lg(gel(p,d)));
    1166         343 :         C->ptcell = (GEN *) gel(p,d)+c;
    1167         343 :         C->parent   = p;
    1168         343 :         ptr_proplock(g, *(C->ptcell));
    1169         343 :         break;
    1170             :       }
    1171             :     case OCcompoC:
    1172             :       {
    1173      691264 :         GEN  p=gel(st,sp-2);
    1174      691264 :         long c=st[sp-1];
    1175      691264 :         if (typ(p)!=t_MAT)
    1176           7 :           pari_err_TYPE("_[,_] OCcompoC [not a matrix]", p);
    1177      691257 :         check_array_index(c, lg(p));
    1178      691250 :         sp--;
    1179      691250 :         gel(st,sp-1) = gel(p,c);
    1180      691250 :         break;
    1181             :       }
    1182             :     case OCcompoCptr:
    1183             :       {
    1184      150598 :         long c=st[sp-1];
    1185      150598 :         gp_pointer *g = &ptrs[rp-1];
    1186      150598 :         matcomp *C=&g->c;
    1187      150598 :         GEN p = g->x;
    1188      150598 :         sp--;
    1189      150598 :         if (typ(p)!=t_MAT)
    1190           7 :           pari_err_TYPE("&_[,_] OCcompoCptr [not a matrix]", p);
    1191      150591 :         check_array_index(c, lg(p));
    1192      150584 :         C->ptcell = (GEN *) p+c;
    1193      150584 :         C->full_col = c;
    1194      150584 :         C->parent   = p;
    1195      150584 :         ptr_proplock(g, *(C->ptcell));
    1196      150584 :         break;
    1197             :       }
    1198             :     case OCcompoL:
    1199             :       {
    1200       61922 :         GEN  p=gel(st,sp-2);
    1201       61922 :         long r=st[sp-1];
    1202       61922 :         sp--;
    1203       61922 :         if (typ(p)!=t_MAT)
    1204           7 :           pari_err_TYPE("_[_,] OCcompoL [not a matrix]", p);
    1205       61915 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1206       61908 :         gel(st,sp-1) = row(p,r);
    1207       61908 :         break;
    1208             :       }
    1209             :     case OCcompoLptr:
    1210             :       {
    1211          77 :         long r=st[sp-1];
    1212          77 :         gp_pointer *g = &ptrs[rp-1];
    1213          77 :         matcomp *C=&g->c;
    1214          77 :         GEN p = g->x, p2;
    1215          77 :         sp--;
    1216          77 :         if (typ(p)!=t_MAT)
    1217           7 :           pari_err_TYPE("&_[_,] OCcompoLptr [not a matrix]", p);
    1218          70 :         check_array_index(r,lg(p) == 1? 1: lgcols(p));
    1219          63 :         p2 = rowcopy(p,r);
    1220          63 :         C->full_row = r; /* record row number */
    1221          63 :         C->ptcell = &p2;
    1222          63 :         C->parent   = p;
    1223          63 :         g->x = p2;
    1224          63 :         break;
    1225             :       }
    1226             :     case OCdefaultarg:
    1227        6839 :       if (var[s_var.n+operand].flag==DEFAULT_VAL)
    1228             :       {
    1229        1708 :         GEN z = gel(st,sp-1);
    1230        1708 :         if (typ(z)==t_CLOSURE)
    1231             :         {
    1232         700 :           pushlex(operand, closure_evalnobrk(z));
    1233         700 :           copylex(operand);
    1234             :         }
    1235             :         else
    1236        1008 :           pushlex(operand, z);
    1237             :       }
    1238        6839 :       sp--;
    1239        6839 :       break;
    1240             :     case OClocalvar:
    1241             :       {
    1242          28 :         long n = pari_stack_new(&s_lvars);
    1243          28 :         entree *ep = (entree *)operand;
    1244          28 :         checkvalue(ep, chk_NOCREATE);
    1245          28 :         lvars[n] = ep;
    1246          28 :         nblvar++;
    1247          28 :         pushvalue(ep,gel(st,--sp));
    1248          28 :         break;
    1249             :       }
    1250             :     case OClocalvar0:
    1251             :       {
    1252          14 :         long n = pari_stack_new(&s_lvars);
    1253          14 :         entree *ep = (entree *)operand;
    1254          14 :         checkvalue(ep, chk_NOCREATE);
    1255          14 :         lvars[n] = ep;
    1256          14 :         nblvar++;
    1257          14 :         zerovalue(ep);
    1258          14 :         break;
    1259             :       }
    1260             : 
    1261             : #define EVAL_f(f) \
    1262             :   switch (ep->arity) \
    1263             :   { \
    1264             :     case 0: f(); break; \
    1265             :     case 1: sp--; f(st[sp]); break; \
    1266             :     case 2: sp-=2; f(st[sp],st[sp+1]); break; \
    1267             :     case 3: sp-=3; f(st[sp],st[sp+1],st[sp+2]); break; \
    1268             :     case 4: sp-=4; f(st[sp],st[sp+1],st[sp+2],st[sp+3]); break; \
    1269             :     case 5: sp-=5; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4]); break; \
    1270             :     case 6: sp-=6; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5]); break; \
    1271             :     case 7: sp-=7; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6]); break; \
    1272             :     case 8: sp-=8; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7]); break; \
    1273             :     case 9: sp-=9; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8]); break; \
    1274             :     case 10: sp-=10; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9]); break; \
    1275             :     case 11: sp-=11; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10]); break; \
    1276             :     case 12: sp-=12; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11]); break; \
    1277             :     case 13: sp-=13; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12]); break; \
    1278             :     case 14: sp-=14; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13]); break; \
    1279             :     case 15: sp-=15; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14]); break; \
    1280             :     case 16: sp-=16; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15]); break; \
    1281             :     case 17: sp-=17; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16]); break; \
    1282             :     case 18: sp-=18; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17]); break; \
    1283             :     case 19: sp-=19; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17],st[sp+18]); break; \
    1284             :     case 20: sp-=20; f(st[sp],st[sp+1],st[sp+2],st[sp+3],st[sp+4],st[sp+5],st[sp+6],st[sp+7],st[sp+8],st[sp+9],st[sp+10],st[sp+11],st[sp+12],st[sp+13],st[sp+14],st[sp+15],st[sp+16],st[sp+17],st[sp+18],st[sp+19]); break; \
    1285             :     default: \
    1286             :       pari_err_IMPL("functions with more than 20 parameters");\
    1287             :       goto endeval; /*LCOV_EXCL_LINE*/ \
    1288             :   }
    1289             : 
    1290             :     case OCcallgen:
    1291             :       {
    1292    73629105 :         entree *ep = (entree *)operand;
    1293             :         GEN res;
    1294             :         /* Macro Madness : evaluate function ep->value on arguments
    1295             :          * st[sp-ep->arity .. sp]. Set res = result. */
    1296    73629105 :         EVAL_f(res = ((GEN (*)(ANYARG))ep->value));
    1297    73617721 :         if (br_status) goto endeval;
    1298    73479039 :         gel(st,sp++)=res;
    1299    73479039 :         break;
    1300             :       }
    1301             :     case OCcallgen2: /*same for ep->arity = 2. Is this optimization worth it ?*/
    1302             :       {
    1303   401504073 :         entree *ep = (entree *)operand;
    1304             :         GEN res;
    1305   401504073 :         sp-=2;
    1306   401504073 :         res = ((GEN (*)(GEN,GEN))ep->value)(gel(st,sp),gel(st,sp+1));
    1307   401976391 :         if (br_status) goto endeval;
    1308   401976363 :         gel(st,sp++)=res;
    1309   401976363 :         break;
    1310             :       }
    1311             :     case OCcalllong:
    1312             :       {
    1313    12806769 :         entree *ep = (entree *)operand;
    1314             :         long res;
    1315    12806769 :         EVAL_f(res = ((long (*)(ANYARG))ep->value));
    1316    12806378 :         if (br_status) goto endeval;
    1317    12806378 :         st[sp++] = res;
    1318    12806378 :         break;
    1319             :       }
    1320             :     case OCcallint:
    1321             :       {
    1322     1693748 :         entree *ep = (entree *)operand;
    1323             :         long res;
    1324     1693748 :         EVAL_f(res = ((int (*)(ANYARG))ep->value));
    1325     1693657 :         if (br_status) goto endeval;
    1326     1693657 :         st[sp++] = res;
    1327     1693657 :         break;
    1328             :       }
    1329             :     case OCcallvoid:
    1330             :       {
    1331    37794679 :         entree *ep = (entree *)operand;
    1332    37794679 :         EVAL_f(((void (*)(ANYARG))ep->value));
    1333    37794332 :         if (br_status) goto endeval;
    1334    37637738 :         break;
    1335             :       }
    1336             : #undef EVAL_f
    1337             : 
    1338             :     case OCcalluser:
    1339             :       {
    1340    34433642 :         long n=operand;
    1341    34433642 :         GEN fun = gel(st,sp-1-n);
    1342             :         long arity, isvar;
    1343             :         GEN z;
    1344    34433642 :         if (typ(fun)!=t_CLOSURE) pari_err(e_NOTFUNC, fun);
    1345    34430919 :         isvar = closure_is_variadic(fun);
    1346    34430917 :         arity = closure_arity(fun);
    1347    34430918 :         if (!isvar || n < arity)
    1348             :         {
    1349    34430848 :           st_alloc(arity-n);
    1350    34430856 :           if (n>arity)
    1351           0 :             pari_err(e_MISC,"too many parameters in user-defined function call");
    1352    34450355 :           for (j=n+1;j<=arity;j++)
    1353       19500 :             gel(st,sp++)=0;
    1354    34430855 :           if (isvar) gel(st,sp-1) = cgetg(1,t_VEC);
    1355             :         }
    1356             :         else
    1357             :         {
    1358             :           GEN v;
    1359          70 :           long j, m = n-arity+1;
    1360          70 :           v = cgetg(m+1,t_VEC);
    1361          70 :           sp-=m;
    1362         301 :           for (j=1; j<=m; j++)
    1363         231 :             gel(v,j) = gel(st,sp+j-1)? gcopy(gel(st,sp+j-1)): gen_0;
    1364          70 :           gel(st,sp++)=v;
    1365             :         }
    1366    34430925 :         z = closure_return(fun);
    1367    34427173 :         if (br_status) goto endeval;
    1368    34427173 :         gel(st, sp-1) = z;
    1369    34427173 :         break;
    1370             :       }
    1371             :     case OCnewframe:
    1372    33163716 :       if (operand>0) nbmvar+=operand;
    1373          12 :       else operand=-operand;
    1374    33163716 :       pari_stack_alloc(&s_var,operand);
    1375    33163719 :       s_var.n+=operand;
    1376    94454830 :       for(j=1;j<=operand;j++)
    1377             :       {
    1378    61291111 :         var[s_var.n-j].flag=PUSH_VAL;
    1379    61291111 :         var[s_var.n-j].value=gen_0;
    1380             :       }
    1381    33163719 :       break;
    1382             :     case OCsaveframe:
    1383             :       {
    1384        4907 :         GEN cl = (operand?gcopy:shallowcopy)(gel(st,sp-1));
    1385        4907 :         long l = lg(gel(cl,7));
    1386        4907 :         GEN  v = cgetg(l, t_VEC);
    1387       70273 :         for(j=1; j<l; j++)
    1388             :         {
    1389       65366 :           GEN val = var[s_var.n-j].value;
    1390       65366 :           gel(v,j) = operand?gcopy(val):val;
    1391             :         }
    1392        4907 :         gel(cl,7) = v;
    1393        4907 :         gel(st,sp-1) = cl;
    1394             :       }
    1395        4907 :       break;
    1396             :     case OCgetargs:
    1397    34560777 :       pari_stack_alloc(&s_var,operand);
    1398    34560971 :       s_var.n+=operand;
    1399    34560971 :       nbmvar+=operand;
    1400    34560971 :       sp-=operand;
    1401    94904382 :       for (j=0;j<operand;j++)
    1402             :       {
    1403    60343430 :         if (gel(st,sp+j))
    1404    60340679 :           pushlex(j-operand,gel(st,sp+j));
    1405             :         else
    1406             :         {
    1407        2751 :           var[s_var.n+j-operand].flag=DEFAULT_VAL;
    1408        2751 :           var[s_var.n+j-operand].value=gen_0;
    1409             :         }
    1410             :       }
    1411    34560952 :       break;
    1412             :     case OCcheckuserargs:
    1413          77 :       for (j=0; j<operand; j++)
    1414          56 :         if (var[s_var.n-operand+j].flag==DEFAULT_VAL)
    1415          14 :           pari_err(e_MISC,"missing mandatory argument"
    1416             :                    " '%s' in user function",get_arg_name(C,j+1));
    1417          21 :       break;
    1418             :     case OCcheckargs:
    1419     6681381 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1420     5282202 :         if ((operand&1L) && gel(st,j)==NULL)
    1421           0 :           pari_err(e_MISC,"missing mandatory argument");
    1422     1399179 :       break;
    1423             :     case OCcheckargs0:
    1424         336 :       for (j=sp-1;operand;operand>>=1UL,j--)
    1425         168 :         if ((operand&1L) && gel(st,j))
    1426           0 :           pari_err(e_MISC,"argument type not implemented");
    1427         168 :       break;
    1428             :     case OCdefaultlong:
    1429       21616 :       sp--;
    1430       21616 :       if (st[sp+operand])
    1431         910 :         st[sp+operand]=gtos(gel(st,sp+operand));
    1432             :       else
    1433       20706 :         st[sp+operand]=st[sp];
    1434       21623 :       break;
    1435             :     case OCdefaultulong:
    1436           0 :       sp--;
    1437           0 :       if (st[sp+operand])
    1438           0 :         st[sp+operand]=gtou(gel(st,sp+operand));
    1439             :       else
    1440           0 :         st[sp+operand]=st[sp];
    1441           0 :       break;
    1442             :     case OCdefaultgen:
    1443           0 :       sp--;
    1444           0 :       if (!st[sp+operand])
    1445           0 :         st[sp+operand]=st[sp];
    1446           0 :       break;
    1447             :     case OCvec:
    1448     8625234 :       gel(st,sp++)=cgetg(operand,t_VEC);
    1449     8625234 :       st[sp++]=avma;
    1450     8625234 :       break;
    1451             :     case OCcol:
    1452        2625 :       gel(st,sp++)=cgetg(operand,t_COL);
    1453        2625 :       st[sp++]=avma;
    1454        2625 :       break;
    1455             :     case OCmat:
    1456             :       {
    1457             :         GEN z;
    1458       53641 :         long l=st[sp-1];
    1459       53641 :         z=cgetg(operand,t_MAT);
    1460      177604 :         for(j=1;j<operand;j++)
    1461      123963 :           gel(z,j) = cgetg(l,t_COL);
    1462       53641 :         gel(st,sp-1) = z;
    1463       53641 :         st[sp++]=avma;
    1464             :       }
    1465       53641 :       break;
    1466             :     case OCpop:
    1467    63138098 :       sp-=operand;
    1468    63138098 :       break;
    1469             :     case OCdup:
    1470             :       {
    1471    22834923 :         long i, s=st[sp-1];
    1472    22834923 :         st_alloc(operand);
    1473    45677000 :         for(i=1;i<=operand;i++)
    1474    22842077 :           st[sp++]=s;
    1475             :       }
    1476    22834923 :       break;
    1477             :     }
    1478             :   }
    1479             :   if (0)
    1480             :   {
    1481             : endeval:
    1482      295304 :     sp = saved_sp;
    1483      590608 :     for(  ; rp>saved_rp ;  )
    1484             :     {
    1485           0 :       gp_pointer *g = &ptrs[--rp];
    1486           0 :       clone_unlock(g->ox);
    1487             :     }
    1488             :   }
    1489   218097949 :   s_prec.n = saved_prec;
    1490   218097949 :   s_trace.n--;
    1491   218097949 :   restore_vars(nbmvar, nblvar);
    1492   217372545 :   clone_unlock(C);
    1493   217343929 : }
    1494             : 
    1495             : GEN
    1496    23613853 : closure_evalgen(GEN C)
    1497             : {
    1498    23613853 :   pari_sp ltop=avma;
    1499    23613853 :   closure_eval(C);
    1500    23580180 :   if (br_status) { avma=ltop; return NULL; }
    1501    23580118 :   return gerepileupto(ltop,gel(st,--sp));
    1502             : }
    1503             : 
    1504             : void
    1505     1354015 : evalstate_save(struct pari_evalstate *state)
    1506             : {
    1507     1354015 :   state->avma = avma;
    1508     1354015 :   state->sp   = sp;
    1509     1354015 :   state->rp   = rp;
    1510     1354015 :   state->prec = s_prec.n;
    1511     1354015 :   state->var  = s_var.n;
    1512     1354015 :   state->lvars= s_lvars.n;
    1513     1354015 :   state->trace= s_trace.n;
    1514     1354015 :   compilestate_save(&state->comp);
    1515     1354015 :   mtstate_save(&state->pending_threads);
    1516     1354015 : }
    1517             : 
    1518             : void
    1519       41660 : evalstate_restore(struct pari_evalstate *state)
    1520             : {
    1521       41660 :   avma = state->avma;
    1522       41660 :   mtstate_restore(&state->pending_threads);
    1523       41660 :   sp = state->sp;
    1524       41660 :   rp = state->rp;
    1525       41660 :   s_prec.n = state->prec;
    1526       41660 :   restore_vars(s_var.n-state->var,s_lvars.n-state->lvars);
    1527       41660 :   restore_trace(s_trace.n-state->trace);
    1528       41660 :   reset_break();
    1529       41660 :   compilestate_restore(&state->comp);
    1530       41660 : }
    1531             : 
    1532             : GEN
    1533       33660 : evalstate_restore_err(struct pari_evalstate *state)
    1534             : {
    1535       33660 :   GENbin* err = copy_bin(pari_err_last());
    1536       33660 :   evalstate_restore(state);
    1537       33660 :   return bin_copy(err);
    1538             : }
    1539             : 
    1540             : void
    1541         256 : evalstate_reset(void)
    1542             : {
    1543         256 :   mtstate_reset();
    1544         256 :   sp = 0;
    1545         256 :   rp = 0;
    1546         256 :   dbg_level = 0;
    1547         256 :   restore_vars(s_var.n, s_lvars.n);
    1548         256 :   s_trace.n = 0;
    1549         256 :   reset_break();
    1550         256 :   compilestate_reset();
    1551         256 :   parsestate_reset();
    1552         256 :   avma = pari_mainstack->top;
    1553         256 : }
    1554             : 
    1555             : void
    1556           0 : evalstate_clone(void)
    1557             : {
    1558             :   long i;
    1559           0 :   for (i = 1; i<=s_var.n; i++) copylex(-i);
    1560           0 :   lvar_make_safe();
    1561           0 :   for (i = 0; i< s_trace.n; i++)
    1562             :   {
    1563           0 :     GEN C = trace[i].closure;
    1564           0 :     if (isonstack(C)) trace[i].closure = gclone(C);
    1565             :   }
    1566           0 : }
    1567             : 
    1568             : GEN
    1569          21 : closure_trapgen(GEN C, long numerr)
    1570             : {
    1571             :   VOLATILE GEN x;
    1572             :   struct pari_evalstate state;
    1573          21 :   evalstate_save(&state);
    1574          21 :   pari_CATCH(numerr) { x = (GEN)1L; }
    1575          21 :   pari_TRY { x = closure_evalgen(C); } pari_ENDCATCH;
    1576          14 :   if (x == (GEN)1L) evalstate_restore(&state);
    1577          14 :   return x;
    1578             : }
    1579             : 
    1580             : GEN
    1581    33905886 : closure_evalnobrk(GEN C)
    1582             : {
    1583    33905886 :   pari_sp ltop=avma;
    1584    33905886 :   closure_eval(C);
    1585    33905879 :   if (br_status) pari_err(e_MISC, "break not allowed here");
    1586    33905872 :   return gerepileupto(ltop,gel(st,--sp));
    1587             : }
    1588             : 
    1589             : void
    1590   123817642 : closure_evalvoid(GEN C)
    1591             : {
    1592   123817642 :   pari_sp ltop=avma;
    1593   123817642 :   closure_eval(C);
    1594   123823209 :   avma=ltop;
    1595   123823209 : }
    1596             : 
    1597             : GEN
    1598       82753 : closure_evalres(GEN C)
    1599             : {
    1600       82753 :   return closure_return(C);
    1601             : }
    1602             : 
    1603             : INLINE GEN
    1604     1533445 : closure_returnupto(GEN C)
    1605             : {
    1606     1533445 :   pari_sp av=avma;
    1607     1533445 :   return copyupto(closure_return(C),(GEN)av);
    1608             : }
    1609             : 
    1610             : GEN
    1611          12 : pareval_worker(GEN C)
    1612             : {
    1613          12 :   return closure_callgenall(C, 0);
    1614             : }
    1615             : 
    1616             : GEN
    1617           6 : pareval(GEN C)
    1618             : {
    1619           6 :   pari_sp av = avma;
    1620           6 :   long l = lg(C), i, pending = 0, workid;
    1621             :   struct pari_mt pt;
    1622             :   GEN worker, V, done;
    1623           6 :   if (!is_vec_t(typ(C))) pari_err_TYPE("pareval",C);
    1624          18 :   for (i=1; i<l; i++)
    1625          12 :     if (typ(gel(C,i))!=t_CLOSURE)
    1626           0 :       pari_err_TYPE("pareval",gel(C,i));
    1627           6 :   worker = snm_closure(is_entry("_pareval_worker"), NULL);
    1628           6 :   V = cgetg(l, t_VEC);
    1629           6 :   mt_queue_start_lim(&pt, worker, l-1);
    1630          20 :   for (i=1; i<l || pending; i++)
    1631             :   {
    1632          14 :     mt_queue_submit(&pt, i, i<l? mkvec(gel(C,i)): NULL);
    1633          14 :     done = mt_queue_get(&pt, &workid, &pending);
    1634          14 :     if (done) gel(V,workid) = done;
    1635             :   }
    1636           6 :   mt_queue_end(&pt);
    1637           6 :   return gerepilecopy(av, V);
    1638             : }
    1639             : 
    1640             : GEN
    1641       60031 : parvector_worker(GEN i, GEN C)
    1642             : {
    1643       60031 :   return closure_callgen1(C, i);
    1644             : }
    1645             : 
    1646             : GEN
    1647        5208 : parfor_worker(GEN i, GEN C)
    1648             : {
    1649        5208 :   retmkvec2(gcopy(i), closure_callgen1(C, i));
    1650             : }
    1651             : 
    1652             : GEN
    1653          12 : parvector(long n, GEN code)
    1654             : {
    1655          12 :   long i, pending = 0, workid;
    1656          12 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1657             :   GEN a, V, done;
    1658             :   struct pari_mt pt;
    1659          12 :   mt_queue_start_lim(&pt, worker, n);
    1660          12 :   a = mkvec(cgetipos(3)); /* left on the stack */
    1661          12 :   V = cgetg(n+1, t_VEC);
    1662         496 :   for (i=1; i<=n || pending; i++)
    1663             :   {
    1664         490 :     mael(a,1,2) = i;
    1665         490 :     mt_queue_submit(&pt, i, i<=n? a: NULL);
    1666         486 :     done = mt_queue_get(&pt, &workid, &pending);
    1667         484 :     if (done) gel(V,workid) = done;
    1668             :   }
    1669           6 :   mt_queue_end(&pt);
    1670           6 :   return V;
    1671             : }
    1672             : 
    1673             : GEN
    1674           6 : parsum(GEN a, GEN b, GEN code, GEN x)
    1675             : {
    1676           6 :   pari_sp av = avma, av2;
    1677           6 :   long pending = 0;
    1678           6 :   GEN worker = snm_closure(is_entry("_parvector_worker"), mkvec(code));
    1679             :   GEN done;
    1680             :   struct pari_mt pt;
    1681           6 :   if (typ(a) != t_INT) pari_err_TYPE("parsum",a);
    1682           6 :   if (!x) x = gen_0;
    1683           6 :   if (gcmp(b,a) < 0) return gcopy(x);
    1684             : 
    1685           6 :   mt_queue_start(&pt, worker);
    1686           6 :   b = gfloor(b);
    1687           6 :   a = mkvec(setloop(a));
    1688           6 :   av2=avma;
    1689       60036 :   for (; cmpii(gel(a,1),b) <= 0 || pending; gel(a,1) = incloop(gel(a,1)))
    1690             :   {
    1691       60030 :     mt_queue_submit(&pt, 0, cmpii(gel(a,1),b) <= 0? a: NULL);
    1692       60030 :     done = mt_queue_get(&pt, NULL, &pending);
    1693       60030 :     if (done)
    1694             :     {
    1695       60000 :       x = gadd(x, done);
    1696       60000 :       if (gc_needed(av2,1))
    1697             :       {
    1698           0 :         if (DEBUGMEM>1) pari_warn(warnmem,"sum");
    1699           0 :         x = gerepileupto(av2,x);
    1700             :       }
    1701             :     }
    1702             :   }
    1703           6 :   mt_queue_end(&pt);
    1704           6 :   return gerepilecopy(av, x);
    1705             : }
    1706             : 
    1707             : void
    1708         142 : parfor(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1709             : {
    1710         142 :   pari_sp av = avma, av2;
    1711         142 :   long running, pending = 0;
    1712         142 :   long status = br_NONE;
    1713         142 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1714         142 :   GEN done, stop = NULL;
    1715             :   struct pari_mt pt;
    1716         142 :   if (typ(a) != t_INT) pari_err_TYPE("parfor",a);
    1717         142 :   if (b)
    1718             :   {
    1719         142 :     if (gcmp(b,a) < 0) return;
    1720         142 :     if (typ(b) == t_INFINITY)
    1721             :     {
    1722           6 :       if (inf_get_sign(b) < 0) return;
    1723           6 :       b = NULL;
    1724             :     }
    1725             :     else
    1726         136 :       b = gfloor(b);
    1727             :   }
    1728         142 :   mt_queue_start(&pt, worker);
    1729         142 :   a = mkvec(setloop(a));
    1730         142 :   av2 = avma;
    1731        5766 :   while ((running = (!stop && (!b || cmpii(gel(a,1),b) <= 0))) || pending)
    1732             :   {
    1733        5488 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1734        5484 :     done = mt_queue_get(&pt, NULL, &pending);
    1735        5482 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1736        3816 :       if (call(E, gel(done,1), gel(done,2)))
    1737             :       {
    1738          28 :         status = br_status;
    1739          28 :         br_status = br_NONE;
    1740          28 :         stop = gerepileuptoint(av2, gel(done,1));
    1741             :       }
    1742        5482 :     gel(a,1) = incloop(gel(a,1));
    1743        5482 :     if (!stop) avma = av2;
    1744             :   }
    1745         136 :   avma = av2;
    1746         136 :   mt_queue_end(&pt);
    1747         136 :   br_status = status;
    1748         136 :   avma = av;
    1749             : }
    1750             : 
    1751             : static long
    1752        4038 : gp_evalvoid2(void *E, GEN x, GEN y)
    1753             : {
    1754        4038 :   GEN code =(GEN) E;
    1755        4038 :   push_lex(x, code);
    1756        4038 :   push_lex(y, NULL);
    1757        4038 :   closure_evalvoid(code);
    1758        4038 :   pop_lex(2);
    1759        4038 :   return loop_break();
    1760             : }
    1761             : 
    1762             : void
    1763         142 : parfor0(GEN a, GEN b, GEN code, GEN code2)
    1764             : {
    1765         142 :   parfor(a, b, code, (void*)code2, code2 ? gp_evalvoid2: NULL);
    1766         136 : }
    1767             : 
    1768             : void
    1769           6 : parforprime(GEN a, GEN b, GEN code, void *E, long call(void*, GEN, GEN))
    1770             : {
    1771           6 :   pari_sp av = avma, av2;
    1772           6 :   long running, pending = 0;
    1773           6 :   long status = br_NONE;
    1774           6 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1775           6 :   GEN v, done, stop = NULL;
    1776             :   struct pari_mt pt;
    1777             :   forprime_t T;
    1778             : 
    1779          12 :   if (!forprime_init(&T, a,b)) { avma = av; return; }
    1780           6 :   mt_queue_start(&pt, worker);
    1781           6 :   v = mkvec(gen_0);
    1782           6 :   av2 = avma;
    1783          76 :   while ((running = (!stop && forprime_next(&T))) || pending)
    1784             :   {
    1785          64 :     gel(v, 1) = T.pp;
    1786          64 :     mt_queue_submit(&pt, 0, running ? v: NULL);
    1787          64 :     done = mt_queue_get(&pt, NULL, &pending);
    1788          64 :     if (call && done && (!stop || cmpii(gel(done,1),stop) < 0))
    1789          48 :       if (call(E, gel(done,1), gel(done,2)))
    1790             :       {
    1791           0 :         status = br_status;
    1792           0 :         br_status = br_NONE;
    1793           0 :         stop = gerepileuptoint(av2, gel(done,1));
    1794             :       }
    1795          64 :     if (!stop) avma = av2;
    1796             :   }
    1797           6 :   avma = av2;
    1798           6 :   mt_queue_end(&pt);
    1799           6 :   br_status = status;
    1800           6 :   avma = av;
    1801             : }
    1802             : 
    1803             : void
    1804           6 : parforprime0(GEN a, GEN b, GEN code, GEN code2)
    1805             : {
    1806           6 :   parforprime(a, b, code, (void*)code2, code2? gp_evalvoid2: NULL);
    1807           6 : }
    1808             : 
    1809             : void
    1810          18 : parforvec(GEN x, GEN code, long flag, void *E, long call(void*, GEN, GEN))
    1811             : {
    1812          18 :   pari_sp av = avma, av2;
    1813          18 :   long running, pending = 0;
    1814          18 :   long status = br_NONE;
    1815          18 :   GEN worker = snm_closure(is_entry("_parfor_worker"), mkvec(code));
    1816          18 :   GEN done, stop = NULL;
    1817             :   struct pari_mt pt;
    1818             :   forvec_t T;
    1819          18 :   GEN a, v = gen_0;
    1820             : 
    1821          36 :   if (!forvec_init(&T, x, flag)) { avma = av; return; }
    1822          18 :   mt_queue_start(&pt, worker);
    1823          18 :   a = mkvec(gen_0);
    1824          18 :   av2 = avma;
    1825         268 :   while ((running = (!stop && v && (v = forvec_next(&T)))) || pending)
    1826             :   {
    1827         232 :     gel(a, 1) = v;
    1828         232 :     mt_queue_submit(&pt, 0, running ? a: NULL);
    1829         232 :     done = mt_queue_get(&pt, NULL, &pending);
    1830         232 :     if (call && done && (!stop || lexcmp(gel(done,1),stop) < 0))
    1831         174 :       if (call(E, gel(done,1), gel(done,2)))
    1832             :       {
    1833           0 :         status = br_status;
    1834           0 :         br_status = br_NONE;
    1835           0 :         stop = gerepilecopy(av2, gel(done,1));
    1836             :       }
    1837         232 :     if (!stop) avma = av2;
    1838             :   }
    1839          18 :   avma = av2;
    1840          18 :   mt_queue_end(&pt);
    1841          18 :   br_status = status;
    1842          18 :   avma = av;
    1843             : }
    1844             : 
    1845             : void
    1846          18 : parforvec0(GEN x, GEN code, GEN code2, long flag)
    1847             : {
    1848          18 :   parforvec(x, code, flag, (void*)code2, code2? gp_evalvoid2: NULL);
    1849          18 : }
    1850             : 
    1851             : void
    1852           0 : closure_callvoid1(GEN C, GEN x)
    1853             : {
    1854           0 :   long i, ar = closure_arity(C);
    1855           0 :   gel(st,sp++) = x;
    1856           0 :   for(i=2; i <= ar; i++) gel(st,sp++) = NULL;
    1857           0 :   closure_evalvoid(C);
    1858           0 : }
    1859             : 
    1860             : GEN
    1861      229009 : closure_callgen1(GEN C, GEN x)
    1862             : {
    1863      229009 :   long i, ar = closure_arity(C);
    1864      229044 :   gel(st,sp++) = x;
    1865      229044 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    1866      229044 :   return closure_returnupto(C);
    1867             : }
    1868             : 
    1869             : GEN
    1870       56493 : closure_callgen1prec(GEN C, GEN x, long prec)
    1871             : {
    1872             :   GEN z;
    1873       56493 :   long i, ar = closure_arity(C);
    1874       56493 :   gel(st,sp++) = x;
    1875       56493 :   for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
    1876       56493 :   push_localprec(prec);
    1877       56493 :   z = closure_returnupto(C);
    1878       56493 :   pop_localprec();
    1879       56493 :   return z;
    1880             : }
    1881             : 
    1882             : GEN
    1883       89278 : closure_callgen2(GEN C, GEN x, GEN y)
    1884             : {
    1885       89278 :   long i, ar = closure_arity(C);
    1886       89278 :   st_alloc(ar);
    1887       89278 :   gel(st,sp++) = x;
    1888       89278 :   gel(st,sp++) = y;
    1889       89278 :   for(i=3; i<=ar; i++) gel(st,sp++) = NULL;
    1890       89278 :   return closure_returnupto(C);
    1891             : }
    1892             : 
    1893             : GEN
    1894     1159718 : closure_callgenvec(GEN C, GEN args)
    1895             : {
    1896     1159718 :   long i, l = lg(args)-1, ar = closure_arity(C);
    1897     1160064 :   st_alloc(ar);
    1898     1159968 :   if (l > ar)
    1899           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    1900     1159968 :   if (closure_is_variadic(C) && l==ar && typ(gel(args,l))!=t_VEC)
    1901           7 :     pari_err_TYPE("call", gel(args,l));
    1902     1160000 :   for (i = 1; i <= l;  i++) gel(st,sp++) = gel(args,i);
    1903     1160000 :   for(      ; i <= ar; i++) gel(st,sp++) = NULL;
    1904     1160000 :   return closure_returnupto(C);
    1905             : }
    1906             : 
    1907             : GEN
    1908         105 : closure_callgenvecprec(GEN C, GEN args, long prec)
    1909             : {
    1910             :   GEN z;
    1911         105 :   push_localprec(prec);
    1912         105 :   z = closure_callgenvec(C, args);
    1913         105 :   pop_localprec();
    1914         105 :   return z;
    1915             : }
    1916             : 
    1917             : GEN
    1918          12 : closure_callgenall(GEN C, long n, ...)
    1919             : {
    1920             :   va_list ap;
    1921          12 :   long i, ar = closure_arity(C);
    1922          12 :   va_start(ap,n);
    1923          12 :   if (n > ar)
    1924           0 :     pari_err(e_MISC,"too many parameters in user-defined function call");
    1925          12 :   st_alloc(ar);
    1926          12 :   for (i = 1; i <=n;  i++) gel(st,sp++) = va_arg(ap, GEN);
    1927          12 :   for(      ; i <=ar; i++) gel(st,sp++) = NULL;
    1928          12 :   va_end(ap);
    1929          12 :   return closure_returnupto(C);
    1930             : }
    1931             : 
    1932             : GEN
    1933     7605922 : gp_eval(void *E, GEN x)
    1934             : {
    1935     7605922 :   GEN code = (GEN)E;
    1936     7605922 :   set_lex(-1,x);
    1937     7605922 :   return closure_evalnobrk(code);
    1938             : }
    1939             : 
    1940             : GEN
    1941      571487 : gp_evalupto(void *E, GEN x)
    1942             : {
    1943      571487 :   pari_sp av = avma;
    1944      571487 :   return copyupto(gp_eval(E,x), (GEN)av);
    1945             : }
    1946             : 
    1947             : GEN
    1948       19040 : gp_evalprec(void *E, GEN x, long prec)
    1949             : {
    1950             :   GEN z;
    1951       19040 :   push_localprec(prec);
    1952       19040 :   z = gp_eval(E, x);
    1953       19040 :   pop_localprec();
    1954       19040 :   return z;
    1955             : }
    1956             : 
    1957             : long
    1958      166999 : gp_evalbool(void *E, GEN x)
    1959             : {
    1960      166999 :   pari_sp av = avma;
    1961      166999 :   long res  = !gequal0(gp_eval(E,x));
    1962      166999 :   avma = av; return res;
    1963             : }
    1964             : 
    1965             : long
    1966     3654644 : gp_evalvoid(void *E, GEN x)
    1967             : {
    1968     3654644 :   GEN code = (GEN)E;
    1969     3654644 :   set_lex(-1,x);
    1970     3654644 :   closure_evalvoid(code);
    1971     3654644 :   return loop_break();
    1972             : }
    1973             : 
    1974             : GEN
    1975       17766 : gp_call(void *E, GEN x)
    1976             : {
    1977       17766 :   GEN code = (GEN)E;
    1978       17766 :   return closure_callgen1(code, x);
    1979             : }
    1980             : 
    1981             : GEN
    1982        3290 : gp_callprec(void *E, GEN x, long prec)
    1983             : {
    1984        3290 :   GEN code = (GEN)E;
    1985        3290 :   return closure_callgen1prec(code, x, prec);
    1986             : }
    1987             : 
    1988             : GEN
    1989          91 : gp_call2(void *E, GEN x, GEN y)
    1990             : {
    1991          91 :   GEN code = (GEN)E;
    1992          91 :   return closure_callgen2(code, x, y);
    1993             : }
    1994             : 
    1995             : long
    1996         672 : gp_callbool(void *E, GEN x)
    1997             : {
    1998         672 :   pari_sp av = avma;
    1999         672 :   GEN code = (GEN)E;
    2000         672 :   long res  = !gequal0(closure_callgen1(code, x));
    2001         672 :   avma = av; return res;
    2002             : }
    2003             : 
    2004             : long
    2005           0 : gp_callvoid(void *E, GEN x)
    2006             : {
    2007           0 :   GEN code = (GEN)E;
    2008           0 :   closure_callvoid1(code, x);
    2009           0 :   return loop_break();
    2010             : }
    2011             : 
    2012             : INLINE const char *
    2013           0 : disassemble_cast(long mode)
    2014             : {
    2015           0 :   switch (mode)
    2016             :   {
    2017             :   case Gsmall:
    2018           0 :     return "small";
    2019             :   case Ggen:
    2020           0 :     return "gen";
    2021             :   case Gvar:
    2022           0 :     return "var";
    2023             :   case Gvoid:
    2024           0 :     return "void";
    2025             :   default:
    2026           0 :     return "unknown";
    2027             :   }
    2028             : }
    2029             : 
    2030             : void
    2031           0 : closure_disassemble(GEN C)
    2032             : {
    2033             :   const char * code;
    2034             :   GEN oper;
    2035             :   long i;
    2036           0 :   if (typ(C)!=t_CLOSURE) pari_err_TYPE("disassemble",C);
    2037           0 :   code=closure_codestr(C);
    2038           0 :   oper=closure_get_oper(C);
    2039           0 :   for(i=1;i<lg(oper);i++)
    2040             :   {
    2041           0 :     op_code opcode=(op_code) code[i];
    2042           0 :     long operand=oper[i];
    2043           0 :     pari_printf("%05ld\t",i);
    2044           0 :     switch(opcode)
    2045             :     {
    2046             :     case OCpushlong:
    2047           0 :       pari_printf("pushlong\t%ld\n",operand);
    2048           0 :       break;
    2049             :     case OCpushgnil:
    2050           0 :       pari_printf("pushgnil\n");
    2051           0 :       break;
    2052             :     case OCpushgen:
    2053           0 :       pari_printf("pushgen\t\t%ld\n",operand);
    2054           0 :       break;
    2055             :     case OCpushreal:
    2056           0 :       pari_printf("pushreal\t%ld\n",operand);
    2057           0 :       break;
    2058             :     case OCpushstoi:
    2059           0 :       pari_printf("pushstoi\t%ld\n",operand);
    2060           0 :       break;
    2061             :     case OCpushvar:
    2062             :       {
    2063           0 :         entree *ep = (entree *)operand;
    2064           0 :         pari_printf("pushvar\t%s\n",ep->name);
    2065           0 :         break;
    2066             :       }
    2067             :     case OCpushdyn:
    2068             :       {
    2069           0 :         entree *ep = (entree *)operand;
    2070           0 :         pari_printf("pushdyn\t\t%s\n",ep->name);
    2071           0 :         break;
    2072             :       }
    2073             :     case OCpushlex:
    2074           0 :       pari_printf("pushlex\t\t%ld\n",operand);
    2075           0 :       break;
    2076             :     case OCstoredyn:
    2077             :       {
    2078           0 :         entree *ep = (entree *)operand;
    2079           0 :         pari_printf("storedyn\t%s\n",ep->name);
    2080           0 :         break;
    2081             :       }
    2082             :     case OCstorelex:
    2083           0 :       pari_printf("storelex\t%ld\n",operand);
    2084           0 :       break;
    2085             :     case OCstoreptr:
    2086           0 :       pari_printf("storeptr\n");
    2087           0 :       break;
    2088             :     case OCsimpleptrdyn:
    2089             :       {
    2090           0 :         entree *ep = (entree *)operand;
    2091           0 :         pari_printf("simpleptrdyn\t%s\n",ep->name);
    2092           0 :         break;
    2093             :       }
    2094             :     case OCsimpleptrlex:
    2095           0 :       pari_printf("simpleptrlex\t%ld\n",operand);
    2096           0 :       break;
    2097             :     case OCnewptrdyn:
    2098             :       {
    2099           0 :         entree *ep = (entree *)operand;
    2100           0 :         pari_printf("newptrdyn\t%s\n",ep->name);
    2101           0 :         break;
    2102             :       }
    2103             :     case OCnewptrlex:
    2104           0 :       pari_printf("newptrlex\t%ld\n",operand);
    2105           0 :       break;
    2106             :     case OCpushptr:
    2107           0 :       pari_printf("pushptr\n");
    2108           0 :       break;
    2109             :     case OCstackgen:
    2110           0 :       pari_printf("stackgen\t%ld\n",operand);
    2111           0 :       break;
    2112             :     case OCendptr:
    2113           0 :       pari_printf("endptr\t\t%ld\n",operand);
    2114           0 :       break;
    2115             :     case OCprecreal:
    2116           0 :       pari_printf("precreal\n");
    2117           0 :       break;
    2118             :     case OCbitprecreal:
    2119           0 :       pari_printf("bitprecreal\n");
    2120           0 :       break;
    2121             :     case OCprecdl:
    2122           0 :       pari_printf("precdl\n");
    2123           0 :       break;
    2124             :     case OCstoi:
    2125           0 :       pari_printf("stoi\n");
    2126           0 :       break;
    2127             :     case OCutoi:
    2128           0 :       pari_printf("utoi\n");
    2129           0 :       break;
    2130             :     case OCitos:
    2131           0 :       pari_printf("itos\t\t%ld\n",operand);
    2132           0 :       break;
    2133             :     case OCitou:
    2134           0 :       pari_printf("itou\t\t%ld\n",operand);
    2135           0 :       break;
    2136             :     case OCtostr:
    2137           0 :       pari_printf("tostr\t\t%ld\n",operand);
    2138           0 :       break;
    2139             :     case OCvarn:
    2140           0 :       pari_printf("varn\t\t%ld\n",operand);
    2141           0 :       break;
    2142             :     case OCcopy:
    2143           0 :       pari_printf("copy\n");
    2144           0 :       break;
    2145             :     case OCcopyifclone:
    2146           0 :       pari_printf("copyifclone\n");
    2147           0 :       break;
    2148             :     case OCcompo1:
    2149           0 :       pari_printf("compo1\t\t%s\n",disassemble_cast(operand));
    2150           0 :       break;
    2151             :     case OCcompo1ptr:
    2152           0 :       pari_printf("compo1ptr\n");
    2153           0 :       break;
    2154             :     case OCcompo2:
    2155           0 :       pari_printf("compo2\t\t%s\n",disassemble_cast(operand));
    2156           0 :       break;
    2157             :     case OCcompo2ptr:
    2158           0 :       pari_printf("compo2ptr\n");
    2159           0 :       break;
    2160             :     case OCcompoC:
    2161           0 :       pari_printf("compoC\n");
    2162           0 :       break;
    2163             :     case OCcompoCptr:
    2164           0 :       pari_printf("compoCptr\n");
    2165           0 :       break;
    2166             :     case OCcompoL:
    2167           0 :       pari_printf("compoL\n");
    2168           0 :       break;
    2169             :     case OCcompoLptr:
    2170           0 :       pari_printf("compoLptr\n");
    2171           0 :       break;
    2172             :     case OCcheckargs:
    2173           0 :       pari_printf("checkargs\t0x%lx\n",operand);
    2174           0 :       break;
    2175             :     case OCcheckargs0:
    2176           0 :       pari_printf("checkargs0\t0x%lx\n",operand);
    2177           0 :       break;
    2178             :     case OCcheckuserargs:
    2179           0 :       pari_printf("checkuserargs\t%ld\n",operand);
    2180           0 :       break;
    2181             :     case OCdefaultlong:
    2182           0 :       pari_printf("defaultlong\t%ld\n",operand);
    2183           0 :       break;
    2184             :     case OCdefaultulong:
    2185           0 :       pari_printf("defaultulong\t%ld\n",operand);
    2186           0 :       break;
    2187             :     case OCdefaultgen:
    2188           0 :       pari_printf("defaultgen\t%ld\n",operand);
    2189           0 :       break;
    2190             :     case OCgetargs:
    2191           0 :       pari_printf("getargs\t\t%ld\n",operand);
    2192           0 :       break;
    2193             :     case OCdefaultarg:
    2194           0 :       pari_printf("defaultarg\t%ld\n",operand);
    2195           0 :       break;
    2196             :     case OClocalvar:
    2197             :       {
    2198           0 :         entree *ep = (entree *)operand;
    2199           0 :         pari_printf("localvar\t%s\n",ep->name);
    2200           0 :         break;
    2201             :       }
    2202             :     case OClocalvar0:
    2203             :       {
    2204           0 :         entree *ep = (entree *)operand;
    2205           0 :         pari_printf("localvar0\t%s\n",ep->name);
    2206           0 :         break;
    2207             :       }
    2208             :     case OCcallgen:
    2209             :       {
    2210           0 :         entree *ep = (entree *)operand;
    2211           0 :         pari_printf("callgen\t\t%s\n",ep->name);
    2212           0 :         break;
    2213             :       }
    2214             :     case OCcallgen2:
    2215             :       {
    2216           0 :         entree *ep = (entree *)operand;
    2217           0 :         pari_printf("callgen2\t%s\n",ep->name);
    2218           0 :         break;
    2219             :       }
    2220             :     case OCcalllong:
    2221             :       {
    2222           0 :         entree *ep = (entree *)operand;
    2223           0 :         pari_printf("calllong\t%s\n",ep->name);
    2224           0 :         break;
    2225             :       }
    2226             :     case OCcallint:
    2227             :       {
    2228           0 :         entree *ep = (entree *)operand;
    2229           0 :         pari_printf("callint\t\t%s\n",ep->name);
    2230           0 :         break;
    2231             :       }
    2232             :     case OCcallvoid:
    2233             :       {
    2234           0 :         entree *ep = (entree *)operand;
    2235           0 :         pari_printf("callvoid\t%s\n",ep->name);
    2236           0 :         break;
    2237             :       }
    2238             :     case OCcalluser:
    2239           0 :       pari_printf("calluser\t%ld\n",operand);
    2240           0 :       break;
    2241             :     case OCvec:
    2242           0 :       pari_printf("vec\t\t%ld\n",operand);
    2243           0 :       break;
    2244             :     case OCcol:
    2245           0 :       pari_printf("col\t\t%ld\n",operand);
    2246           0 :       break;
    2247             :     case OCmat:
    2248           0 :       pari_printf("mat\t\t%ld\n",operand);
    2249           0 :       break;
    2250             :     case OCnewframe:
    2251           0 :       pari_printf("newframe\t%ld\n",operand);
    2252           0 :       break;
    2253             :     case OCsaveframe:
    2254           0 :       pari_printf("saveframe\t%ld\n", operand);
    2255           0 :       break;
    2256             :     case OCpop:
    2257           0 :       pari_printf("pop\t\t%ld\n",operand);
    2258           0 :       break;
    2259             :     case OCdup:
    2260           0 :       pari_printf("dup\t\t%ld\n",operand);
    2261           0 :       break;
    2262             :     case OCavma:
    2263           0 :       pari_printf("avma\n",operand);
    2264           0 :       break;
    2265             :     case OCgerepile:
    2266           0 :       pari_printf("gerepile\n",operand);
    2267           0 :       break;
    2268             :     case OCcowvardyn:
    2269             :       {
    2270           0 :         entree *ep = (entree *)operand;
    2271           0 :         pari_printf("cowvardyn\t%s\n",ep->name);
    2272           0 :         break;
    2273             :       }
    2274             :     case OCcowvarlex:
    2275           0 :       pari_printf("cowvarlex\t%ld\n",operand);
    2276           0 :       break;
    2277             :     }
    2278             :   }
    2279           0 : }
    2280             : 
    2281             : static int
    2282           0 : opcode_need_relink(op_code opcode)
    2283             : {
    2284           0 :   switch(opcode)
    2285             :   {
    2286             :   case OCpushlong:
    2287             :   case OCpushgen:
    2288             :   case OCpushgnil:
    2289             :   case OCpushreal:
    2290             :   case OCpushstoi:
    2291             :   case OCpushlex:
    2292             :   case OCstorelex:
    2293             :   case OCstoreptr:
    2294             :   case OCsimpleptrlex:
    2295             :   case OCnewptrlex:
    2296             :   case OCpushptr:
    2297             :   case OCstackgen:
    2298             :   case OCendptr:
    2299             :   case OCprecreal:
    2300             :   case OCbitprecreal:
    2301             :   case OCprecdl:
    2302             :   case OCstoi:
    2303             :   case OCutoi:
    2304             :   case OCitos:
    2305             :   case OCitou:
    2306             :   case OCtostr:
    2307             :   case OCvarn:
    2308             :   case OCcopy:
    2309             :   case OCcopyifclone:
    2310             :   case OCcompo1:
    2311             :   case OCcompo1ptr:
    2312             :   case OCcompo2:
    2313             :   case OCcompo2ptr:
    2314             :   case OCcompoC:
    2315             :   case OCcompoCptr:
    2316             :   case OCcompoL:
    2317             :   case OCcompoLptr:
    2318             :   case OCcheckargs:
    2319             :   case OCcheckargs0:
    2320             :   case OCcheckuserargs:
    2321             :   case OCgetargs:
    2322             :   case OCdefaultarg:
    2323             :   case OCdefaultgen:
    2324             :   case OCdefaultlong:
    2325             :   case OCdefaultulong:
    2326             :   case OCcalluser:
    2327             :   case OCvec:
    2328             :   case OCcol:
    2329             :   case OCmat:
    2330             :   case OCnewframe:
    2331             :   case OCsaveframe:
    2332             :   case OCdup:
    2333             :   case OCpop:
    2334             :   case OCavma:
    2335             :   case OCgerepile:
    2336             :   case OCcowvarlex:
    2337           0 :     break;
    2338             :   case OCpushvar:
    2339             :   case OCpushdyn:
    2340             :   case OCstoredyn:
    2341             :   case OCsimpleptrdyn:
    2342             :   case OCnewptrdyn:
    2343             :   case OClocalvar:
    2344             :   case OClocalvar0:
    2345             :   case OCcallgen:
    2346             :   case OCcallgen2:
    2347             :   case OCcalllong:
    2348             :   case OCcallint:
    2349             :   case OCcallvoid:
    2350             :   case OCcowvardyn:
    2351           0 :     return 1;
    2352             :   }
    2353           0 :   return 0;
    2354             : }
    2355             : 
    2356             : static void
    2357           0 : closure_relink(GEN C, hashtable *table)
    2358             : {
    2359           0 :   const char *code = closure_codestr(C);
    2360           0 :   GEN oper = closure_get_oper(C);
    2361           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2362             :   long i, j;
    2363           0 :   for(i=1;i<lg(oper);i++)
    2364           0 :     if (oper[i] && opcode_need_relink((op_code)code[i]))
    2365           0 :       oper[i] = (long) hash_search(table,(void*) oper[i])->val;
    2366           0 :   for (i=1;i<lg(fram);i++)
    2367           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2368           0 :       if (mael(fram,i,j))
    2369           0 :         mael(fram,i,j) = (long) hash_search(table,(void*) mael(fram,i,j))->val;
    2370           0 : }
    2371             : 
    2372             : void
    2373           0 : gen_relink(GEN x, hashtable *table)
    2374             : {
    2375           0 :   long i, lx, tx = typ(x);
    2376           0 :   switch(tx)
    2377             :   {
    2378             :     case t_CLOSURE:
    2379           0 :       closure_relink(x, table);
    2380           0 :       gen_relink(closure_get_data(x), table);
    2381           0 :       if (lg(x)==8) gen_relink(closure_get_frame(x), table);
    2382           0 :       break;
    2383             :     case t_LIST:
    2384           0 :       if (list_data(x)) gen_relink(list_data(x), table);
    2385           0 :       break;
    2386             :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2387           0 :       lx = lg(x);
    2388           0 :       for (i=lontyp[tx]; i<lx; i++) gen_relink(gel(x,i), table);
    2389             :   }
    2390           0 : }
    2391             : 
    2392             : static void
    2393           0 : closure_unlink(GEN C)
    2394             : {
    2395           0 :   const char *code = closure_codestr(C);
    2396           0 :   GEN oper = closure_get_oper(C);
    2397           0 :   GEN fram = gel(closure_get_dbg(C),3);
    2398             :   long i, j;
    2399           0 :   for(i=1;i<lg(oper);i++)
    2400           0 :     if (oper[i] && opcode_need_relink((op_code) code[i]))
    2401             :     {
    2402           0 :       long n = pari_stack_new(&s_relocs);
    2403           0 :       relocs[n] = (entree *) oper[i];
    2404             :     }
    2405           0 :   for (i=1;i<lg(fram);i++)
    2406           0 :     for (j=1;j<lg(gel(fram,i));j++)
    2407           0 :       if (mael(fram,i,j))
    2408             :       {
    2409           0 :         long n = pari_stack_new(&s_relocs);
    2410           0 :         relocs[n] = (entree *) mael(fram,i,j);
    2411             :       }
    2412           0 : }
    2413             : 
    2414             : static void
    2415          12 : gen_unlink(GEN x)
    2416             : {
    2417          12 :   long i, lx, tx = typ(x);
    2418          12 :   switch(tx)
    2419             :   {
    2420             :     case t_CLOSURE:
    2421           0 :       closure_unlink(x);
    2422           0 :       gen_unlink(closure_get_data(x));
    2423           0 :       if (lg(x)==8) gen_unlink(closure_get_frame(x));
    2424           0 :       break;
    2425             :     case t_LIST:
    2426           0 :       if (list_data(x)) gen_unlink(list_data(x));
    2427           0 :       break;
    2428             :     case t_VEC: case t_COL: case t_MAT: case t_ERROR:
    2429           0 :       lx = lg(x);
    2430           0 :       for (i = lontyp[tx]; i<lx; i++) gen_unlink(gel(x,i));
    2431             :   }
    2432          12 : }
    2433             : 
    2434             : GEN
    2435           8 : copybin_unlink(GEN C)
    2436             : {
    2437           8 :   long i, l , n, nold = s_relocs.n;
    2438             :   GEN v, w, V, res;
    2439           8 :   if (C)
    2440           4 :     gen_unlink(C);
    2441             :   else
    2442             :   { /* contents of all variables */
    2443           4 :     long v, maxv = pari_var_next();
    2444          44 :     for (v=0; v<maxv; v++)
    2445             :     {
    2446          40 :       entree *ep = varentries[v];
    2447          40 :       if (!ep || !ep->value) continue;
    2448           8 :       gen_unlink((GEN)ep->value);
    2449             :     }
    2450             :   }
    2451           8 :   n = s_relocs.n-nold;
    2452           8 :   v = cgetg(n+1, t_VECSMALL);
    2453           8 :   for(i=0; i<n; i++)
    2454           0 :     v[i+1] = (long) relocs[i];
    2455           8 :   s_relocs.n = nold;
    2456           8 :   w = vecsmall_uniq(v); l = lg(w);
    2457           8 :   res = cgetg(3,t_VEC);
    2458           8 :   V = cgetg(l, t_VEC);
    2459           8 :   for(i=1; i<l; i++)
    2460             :   {
    2461           0 :     entree *ep = (entree*) w[i];
    2462           0 :     gel(V,i) = strtoGENstr(ep->name);
    2463             :   }
    2464           8 :   gel(res,1) = vecsmall_copy(w);
    2465           8 :   gel(res,2) = V;
    2466           8 :   return res;
    2467             : }
    2468             : 
    2469             : /* e = t_VECSMALL of entree *ep [ addresses ],
    2470             :  * names = t_VEC of strtoGENstr(ep.names),
    2471             :  * Return hashtable : ep => is_entry(ep.name) */
    2472             : hashtable *
    2473           0 : hash_from_link(GEN e, GEN names, int use_stack)
    2474             : {
    2475           0 :   long i, l = lg(e);
    2476           0 :   hashtable *h = hash_create_ulong(l-1, use_stack);
    2477           0 :   if (lg(names) != l) pari_err_DIM("hash_from_link");
    2478           0 :   for (i = 1; i < l; i++)
    2479             :   {
    2480           0 :     char *s = GSTR(gel(names,i));
    2481           0 :     hash_insert(h, (void*)e[i], (void*)fetch_entry(s));
    2482             :   }
    2483           0 :   return h;
    2484             : }
    2485             : 
    2486             : void
    2487           0 : bincopy_relink(GEN C, GEN V)
    2488             : {
    2489           0 :   pari_sp av = avma;
    2490           0 :   hashtable *table = hash_from_link(gel(V,1),gel(V,2),1);
    2491           0 :   gen_relink(C, table);
    2492           0 :   avma = av;
    2493           0 : }

Generated by: LCOV version 1.11