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

Generated by: LCOV version 1.11