Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - compile.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.0 lcov report (development 29804-254f602fce) Lines: 1608 1779 90.4 %
Date: 2024-12-18 09:08:59 Functions: 88 91 96.7 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : #include "pari.h"
      16             : #include "paripriv.h"
      17             : #include "anal.h"
      18             : #include "tree.h"
      19             : #include "opcode.h"
      20             : 
      21             : #define DEBUGLEVEL DEBUGLEVEL_compiler
      22             : 
      23             : #define tree pari_tree
      24             : 
      25             : enum COflags {COsafelex=1, COsafedyn=2};
      26             : 
      27             : /***************************************************************************
      28             :  **                                                                       **
      29             :  **                           String constant expansion                   **
      30             :  **                                                                       **
      31             :  ***************************************************************************/
      32             : 
      33             : static char *
      34      880091 : translate(const char **src, char *s)
      35             : {
      36      880091 :   const char *t = *src;
      37     6941027 :   while (*t)
      38             :   {
      39     6941675 :     while (*t == '\\')
      40             :     {
      41         648 :       switch(*++t)
      42             :       {
      43           0 :         case 'e':  *s='\033'; break; /* escape */
      44         466 :         case 'n':  *s='\n'; break;
      45          14 :         case 't':  *s='\t'; break;
      46         168 :         default:   *s=*t; if (!*t) { *src=s; return NULL; }
      47             :       }
      48         648 :       t++; s++;
      49             :     }
      50     6941027 :     if (*t == '"')
      51             :     {
      52      880091 :       if (t[1] != '"') break;
      53           0 :       t += 2; continue;
      54             :     }
      55     6060936 :     *s++ = *t++;
      56             :   }
      57      880091 :   *s=0; *src=t; return s;
      58             : }
      59             : 
      60             : static void
      61           8 : matchQ(const char *s, char *entry)
      62             : {
      63           8 :   if (*s != '"')
      64           0 :     pari_err(e_SYNTAX,"expected character: '\"' instead of",s,entry);
      65           8 : }
      66             : 
      67             : /*  Read a "string" from src. Format then copy it, starting at s. Return
      68             :  *  pointer to char following the end of the input string */
      69             : char *
      70           4 : pari_translate_string(const char *src, char *s, char *entry)
      71             : {
      72           4 :   matchQ(src, entry); src++; s = translate(&src, s);
      73           4 :   if (!s) pari_err(e_SYNTAX,"run-away string",src,entry);
      74           4 :   matchQ(src, entry); return (char*)src+1;
      75             : }
      76             : 
      77             : static GEN
      78      880087 : strntoGENexp(const char *str, long len)
      79             : {
      80      880087 :   long n = nchar2nlong(len-1);
      81      880087 :   GEN z = cgetg(1+n, t_STR);
      82      880087 :   const char *t = str+1;
      83      880087 :   z[n] = 0;
      84      880087 :   if (!translate(&t, GSTR(z))) compile_err("run-away string",str);
      85      880087 :   return z;
      86             : }
      87             : 
      88             : /***************************************************************************
      89             :  **                                                                       **
      90             :  **                           Byte-code compiler                          **
      91             :  **                                                                       **
      92             :  ***************************************************************************/
      93             : 
      94             : typedef enum {Llocal, Lmy} Ltype;
      95             : 
      96             : struct vars_s
      97             : {
      98             :   Ltype type; /*Only Llocal and Lmy are allowed */
      99             :   int inl;
     100             :   entree *ep;
     101             : };
     102             : 
     103             : struct frame_s
     104             : {
     105             :   long pc;
     106             :   GEN frame;
     107             : };
     108             : 
     109             : static THREAD pari_stack s_opcode, s_operand, s_data, s_lvar;
     110             : static THREAD pari_stack s_dbginfo, s_frame, s_accesslex;
     111             : static THREAD char *opcode;
     112             : static THREAD long *operand;
     113             : static THREAD long *accesslex;
     114             : static THREAD GEN *data;
     115             : static THREAD long offset, nblex;
     116             : static THREAD struct vars_s *localvars;
     117             : static THREAD const char **dbginfo, *dbgstart;
     118             : static THREAD struct frame_s *frames;
     119             : 
     120             : void
     121      326282 : pari_init_compiler(void)
     122             : {
     123      326282 :   pari_stack_init(&s_opcode,sizeof(*opcode),(void **)&opcode);
     124      326245 :   pari_stack_init(&s_operand,sizeof(*operand),(void **)&operand);
     125      326229 :   pari_stack_init(&s_accesslex,sizeof(*operand),(void **)&accesslex);
     126      326206 :   pari_stack_init(&s_data,sizeof(*data),(void **)&data);
     127      326188 :   pari_stack_init(&s_lvar,sizeof(*localvars),(void **)&localvars);
     128      326175 :   pari_stack_init(&s_dbginfo,sizeof(*dbginfo),(void **)&dbginfo);
     129      326181 :   pari_stack_init(&s_frame,sizeof(*frames),(void **)&frames);
     130      326179 :   offset=-1; nblex=0;
     131      326179 : }
     132             : void
     133      325119 : pari_close_compiler(void)
     134             : {
     135      325119 :   pari_stack_delete(&s_opcode);
     136      324215 :   pari_stack_delete(&s_operand);
     137      323036 :   pari_stack_delete(&s_accesslex);
     138      322327 :   pari_stack_delete(&s_data);
     139      321797 :   pari_stack_delete(&s_lvar);
     140      321443 :   pari_stack_delete(&s_dbginfo);
     141      321304 :   pari_stack_delete(&s_frame);
     142      321271 : }
     143             : 
     144             : struct codepos
     145             : {
     146             :   long opcode, data, localvars, frames, accesslex;
     147             :   long offset, nblex;
     148             :   const char *dbgstart;
     149             : };
     150             : 
     151             : static void
     152     8950415 : getcodepos(struct codepos *pos)
     153             : {
     154     8950415 :   pos->opcode=s_opcode.n;
     155     8950415 :   pos->accesslex=s_accesslex.n;
     156     8950415 :   pos->data=s_data.n;
     157     8950415 :   pos->offset=offset;
     158     8950415 :   pos->nblex=nblex;
     159     8950415 :   pos->localvars=s_lvar.n;
     160     8950415 :   pos->dbgstart=dbgstart;
     161     8950415 :   pos->frames=s_frame.n;
     162     8950415 :   offset=s_data.n-1;
     163     8950415 : }
     164             : 
     165             : void
     166         438 : compilestate_reset(void)
     167             : {
     168         438 :   s_opcode.n=0;
     169         438 :   s_operand.n=0;
     170         438 :   s_accesslex.n=0;
     171         438 :   s_dbginfo.n=0;
     172         438 :   s_data.n=0;
     173         438 :   s_lvar.n=0;
     174         438 :   s_frame.n=0;
     175         438 :   offset=-1;
     176         438 :   nblex=0;
     177         438 :   dbgstart=NULL;
     178         438 : }
     179             : 
     180             : void
     181     1419276 : compilestate_save(struct pari_compilestate *comp)
     182             : {
     183     1419276 :   comp->opcode=s_opcode.n;
     184     1419276 :   comp->operand=s_operand.n;
     185     1419276 :   comp->accesslex=s_accesslex.n;
     186     1419276 :   comp->data=s_data.n;
     187     1419276 :   comp->offset=offset;
     188     1419276 :   comp->nblex=nblex;
     189     1419276 :   comp->localvars=s_lvar.n;
     190     1419276 :   comp->dbgstart=dbgstart;
     191     1419276 :   comp->dbginfo=s_dbginfo.n;
     192     1419276 :   comp->frames=s_frame.n;
     193     1419276 : }
     194             : 
     195             : void
     196       49080 : compilestate_restore(struct pari_compilestate *comp)
     197             : {
     198       49080 :   s_opcode.n=comp->opcode;
     199       49080 :   s_operand.n=comp->operand;
     200       49080 :   s_accesslex.n=comp->accesslex;
     201       49080 :   s_data.n=comp->data;
     202       49080 :   offset=comp->offset;
     203       49080 :   nblex=comp->nblex;
     204       49080 :   s_lvar.n=comp->localvars;
     205       49080 :   dbgstart=comp->dbgstart;
     206       49080 :   s_dbginfo.n=comp->dbginfo;
     207       49080 :   s_frame.n=comp->frames;
     208       49080 : }
     209             : 
     210             : static GEN
     211     9768942 : gcopyunclone(GEN x) { GEN y = gcopy(x); gunclone(x); return y; }
     212             : 
     213             : static void
     214      112842 : access_push(long x)
     215             : {
     216      112842 :   long a = pari_stack_new(&s_accesslex);
     217      112842 :   accesslex[a] = x;
     218      112842 : }
     219             : 
     220             : static GEN
     221     8002002 : genctx(long nbmvar, long paccesslex)
     222             : {
     223     8002002 :   GEN acc = const_vec(nbmvar,gen_1);
     224     8002005 :   long i, lvl = 1 + nbmvar;
     225     8043291 :   for (i = paccesslex; i<s_accesslex.n; i++)
     226             :   {
     227       41286 :     long a = accesslex[i];
     228       41286 :     if (a > 0) { lvl+=a; continue; }
     229       36266 :     a += lvl;
     230       36266 :     if (a <= 0) pari_err_BUG("genctx");
     231       36266 :     if (a <= nbmvar)
     232       28235 :       gel(acc, a) = gen_0;
     233             :   }
     234     8002005 :   s_accesslex.n = paccesslex;
     235    28375940 :   for (i = 1; i<=nbmvar; i++)
     236    20373934 :     if (signe(gel(acc,i))==0)
     237       20507 :       access_push(i-nbmvar-1);
     238     8002006 :   return acc;
     239             : }
     240             : 
     241             : static GEN
     242     8950327 : getfunction(const struct codepos *pos, long arity, long nbmvar, GEN text,
     243             :             long gap)
     244             : {
     245     8950327 :   long lop  = s_opcode.n+1 - pos->opcode;
     246     8950327 :   long ldat = s_data.n+1 - pos->data;
     247     8950327 :   long lfram = s_frame.n+1 - pos->frames;
     248     8950327 :   GEN cl = cgetg(nbmvar && text? 8: (text? 7: 6), t_CLOSURE);
     249             :   GEN frpc, fram, dbg, op, dat;
     250             :   char *s;
     251             :   long i;
     252             : 
     253     8950317 :   cl[1] = arity;
     254     8950317 :   gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
     255     8950283 :   gel(cl,3) = op = cgetg(lop, t_VECSMALL);
     256     8950283 :   gel(cl,4) = dat = cgetg(ldat, t_VEC);
     257     8950292 :   dbg = cgetg(lop,  t_VECSMALL);
     258     8950290 :   frpc = cgetg(lfram,  t_VECSMALL);
     259     8950288 :   fram = cgetg(lfram,  t_VEC);
     260     8950294 :   gel(cl,5) = mkvec3(dbg, frpc, fram);
     261     8950307 :   if (text) gel(cl,6) = text;
     262     8950307 :   s = GSTR(gel(cl,2)) - 1;
     263    84732274 :   for (i = 1; i < lop; i++)
     264             :   {
     265    75781967 :     long j = i+pos->opcode-1;
     266    75781967 :     s[i] = opcode[j];
     267    75781967 :     op[i] = operand[j];
     268    75781967 :     dbg[i] = dbginfo[j] - dbgstart;
     269    75781967 :     if (dbg[i] < 0) dbg[i] += gap;
     270             :   }
     271     8950307 :   s[i] = 0;
     272     8950307 :   s_opcode.n = pos->opcode;
     273     8950307 :   s_operand.n = pos->opcode;
     274     8950307 :   s_dbginfo.n = pos->opcode;
     275     8950307 :   if (lg(cl)==8)
     276     7991168 :     gel(cl,7) = genctx(nbmvar, pos->accesslex);
     277      959139 :   else if (nbmvar==0)
     278      948374 :     s_accesslex.n = pos->accesslex;
     279             :   else
     280             :   {
     281       10765 :     pari_sp av = avma;
     282       10765 :     (void) genctx(nbmvar, pos->accesslex);
     283       10832 :     set_avma(av);
     284             :   }
     285    10707995 :   for (i = 1; i < ldat; i++)
     286     1757623 :     if (data[i+pos->data-1]) gel(dat,i) = gcopyunclone(data[i+pos->data-1]);
     287     8950372 :   s_data.n = pos->data;
     288     8978480 :   while (s_lvar.n > pos->localvars && !localvars[s_lvar.n-1].inl)
     289             :   {
     290       28108 :     if (localvars[s_lvar.n-1].type==Lmy) nblex--;
     291       28108 :     s_lvar.n--;
     292             :   }
     293    16961772 :   for (i = 1; i < lfram; i++)
     294             :   {
     295     8011322 :     long j = i+pos->frames-1;
     296     8011322 :     frpc[i] = frames[j].pc - pos->opcode+1;
     297     8011322 :     gel(fram, i) = gcopyunclone(frames[j].frame);
     298             :   }
     299     8950450 :   s_frame.n = pos->frames;
     300     8950450 :   offset = pos->offset;
     301     8950450 :   dbgstart = pos->dbgstart;
     302     8950450 :   return cl;
     303             : }
     304             : 
     305             : static GEN
     306       19951 : getclosure(struct codepos *pos, long nbmvar)
     307             : {
     308       19951 :   return getfunction(pos, 0, nbmvar, NULL, 0);
     309             : }
     310             : 
     311             : static void
     312    75778639 : op_push_loc(op_code o, long x, const char *loc)
     313             : {
     314    75778639 :   long n=pari_stack_new(&s_opcode);
     315    75778682 :   long m=pari_stack_new(&s_operand);
     316    75778617 :   long d=pari_stack_new(&s_dbginfo);
     317    75778650 :   opcode[n]=o;
     318    75778650 :   operand[m]=x;
     319    75778650 :   dbginfo[d]=loc;
     320    75778650 : }
     321             : 
     322             : static void
     323    38483252 : op_push(op_code o, long x, long n)
     324             : {
     325    38483252 :   op_push_loc(o,x,tree[n].str);
     326    38483252 : }
     327             : 
     328             : static void
     329        2940 : op_insert_loc(long k, op_code o, long x, const char *loc)
     330             : {
     331             :   long i;
     332        2940 :   long n=pari_stack_new(&s_opcode);
     333        2940 :   (void) pari_stack_new(&s_operand);
     334        2940 :   (void) pari_stack_new(&s_dbginfo);
     335      617282 :   for (i=n-1; i>=k; i--)
     336             :   {
     337      614342 :     opcode[i+1] = opcode[i];
     338      614342 :     operand[i+1]= operand[i];
     339      614342 :     dbginfo[i+1]= dbginfo[i];
     340             :   }
     341        2940 :   opcode[k]  = o;
     342        2940 :   operand[k] = x;
     343        2940 :   dbginfo[k] = loc;
     344        2940 : }
     345             : 
     346             : static long
     347     1757623 : data_push(GEN x)
     348             : {
     349     1757623 :   long n=pari_stack_new(&s_data);
     350     1757623 :   data[n] = x?gclone(x):x;
     351     1757623 :   return n-offset;
     352             : }
     353             : 
     354             : static void
     355       64621 : var_push(entree *ep, Ltype type)
     356             : {
     357       64621 :   long n=pari_stack_new(&s_lvar);
     358       64621 :   localvars[n].ep   = ep;
     359       64621 :   localvars[n].inl  = 0;
     360       64621 :   localvars[n].type = type;
     361       64621 :   if (type == Lmy) nblex++;
     362       64621 : }
     363             : 
     364             : static void
     365     8011333 : frame_push(GEN x)
     366             : {
     367     8011333 :   long n=pari_stack_new(&s_frame);
     368     8011328 :   frames[n].pc = s_opcode.n-1;
     369     8011328 :   frames[n].frame = gclone(x);
     370     8011415 : }
     371             : 
     372             : static GEN
     373          53 : pack_localvars(void)
     374             : {
     375          53 :   GEN pack=cgetg(3,t_VEC);
     376          53 :   long i, l=s_lvar.n;
     377          53 :   GEN t=cgetg(1+l,t_VECSMALL);
     378          53 :   GEN e=cgetg(1+l,t_VECSMALL);
     379          53 :   gel(pack,1)=t;
     380          53 :   gel(pack,2)=e;
     381         129 :   for(i=1;i<=l;i++)
     382             :   {
     383          76 :     t[i]=localvars[i-1].type;
     384          76 :     e[i]=(long)localvars[i-1].ep;
     385             :   }
     386         129 :   for(i=1;i<=nblex;i++)
     387          76 :     access_push(-i);
     388          53 :   return pack;
     389             : }
     390             : 
     391             : void
     392         259 : push_frame(GEN C, long lpc, long dummy)
     393             : {
     394         259 :   const char *code=closure_codestr(C);
     395         259 :   GEN oper=closure_get_oper(C);
     396         259 :   GEN dbg=closure_get_dbg(C);
     397         259 :   GEN frpc=gel(dbg,2);
     398         259 :   GEN fram=gel(dbg,3);
     399         259 :   long pc, j=1, lfr = lg(frpc);
     400         259 :   if (lpc==-1)
     401             :   {
     402             :     long k;
     403          56 :     GEN e = gel(fram, 1);
     404         112 :     for(k=1; k<lg(e); k++)
     405          56 :       var_push(dummy?NULL:(entree*)e[k], Lmy);
     406          56 :     return;
     407             :   }
     408         259 :   if (lg(C)<8) while (j<lfr && frpc[j]==0) j++;
     409        1715 :   for(pc=0; pc<lpc; pc++) /* do not assume lpc was completed */
     410             :   {
     411        1512 :     if (pc>0 && (code[pc]==OClocalvar || code[pc]==OClocalvar0))
     412           0 :       var_push((entree*)oper[pc],Llocal);
     413        1512 :     if (j<lfr && pc==frpc[j])
     414             :     {
     415             :       long k;
     416         154 :       GEN e = gel(fram,j);
     417         399 :       for(k=1; k<lg(e); k++)
     418         245 :         var_push(dummy?NULL:(entree*)e[k], Lmy);
     419         154 :       j++;
     420             :     }
     421             :   }
     422             : }
     423             : 
     424             : void
     425           0 : debug_context(void)
     426             : {
     427             :   long i;
     428           0 :   for(i=0;i<s_lvar.n;i++)
     429             :   {
     430           0 :     entree *ep = localvars[i].ep;
     431           0 :     Ltype type = localvars[i].type;
     432           0 :     err_printf("%ld: %s: %s\n",i,(type==Lmy?"my":"local"),(ep?ep->name:"NULL"));
     433             :   }
     434           0 : }
     435             : 
     436             : GEN
     437       10992 : localvars_read_str(const char *x, GEN pack)
     438             : {
     439       10992 :   pari_sp av = avma;
     440             :   GEN code;
     441       10992 :   long l=0, nbmvar=nblex;
     442       10992 :   if (pack)
     443             :   {
     444       10992 :     GEN t=gel(pack,1);
     445       10992 :     GEN e=gel(pack,2);
     446             :     long i;
     447       10992 :     l=lg(t)-1;
     448       47171 :     for(i=1;i<=l;i++)
     449       36179 :       var_push((entree*)e[i],(Ltype)t[i]);
     450             :   }
     451       10992 :   code = compile_str(x);
     452       10992 :   s_lvar.n -= l;
     453       10992 :   nblex = nbmvar;
     454       10992 :   return gerepileupto(av, closure_evalres(code));
     455             : }
     456             : 
     457             : long
     458           7 : localvars_find(GEN pack, entree *ep)
     459             : {
     460           7 :   GEN t=gel(pack,1);
     461           7 :   GEN e=gel(pack,2);
     462             :   long i;
     463           7 :   long vn=0;
     464           7 :   for(i=lg(e)-1;i>=1;i--)
     465             :   {
     466           0 :     if(t[i]==Lmy)
     467           0 :       vn--;
     468           0 :     if(e[i]==(long)ep)
     469           0 :       return t[i]==Lmy?vn:0;
     470             :   }
     471           7 :   return 0;
     472             : }
     473             : 
     474             : /*
     475             :  Flags for copy optimisation:
     476             :  -- Freturn: The result will be returned.
     477             :  -- FLsurvive: The result must survive the closure.
     478             :  -- FLnocopy: The result will never be updated nor part of a user variable.
     479             :  -- FLnocopylex: The result will never be updated nor part of dynamic variable.
     480             : */
     481             : enum FLflag {FLreturn=1, FLsurvive=2, FLnocopy=4, FLnocopylex=8};
     482             : 
     483             : static void
     484      262519 : addcopy(long n, long mode, long flag, long mask)
     485             : {
     486      262519 :   if (mode==Ggen && !(flag&mask))
     487             :   {
     488       25978 :     op_push(OCcopy,0,n);
     489       25978 :     if (!(flag&FLsurvive) && DEBUGLEVEL)
     490           0 :       pari_warn(warner,"compiler generates copy for `%.*s'",
     491           0 :                        tree[n].len,tree[n].str);
     492             :   }
     493      262519 : }
     494             : 
     495             : static void compilenode(long n, int mode, long flag);
     496             : 
     497             : typedef enum {PPend,PPstd,PPdefault,PPdefaultmulti,PPstar,PPauto} PPproto;
     498             : 
     499             : static PPproto
     500   121148892 : parseproto(char const **q, char *c, const char *str)
     501             : {
     502   121148892 :   char  const *p=*q;
     503             :   long i;
     504   121148892 :   switch(*p)
     505             :   {
     506    29558272 :   case 0:
     507             :   case '\n':
     508    29558272 :     return PPend;
     509      275993 :   case 'D':
     510      275993 :     switch(p[1])
     511             :     {
     512      187011 :     case 'G':
     513             :     case '&':
     514             :     case 'W':
     515             :     case 'V':
     516             :     case 'I':
     517             :     case 'E':
     518             :     case 'J':
     519             :     case 'n':
     520             :     case 'P':
     521             :     case 'r':
     522             :     case 's':
     523      187011 :       *c=p[1]; *q=p+2; return PPdefault;
     524       88982 :     default:
     525      537462 :       for(i=0;*p && i<2;p++) i+=*p==',';
     526             :       /* assert(i>=2) because check_proto validated the protototype */
     527       88982 :       *c=p[-2]; *q=p; return PPdefaultmulti;
     528             :     }
     529             :     break;
     530      137753 :   case 'C':
     531             :   case 'p':
     532             :   case 'b':
     533             :   case 'P':
     534             :   case 'f':
     535      137753 :     *c=*p; *q=p+1; return PPauto;
     536        1536 :   case '&':
     537        1536 :     *c='*'; *q=p+1; return PPstd;
     538       18548 :   case 'V':
     539       18548 :     if (p[1]=='=')
     540             :     {
     541       13484 :       if (p[2]!='G')
     542           0 :         compile_err("function prototype is not supported",str);
     543       13484 :       *c='='; p+=2;
     544             :     }
     545             :     else
     546        5064 :       *c=*p;
     547       18548 :     *q=p+1; return PPstd;
     548       44550 :   case 'E':
     549             :   case 's':
     550       44550 :     if (p[1]=='*') { *c=*p++; *q=p+1; return PPstar; }
     551             :     /*fall through*/
     552             :   }
     553    91126901 :   *c=*p; *q=p+1; return PPstd;
     554             : }
     555             : 
     556             : static long
     557      419792 : detag(long n)
     558             : {
     559      419792 :   while (tree[n].f==Ftag)
     560           0 :     n=tree[n].x;
     561      419792 :   return n;
     562             : }
     563             : 
     564             : /* return type for GP functions */
     565             : static op_code
     566    13596724 : get_ret_type(const char **p, long arity, Gtype *t, long *flag)
     567             : {
     568    13596724 :   *flag = 0;
     569    13596724 :   if (**p == 'v') { (*p)++; *t=Gvoid; return OCcallvoid; }
     570    13549480 :   else if (**p == 'i') { (*p)++; *t=Gsmall;  return OCcallint; }
     571    13543243 :   else if (**p == 'l') { (*p)++; *t=Gsmall;  return OCcalllong; }
     572    13517761 :   else if (**p == 'u') { (*p)++; *t=Gusmall; return OCcalllong; }
     573    13517761 :   else if (**p == 'm') { (*p)++; *flag = FLnocopy; }
     574    13517761 :   *t=Ggen; return arity==2?OCcallgen2:OCcallgen;
     575             : }
     576             : 
     577             : static void
     578           7 : U_compile_err(const char *s)
     579           7 : { compile_err("this should be a small non-negative integer",s); }
     580             : static void
     581           7 : L_compile_err(const char *s)
     582           7 : { compile_err("this should be a small integer",s); }
     583             : 
     584             : /*supported types:
     585             :  * type: Gusmall, Gsmall, Ggen, Gvoid, Gvec, Gclosure
     586             :  * mode: Gusmall, Gsmall, Ggen, Gvar, Gvoid
     587             :  */
     588             : static void
     589    14655597 : compilecast_loc(int type, int mode, const char *loc)
     590             : {
     591    14655597 :   if (type==mode) return;
     592     4528139 :   switch (mode)
     593             :   {
     594         200 :   case Gusmall:
     595         200 :     if (type==Ggen)        op_push_loc(OCitou,-1,loc);
     596         158 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     597         158 :     else if (type!=Gsmall) U_compile_err(loc);
     598         200 :     break;
     599        5082 :   case Gsmall:
     600        5082 :     if (type==Ggen)        op_push_loc(OCitos,-1,loc);
     601           7 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     602           7 :     else if (type!=Gusmall) L_compile_err(loc);
     603        5075 :     break;
     604     4510177 :   case Ggen:
     605     4510177 :     if (type==Gsmall)      op_push_loc(OCstoi,0,loc);
     606     4496236 :     else if (type==Gusmall)op_push_loc(OCutoi,0,loc);
     607     4496236 :     else if (type==Gvoid)  op_push_loc(OCpushgnil,0,loc);
     608     4510177 :     break;
     609        8873 :   case Gvoid:
     610        8873 :     op_push_loc(OCpop, 1,loc);
     611        8873 :     break;
     612        3807 :   case Gvar:
     613        3807 :     if (type==Ggen)        op_push_loc(OCvarn,-1,loc);
     614           7 :     else compile_varerr(loc);
     615        3800 :      break;
     616           0 :   default:
     617           0 :     pari_err_BUG("compilecast [unknown type]");
     618             :   }
     619             : }
     620             : 
     621             : static void
     622     6666779 : compilecast(long n, int type, int mode) { compilecast_loc(type, mode, tree[n].str); }
     623             : 
     624             : static entree *
     625       25137 : fetch_member_raw(const char *s, long len)
     626             : {
     627       25137 :   pari_sp av = avma;
     628       25137 :   char *t = stack_malloc(len+2);
     629             :   entree *ep;
     630       25137 :   t[0] = '_'; strncpy(t+1, s, len); t[++len] = 0; /* prepend '_' */
     631       25137 :   ep = fetch_entry_raw(t, len);
     632       25137 :   set_avma(av); return ep;
     633             : }
     634             : static entree *
     635     9726690 : getfunc(long n)
     636             : {
     637     9726690 :   long x=tree[n].x;
     638     9726690 :   if (tree[x].x==CSTmember) /* str-1 points to '.' */
     639       25137 :     return do_alias(fetch_member_raw(tree[x].str - 1, tree[x].len + 1));
     640             :   else
     641     9701553 :     return do_alias(fetch_entry_raw(tree[x].str, tree[x].len));
     642             : }
     643             : 
     644             : static entree *
     645      353754 : getentry(long n)
     646             : {
     647      353754 :   n = detag(n);
     648      353754 :   if (tree[n].f!=Fentry)
     649             :   {
     650          21 :     if (tree[n].f==Fseq)
     651           0 :       compile_err("unexpected character: ';'", tree[tree[n].y].str-1);
     652          21 :     compile_varerr(tree[n].str);
     653             :   }
     654      353733 :   return getfunc(n);
     655             : }
     656             : 
     657             : static entree *
     658       80825 : getvar(long n)
     659       80825 : { return getentry(n); }
     660             : 
     661             : /* match Fentry that are not actually EpSTATIC functions called without parens*/
     662             : static entree *
     663         131 : getvardyn(long n)
     664             : {
     665         131 :   entree *ep = getentry(n);
     666         131 :   if (EpSTATIC(do_alias(ep)))
     667           0 :     compile_varerr(tree[n].str);
     668         131 :   return ep;
     669             : }
     670             : 
     671             : static long
     672     5027178 : getmvar(entree *ep)
     673             : {
     674             :   long i;
     675     5027178 :   long vn=0;
     676     6149261 :   for(i=s_lvar.n-1;i>=0;i--)
     677             :   {
     678     1199705 :     if(localvars[i].type==Lmy)
     679     1199432 :       vn--;
     680     1199705 :     if(localvars[i].ep==ep)
     681       77622 :       return localvars[i].type==Lmy?vn:0;
     682             :   }
     683     4949556 :   return 0;
     684             : }
     685             : 
     686             : static void
     687        9438 : ctxmvar(long n)
     688             : {
     689        9438 :   pari_sp av=avma;
     690             :   GEN ctx;
     691             :   long i;
     692        9438 :   if (n==0) return;
     693        4117 :   ctx = cgetg(n+1,t_VECSMALL);
     694       67139 :   for(n=0, i=0; i<s_lvar.n; i++)
     695       63022 :     if(localvars[i].type==Lmy)
     696       63022 :       ctx[++n]=(long)localvars[i].ep;
     697        4117 :   frame_push(ctx);
     698        4117 :   set_avma(av);
     699             : }
     700             : 
     701             : INLINE int
     702    51331209 : is_func_named(entree *ep, const char *s)
     703             : {
     704    51331209 :   return !strcmp(ep->name, s);
     705             : }
     706             : 
     707             : INLINE int
     708        3980 : is_node_zero(long n)
     709             : {
     710        3980 :   n = detag(n);
     711        3980 :   return (tree[n].f==Fsmall && tree[n].x==0);
     712             : }
     713             : 
     714             : static void
     715          91 : str_defproto(const char *p, const char *q, const char *loc)
     716             : {
     717          91 :   long len = p-4-q;
     718          91 :   if (q[1]!='"' || q[len]!='"')
     719           0 :     compile_err("default argument must be a string",loc);
     720          91 :   op_push_loc(OCpushgen,data_push(strntoGENexp(q+1,len)),loc);
     721          91 : }
     722             : 
     723             : static long
     724         406 : countmatrixelts(long n)
     725             : {
     726             :   long x,i;
     727         406 :   if (n==-1 || tree[n].f==Fnoarg) return 0;
     728         959 :   for(x=n, i=0; tree[x].f==Fmatrixelts; x=tree[x].x)
     729         553 :     if (tree[tree[x].y].f!=Fnoarg) i++;
     730         406 :   if (tree[x].f!=Fnoarg) i++;
     731         406 :   return i;
     732             : }
     733             : 
     734             : static long
     735    18446753 : countlisttogen(long n, Ffunc f)
     736             : {
     737             :   long x,i;
     738    18446753 :   if (n==-1 || tree[n].f==Fnoarg) return 0;
     739    42799808 :   for(x=n, i=0; tree[x].f==f ;x=tree[x].x, i++);
     740    17689308 :   return i+1;
     741             : }
     742             : 
     743             : static GEN
     744    18446753 : listtogen(long n, Ffunc f)
     745             : {
     746    18446753 :   long x,i,nb = countlisttogen(n, f);
     747    18446753 :   GEN z=cgetg(nb+1, t_VECSMALL);
     748    18446753 :   if (nb)
     749             :   {
     750    42799808 :     for (x=n, i = nb-1; i>0; z[i+1]=tree[x].y, x=tree[x].x, i--);
     751    17689308 :     z[1]=x;
     752             :   }
     753    18446753 :   return z;
     754             : }
     755             : 
     756             : static long
     757     9394014 : first_safe_arg(GEN arg, long mask)
     758             : {
     759     9394014 :   long lnc, l=lg(arg);
     760    19784334 :   for (lnc=l-1; lnc>0 && (tree[arg[lnc]].flags&mask)==mask; lnc--);
     761     9394014 :   return lnc;
     762             : }
     763             : 
     764             : static void
     765       20193 : checkdups(GEN arg, GEN vep)
     766             : {
     767       20193 :   long l=vecsmall_duplicate(vep);
     768       20193 :   if (l!=0) compile_err("variable declared twice",tree[arg[l]].str);
     769       20193 : }
     770             : 
     771             : enum {MAT_range,MAT_std,MAT_line,MAT_column,VEC_std};
     772             : 
     773             : static int
     774       15220 : matindex_type(long n)
     775             : {
     776       15220 :   long x = tree[n].x, y = tree[n].y;
     777       15220 :   long fxx = tree[tree[x].x].f, fxy = tree[tree[x].y].f;
     778       15220 :   if (y==-1)
     779             :   {
     780       13148 :     if (fxy!=Fnorange) return MAT_range;
     781       12560 :     if (fxx==Fnorange) compile_err("missing index",tree[n].str);
     782       12560 :     return VEC_std;
     783             :   }
     784             :   else
     785             :   {
     786        2072 :     long fyx = tree[tree[y].x].f, fyy = tree[tree[y].y].f;
     787        2072 :     if (fxy!=Fnorange || fyy!=Fnorange) return MAT_range;
     788        1897 :     if (fxx==Fnorange && fyx==Fnorange)
     789           0 :       compile_err("missing index",tree[n].str);
     790        1897 :     if (fxx==Fnorange) return MAT_column;
     791        1092 :     if (fyx==Fnorange) return MAT_line;
     792         826 :     return MAT_std;
     793             :   }
     794             : }
     795             : 
     796             : static entree *
     797       47442 : getlvalue(long n)
     798             : {
     799       48429 :   while ((tree[n].f==Fmatcoeff && matindex_type(tree[n].y)!=MAT_range) || tree[n].f==Ftag)
     800         987 :     n=tree[n].x;
     801       47442 :   return getvar(n);
     802             : }
     803             : 
     804             : INLINE void
     805       43972 : compilestore(long vn, entree *ep, long n)
     806             : {
     807       43972 :   if (vn)
     808        4632 :     op_push(OCstorelex,vn,n);
     809             :   else
     810             :   {
     811       39340 :     if (EpSTATIC(do_alias(ep)))
     812           0 :       compile_varerr(tree[n].str);
     813       39340 :     op_push(OCstoredyn,(long)ep,n);
     814             :   }
     815       43972 : }
     816             : 
     817             : INLINE void
     818         826 : compilenewptr(long vn, entree *ep, long n)
     819             : {
     820         826 :   if (vn)
     821             :   {
     822         252 :     access_push(vn);
     823         252 :     op_push(OCnewptrlex,vn,n);
     824             :   }
     825             :   else
     826         574 :     op_push(OCnewptrdyn,(long)ep,n);
     827         826 : }
     828             : 
     829             : static void
     830        1806 : compilelvalue(long n)
     831             : {
     832        1806 :   n = detag(n);
     833        1806 :   if (tree[n].f==Fentry)
     834         826 :     return;
     835             :   else
     836             :   {
     837         980 :     long x = tree[n].x, y = tree[n].y;
     838         980 :     long yx = tree[y].x, yy = tree[y].y;
     839         980 :     long m = matindex_type(y);
     840         980 :     if (m == MAT_range)
     841           0 :       compile_err("not an lvalue",tree[n].str);
     842         980 :     if (m == VEC_std && tree[x].f==Fmatcoeff)
     843             :     {
     844         119 :       int mx = matindex_type(tree[x].y);
     845         119 :       if (mx==MAT_line)
     846             :       {
     847           0 :         int xy = tree[x].y, xyx = tree[xy].x;
     848           0 :         compilelvalue(tree[x].x);
     849           0 :         compilenode(tree[xyx].x,Gsmall,0);
     850           0 :         compilenode(tree[yx].x,Gsmall,0);
     851           0 :         op_push(OCcompo2ptr,0,y);
     852           0 :         return;
     853             :       }
     854             :     }
     855         980 :     compilelvalue(x);
     856         980 :     switch(m)
     857             :     {
     858         658 :     case VEC_std:
     859         658 :       compilenode(tree[yx].x,Gsmall,0);
     860         658 :       op_push(OCcompo1ptr,0,y);
     861         658 :       break;
     862         126 :     case MAT_std:
     863         126 :       compilenode(tree[yx].x,Gsmall,0);
     864         126 :       compilenode(tree[yy].x,Gsmall,0);
     865         126 :       op_push(OCcompo2ptr,0,y);
     866         126 :       break;
     867          98 :     case MAT_line:
     868          98 :       compilenode(tree[yx].x,Gsmall,0);
     869          98 :       op_push(OCcompoLptr,0,y);
     870          98 :       break;
     871          98 :     case MAT_column:
     872          98 :       compilenode(tree[yy].x,Gsmall,0);
     873          98 :       op_push(OCcompoCptr,0,y);
     874          98 :       break;
     875             :     }
     876             :   }
     877             : }
     878             : 
     879             : static void
     880       13134 : compilematcoeff(long n, int mode)
     881             : {
     882       13134 :   long x=tree[n].x, y=tree[n].y;
     883       13134 :   long yx=tree[y].x, yy=tree[y].y;
     884       13134 :   long m=matindex_type(y);
     885       13134 :   compilenode(x,Ggen,FLnocopy);
     886       13134 :   switch(m)
     887             :   {
     888       11118 :   case VEC_std:
     889       11118 :     compilenode(tree[yx].x,Gsmall,0);
     890       11118 :     op_push(OCcompo1,mode,y);
     891       11118 :     return;
     892         574 :   case MAT_std:
     893         574 :     compilenode(tree[yx].x,Gsmall,0);
     894         574 :     compilenode(tree[yy].x,Gsmall,0);
     895         574 :     op_push(OCcompo2,mode,y);
     896         574 :     return;
     897          70 :   case MAT_line:
     898          70 :     compilenode(tree[yx].x,Gsmall,0);
     899          70 :     op_push(OCcompoL,0,y);
     900          70 :     compilecast(n,Gvec,mode);
     901          70 :     return;
     902         609 :   case MAT_column:
     903         609 :     compilenode(tree[yy].x,Gsmall,0);
     904         609 :     op_push(OCcompoC,0,y);
     905         609 :     compilecast(n,Gvec,mode);
     906         609 :     return;
     907         763 :   case MAT_range:
     908         763 :     compilenode(tree[yx].x,Gsmall,0);
     909         763 :     compilenode(tree[yx].y,Gsmall,0);
     910         763 :     if (yy==-1)
     911         588 :       op_push(OCcallgen,(long)is_entry("_[_.._]"),n);
     912             :     else
     913             :     {
     914         175 :       compilenode(tree[yy].x,Gsmall,0);
     915         175 :       compilenode(tree[yy].y,Gsmall,0);
     916         175 :       op_push(OCcallgen,(long)is_entry("_[_.._,_.._]"),n);
     917             :     }
     918         763 :     compilecast(n,Gvec,mode);
     919         756 :     return;
     920           0 :   default:
     921           0 :     pari_err_BUG("compilematcoeff");
     922             :   }
     923             : }
     924             : 
     925             : static void
     926    11090860 : compilesmall(long n, long x, long mode)
     927             : {
     928    11090860 :   if (mode==Ggen)
     929    11006360 :     op_push(OCpushstoi, x, n);
     930             :   else
     931             :   {
     932       84500 :     if (mode==Gusmall && x < 0) U_compile_err(tree[n].str);
     933       84500 :     op_push(OCpushlong, x, n);
     934       84500 :     compilecast(n,Gsmall,mode);
     935             :   }
     936    11090853 : }
     937             : 
     938             : static void
     939     4462191 : compilevec(long n, long mode, op_code op)
     940             : {
     941     4462191 :   pari_sp ltop=avma;
     942     4462191 :   long x=tree[n].x;
     943             :   long i;
     944     4462191 :   GEN arg=listtogen(x,Fmatrixelts);
     945     4462191 :   long l=lg(arg);
     946     4462191 :   op_push(op,l,n);
     947    20307504 :   for (i=1;i<l;i++)
     948             :   {
     949    15845313 :     if (tree[arg[i]].f==Fnoarg)
     950           0 :       compile_err("missing vector element",tree[arg[i]].str);
     951    15845313 :     compilenode(arg[i],Ggen,FLsurvive);
     952    15845313 :     op_push(OCstackgen,i,n);
     953             :   }
     954     4462191 :   set_avma(ltop);
     955     4462191 :   op_push(OCpop,1,n);
     956     4462191 :   compilecast(n,Gvec,mode);
     957     4462191 : }
     958             : 
     959             : static void
     960        9604 : compilemat(long n, long mode)
     961             : {
     962        9604 :   pari_sp ltop=avma;
     963        9604 :   long x=tree[n].x;
     964             :   long i,j;
     965        9604 :   GEN line=listtogen(x,Fmatrixlines);
     966        9604 :   long lglin = lg(line), lgcol=0;
     967        9604 :   op_push(OCpushlong, lglin,n);
     968        9604 :   if (lglin==1)
     969         994 :     op_push(OCmat,1,n);
     970       47726 :   for(i=1;i<lglin;i++)
     971             :   {
     972       38122 :     GEN col=listtogen(line[i],Fmatrixelts);
     973       38122 :     long l=lg(col), k;
     974       38122 :     if (i==1)
     975             :     {
     976        8610 :       lgcol=l;
     977        8610 :       op_push(OCmat,lgcol,n);
     978             :     }
     979       29512 :     else if (l!=lgcol)
     980           0 :       compile_err("matrix must be rectangular",tree[line[i]].str);
     981       38122 :     k=i;
     982      290829 :     for(j=1;j<lgcol;j++)
     983             :     {
     984      252707 :       k-=lglin;
     985      252707 :       if (tree[col[j]].f==Fnoarg)
     986           0 :         compile_err("missing matrix element",tree[col[j]].str);
     987      252707 :       compilenode(col[j], Ggen, FLsurvive);
     988      252707 :       op_push(OCstackgen,k,n);
     989             :     }
     990             :   }
     991        9604 :   set_avma(ltop);
     992        9604 :   op_push(OCpop,1,n);
     993        9604 :   compilecast(n,Gvec,mode);
     994        9604 : }
     995             : 
     996             : static GEN
     997       47204 : cattovec(long n, long fnum)
     998             : {
     999       47204 :   long x=n, y, i=0, nb;
    1000             :   GEN stack;
    1001       47204 :   if (tree[n].f==Fnoarg) return cgetg(1,t_VECSMALL);
    1002             :   while(1)
    1003         210 :   {
    1004       47414 :     long xx=tree[x].x;
    1005       47414 :     long xy=tree[x].y;
    1006       47414 :     if (tree[x].f!=Ffunction || xx!=fnum) break;
    1007         210 :     x=tree[xy].x;
    1008         210 :     y=tree[xy].y;
    1009         210 :     if (tree[y].f==Fnoarg)
    1010           0 :       compile_err("unexpected character: ", tree[y].str);
    1011         210 :     i++;
    1012             :   }
    1013       47204 :   if (tree[x].f==Fnoarg)
    1014           0 :     compile_err("unexpected character: ", tree[x].str);
    1015       47204 :   nb=i+1;
    1016       47204 :   stack=cgetg(nb+1,t_VECSMALL);
    1017       47414 :   for(x=n;i>0;i--)
    1018             :   {
    1019         210 :     long y=tree[x].y;
    1020         210 :     x=tree[y].x;
    1021         210 :     stack[i+1]=tree[y].y;
    1022             :   }
    1023       47204 :   stack[1]=x;
    1024       47204 :   return stack;
    1025             : }
    1026             : 
    1027             : static GEN
    1028         339 : compilelambda(long y, GEN vep, long nbmvar, struct codepos *pos)
    1029             : {
    1030         339 :   long lev = vep ? lg(vep)-1 : 0;
    1031         339 :   GEN text=cgetg(3,t_VEC);
    1032         339 :   gel(text,1)=strtoGENstr(lev? ((entree*) vep[1])->name: "");
    1033         339 :   gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
    1034         339 :   dbgstart = tree[y].str;
    1035         339 :   compilenode(y,Ggen,FLsurvive|FLreturn);
    1036         339 :   return getfunction(pos,lev,nbmvar,text,2);
    1037             : }
    1038             : 
    1039             : static void
    1040       22787 : compilecall(long n, int mode, entree *ep)
    1041             : {
    1042       22787 :   pari_sp ltop=avma;
    1043             :   long j;
    1044       22787 :   long x=tree[n].x, tx = tree[x].x;
    1045       22787 :   long y=tree[n].y;
    1046       22787 :   GEN arg=listtogen(y,Flistarg);
    1047       22787 :   long nb=lg(arg)-1;
    1048       22787 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
    1049       22787 :   long lnl=first_safe_arg(arg, COsafelex);
    1050       22787 :   long fl = lnl==0? (lnc==0? FLnocopy: FLnocopylex): 0;
    1051       22787 :   if (ep==NULL)
    1052         322 :     compilenode(x, Ggen, fl);
    1053             :   else
    1054             :   {
    1055       22465 :     long vn=getmvar(ep);
    1056       22465 :     if (vn)
    1057             :     {
    1058         567 :       access_push(vn);
    1059         567 :       op_push(OCpushlex,vn,n);
    1060             :     }
    1061             :     else
    1062       21898 :       op_push(OCpushdyn,(long)ep,n);
    1063             :   }
    1064       61343 :   for (j=1;j<=nb;j++)
    1065             :   {
    1066       38556 :     long x = tree[arg[j]].x, f = tree[arg[j]].f;
    1067       38556 :     if (f==Fseq)
    1068           0 :       compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1069       38556 :     else if (f==Findarg)
    1070             :     {
    1071         126 :       long a = tree[arg[j]].x;
    1072         126 :       entree *ep = getlvalue(a);
    1073         126 :       long vn = getmvar(ep);
    1074         126 :       if (vn)
    1075          49 :         op_push(OCcowvarlex, vn, a);
    1076         126 :       compilenode(a, Ggen,FLnocopy);
    1077         126 :       op_push(OClock,0,n);
    1078       38430 :     } else if (tx==CSTmember)
    1079             :     {
    1080          28 :       compilenode(arg[j], Ggen,FLnocopy);
    1081          28 :       op_push(OClock,0,n);
    1082             :     }
    1083       38402 :     else if (f!=Fnoarg)
    1084       38150 :       compilenode(arg[j], Ggen,j>=lnl?FLnocopylex:0);
    1085             :     else
    1086         252 :       op_push(OCpushlong,0,n);
    1087             :   }
    1088       22787 :   op_push(OCcalluser,nb,x);
    1089       22787 :   compilecast(n,Ggen,mode);
    1090       22787 :   set_avma(ltop);
    1091       22787 : }
    1092             : 
    1093             : static GEN
    1094       20206 : compilefuncinline(long n, long c, long a, long flag, long isif, long lev, long *ev)
    1095             : {
    1096             :   struct codepos pos;
    1097       20206 :   int type=c=='I'?Gvoid:Ggen;
    1098       20206 :   long rflag=c=='I'?0:FLsurvive;
    1099       20206 :   long nbmvar = nblex;
    1100       20206 :   GEN vep = NULL;
    1101       20206 :   if (isif && (flag&FLreturn)) rflag|=FLreturn;
    1102       20206 :   getcodepos(&pos);
    1103       20206 :   if (c=='J') ctxmvar(nbmvar);
    1104       20206 :   if (lev)
    1105             :   {
    1106             :     long i;
    1107       11828 :     GEN varg=cgetg(lev+1,t_VECSMALL);
    1108       11828 :     vep=cgetg(lev+1,t_VECSMALL);
    1109       24416 :     for(i=0;i<lev;i++)
    1110             :     {
    1111             :       entree *ve;
    1112       12588 :       if (ev[i]<0)
    1113           0 :         compile_err("missing variable name", tree[a].str-1);
    1114       12588 :       ve = getvar(ev[i]);
    1115       12588 :       vep[i+1]=(long)ve;
    1116       12588 :       varg[i+1]=ev[i];
    1117       12588 :       var_push(ve,Lmy);
    1118             :     }
    1119       11828 :     checkdups(varg,vep);
    1120       11828 :     if (c=='J')
    1121         339 :       op_push(OCgetargs,lev,n);
    1122       11828 :     access_push(lg(vep)-1);
    1123       11828 :     frame_push(vep);
    1124             :   }
    1125       20206 :   if (c=='J')
    1126         339 :     return compilelambda(a,vep,nbmvar,&pos);
    1127       19867 :   if (tree[a].f==Fnoarg)
    1128         134 :     compilecast(a,Gvoid,type);
    1129             :   else
    1130       19733 :     compilenode(a,type,rflag);
    1131       19867 :   return getclosure(&pos, nbmvar);
    1132             : }
    1133             : 
    1134             : static long
    1135        3322 : countvar(GEN arg)
    1136             : {
    1137        3322 :   long i, l = lg(arg);
    1138        3322 :   long n = l-1;
    1139       10328 :   for(i=1; i<l; i++)
    1140             :   {
    1141        7006 :     long a=arg[i];
    1142        7006 :     if (tree[a].f==Fassign)
    1143             :     {
    1144        3889 :       long x = detag(tree[a].x);
    1145        3889 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1146         406 :         n += countmatrixelts(tree[x].x)-1;
    1147             :     }
    1148             :   }
    1149        3322 :   return n;
    1150             : }
    1151             : 
    1152             : static void
    1153           6 : compileuninline(GEN arg)
    1154             : {
    1155             :   long j;
    1156           6 :   if (lg(arg) > 1)
    1157           0 :     compile_err("too many arguments",tree[arg[1]].str);
    1158          18 :   for(j=0; j<s_lvar.n; j++)
    1159          12 :     if(!localvars[j].inl)
    1160           0 :       pari_err(e_MISC,"uninline is only valid at top level");
    1161           6 :   s_lvar.n = 0; nblex = 0;
    1162           6 : }
    1163             : 
    1164             : static void
    1165        3294 : compilemy(GEN arg, const char *str, int inl)
    1166             : {
    1167        3294 :   long i, j, k, l = lg(arg);
    1168        3294 :   long n = countvar(arg);
    1169        3294 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1170        3294 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1171        3294 :   if (inl)
    1172             :   {
    1173          13 :     for(j=0; j<s_lvar.n; j++)
    1174           0 :       if(!localvars[j].inl)
    1175           0 :         pari_err(e_MISC,"inline is only valid at top level");
    1176             :   }
    1177       10244 :   for(k=0, i=1; i<l; i++)
    1178             :   {
    1179        6950 :     long a=arg[i];
    1180        6950 :     if (tree[a].f==Fassign)
    1181             :     {
    1182        3847 :       long x = detag(tree[a].x);
    1183        3847 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1184         392 :       {
    1185         392 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1186         392 :         long nv = lg(vars)-1;
    1187        1309 :         for (j=1; j<=nv; j++)
    1188         917 :           if (tree[vars[j]].f!=Fnoarg)
    1189             :           {
    1190         903 :             ver[++k] = vars[j];
    1191         903 :             vep[k] = (long)getvar(ver[k]);
    1192             :           }
    1193         392 :         continue;
    1194        3455 :       } else ver[++k] = x;
    1195        3103 :     } else ver[++k] = a;
    1196        6558 :     vep[k] = (long)getvar(ver[k]);
    1197             :   }
    1198        3294 :   checkdups(ver,vep);
    1199       10755 :   for(i=1; i<=n; i++) var_push(NULL,Lmy);
    1200        3294 :   op_push_loc(OCnewframe,inl?-n:n,str);
    1201        3294 :   access_push(lg(vep)-1);
    1202        3294 :   frame_push(vep);
    1203       10244 :   for (k=0, i=1; i<l; i++)
    1204             :   {
    1205        6950 :     long a=arg[i];
    1206        6950 :     if (tree[a].f==Fassign)
    1207             :     {
    1208        3847 :       long x = detag(tree[a].x);
    1209        3847 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1210         392 :       {
    1211         392 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1212         392 :         long nv = lg(vars)-1, m = nv;
    1213         392 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1214        1309 :         for (j=1; j<=nv; j++)
    1215         917 :           if (tree[vars[j]].f==Fnoarg) m--;
    1216         392 :         if (m > 1) op_push(OCdup,m-1,x);
    1217        1309 :         for (j=1; j<=nv; j++)
    1218         917 :           if (tree[vars[j]].f!=Fnoarg)
    1219             :           {
    1220         903 :             long v = detag(vars[j]);
    1221         903 :             op_push(OCpushlong,j,v);
    1222         903 :             op_push(OCcompo1,Ggen,v);
    1223         903 :             k++;
    1224         903 :             op_push(OCstorelex,-n+k-1,a);
    1225         903 :             localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1226         903 :             localvars[s_lvar.n-n+k-1].inl=inl;
    1227             :           }
    1228         392 :         continue;
    1229             :       }
    1230        3455 :       else if (!is_node_zero(tree[a].y))
    1231             :       {
    1232        3314 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1233        3314 :         op_push(OCstorelex,-n+k,a);
    1234             :       }
    1235             :     }
    1236        6558 :     k++;
    1237        6558 :     localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1238        6558 :     localvars[s_lvar.n-n+k-1].inl=inl;
    1239             :   }
    1240        3294 : }
    1241             : 
    1242             : static long
    1243          70 : localpush(op_code op, long a)
    1244             : {
    1245          70 :   entree *ep = getvardyn(a);
    1246          70 :   long vep  = (long) ep;
    1247          70 :   op_push(op,vep,a);
    1248          70 :   var_push(ep,Llocal);
    1249          70 :   return vep;
    1250             : }
    1251             : 
    1252             : static void
    1253          28 : compilelocal(GEN arg)
    1254             : {
    1255          28 :   long i, j, k, l = lg(arg);
    1256          28 :   long n = countvar(arg);
    1257          28 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1258          28 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1259          84 :   for(k=0, i=1; i<l; i++)
    1260             :   {
    1261          56 :     long a=arg[i];
    1262          56 :     if (tree[a].f==Fassign)
    1263             :     {
    1264          42 :       long x = detag(tree[a].x);
    1265          42 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1266          14 :       {
    1267          14 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1268          14 :         long nv = lg(vars)-1, m = nv;
    1269          14 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1270          56 :         for (j=1; j<=nv; j++)
    1271          42 :           if (tree[vars[j]].f==Fnoarg) m--;
    1272          14 :         if (m > 1) op_push(OCdup,m-1,x);
    1273          56 :         for (j=1; j<=nv; j++)
    1274          42 :           if (tree[vars[j]].f!=Fnoarg)
    1275             :           {
    1276          28 :             long v = detag(vars[j]);
    1277          28 :             op_push(OCpushlong,j,v);
    1278          28 :             op_push(OCcompo1,Ggen,v);
    1279          28 :             vep[++k] = localpush(OClocalvar, v);
    1280          28 :             ver[k] = v;
    1281             :           }
    1282          14 :         continue;
    1283          28 :       } else if (!is_node_zero(tree[a].y))
    1284             :       {
    1285          21 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1286          21 :         ver[++k] = x;
    1287          21 :         vep[k] = localpush(OClocalvar, ver[k]);
    1288          21 :         continue;
    1289             :       }
    1290             :       else
    1291           7 :         ver[++k] = x;
    1292             :     } else
    1293          14 :       ver[++k] = a;
    1294          21 :     vep[k] = localpush(OClocalvar0, ver[k]);
    1295             :   }
    1296          28 :   checkdups(ver,vep);
    1297          28 : }
    1298             : 
    1299             : static void
    1300          41 : compileexport(GEN arg)
    1301             : {
    1302          41 :   long i, l = lg(arg);
    1303          82 :   for (i=1; i<l; i++)
    1304             :   {
    1305          41 :     long a=arg[i];
    1306          41 :     if (tree[a].f==Fassign)
    1307             :     {
    1308          14 :       long x = detag(tree[a].x);
    1309          14 :       long v = (long) getvardyn(x);
    1310          14 :       compilenode(tree[a].y,Ggen,FLnocopy);
    1311          14 :       op_push(OCexportvar,v,x);
    1312             :     } else
    1313             :     {
    1314          27 :       long x = detag(a);
    1315          27 :       long v = (long) getvardyn(x);
    1316          27 :       op_push(OCpushdyn,v,x);
    1317          27 :       op_push(OCexportvar,v,x);
    1318             :     }
    1319             :   }
    1320          41 : }
    1321             : 
    1322             : static void
    1323           6 : compileunexport(GEN arg)
    1324             : {
    1325           6 :   long i, l = lg(arg);
    1326          12 :   for (i=1; i<l; i++)
    1327             :   {
    1328           6 :     long a = arg[i];
    1329           6 :     long x = detag(a);
    1330           6 :     long v = (long) getvardyn(x);
    1331           6 :     op_push(OCunexportvar,v,x);
    1332             :   }
    1333           6 : }
    1334             : 
    1335             : static void
    1336     4670615 : compilefunc(entree *ep, long n, int mode, long flag)
    1337             : {
    1338     4670615 :   pari_sp ltop=avma;
    1339             :   long j;
    1340     4670615 :   long x=tree[n].x, y=tree[n].y;
    1341             :   op_code ret_op;
    1342             :   long ret_flag;
    1343             :   Gtype ret_typ;
    1344             :   char const *p,*q;
    1345             :   char c;
    1346             :   const char *str;
    1347             :   PPproto mod;
    1348     4670615 :   GEN arg=listtogen(y,Flistarg);
    1349     4670615 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
    1350     4670615 :   long lnl=first_safe_arg(arg, COsafelex);
    1351     4670615 :   long nbpointers=0, nbopcodes;
    1352     4670615 :   long nb=lg(arg)-1, lev=0;
    1353             :   long ev[20];
    1354     4670615 :   if (x>=OPnboperator)
    1355      200215 :     str=tree[x].str;
    1356             :   else
    1357             :   {
    1358     4470400 :     if (nb==2)
    1359      349206 :       str=tree[arg[1]].str+tree[arg[1]].len;
    1360     4121194 :     else if (nb==1)
    1361     4120217 :       str=tree[arg[1]].str;
    1362             :     else
    1363         977 :       str=tree[n].str;
    1364     4476639 :     while(*str==')') str++;
    1365             :   }
    1366     4670615 :   if (tree[n].f==Fassign)
    1367             :   {
    1368           0 :     nb=2; lnc=2; lnl=2; arg=mkvecsmall2(x,y);
    1369             :   }
    1370     4670615 :   else if (is_func_named(ep,"if"))
    1371             :   {
    1372        4795 :     if (nb>=4)
    1373         119 :       ep=is_entry("_multi_if");
    1374        4676 :     else if (mode==Gvoid)
    1375        3008 :       ep=is_entry("_void_if");
    1376             :   }
    1377     4665820 :   else if (is_func_named(ep,"return") && (flag&FLreturn) && nb<=1)
    1378             :   {
    1379         105 :     if (nb==0) op_push(OCpushgnil,0,n);
    1380         105 :     else compilenode(arg[1],Ggen,FLsurvive|FLreturn);
    1381         105 :     set_avma(ltop);
    1382     3734032 :     return;
    1383             :   }
    1384     4665715 :   else if (is_func_named(ep,"inline"))
    1385             :   {
    1386          13 :     compilemy(arg, str, 1);
    1387          13 :     compilecast(n,Gvoid,mode);
    1388          13 :     set_avma(ltop);
    1389          13 :     return;
    1390             :   }
    1391     4665702 :   else if (is_func_named(ep,"uninline"))
    1392             :   {
    1393           6 :     compileuninline(arg);
    1394           6 :     compilecast(n,Gvoid,mode);
    1395           6 :     set_avma(ltop);
    1396           6 :     return;
    1397             :   }
    1398     4665696 :   else if (is_func_named(ep,"my"))
    1399             :   {
    1400        3281 :     compilemy(arg, str, 0);
    1401        3281 :     compilecast(n,Gvoid,mode);
    1402        3281 :     set_avma(ltop);
    1403        3281 :     return;
    1404             :   }
    1405     4662415 :   else if (is_func_named(ep,"local"))
    1406             :   {
    1407          28 :     compilelocal(arg);
    1408          28 :     compilecast(n,Gvoid,mode);
    1409          28 :     set_avma(ltop);
    1410          28 :     return;
    1411             :   }
    1412     4662387 :   else if (is_func_named(ep,"export"))
    1413             :   {
    1414          41 :     compileexport(arg);
    1415          41 :     compilecast(n,Gvoid,mode);
    1416          41 :     set_avma(ltop);
    1417          41 :     return;
    1418             :   }
    1419     4662346 :   else if (is_func_named(ep,"unexport"))
    1420             :   {
    1421           6 :     compileunexport(arg);
    1422           6 :     compilecast(n,Gvoid,mode);
    1423           6 :     set_avma(ltop);
    1424           6 :     return;
    1425             :   }
    1426             :   /*We generate dummy code for global() for compatibility with gp2c*/
    1427     4662340 :   else if (is_func_named(ep,"global"))
    1428             :   {
    1429             :     long i;
    1430          21 :     for (i=1;i<=nb;i++)
    1431             :     {
    1432          14 :       long a=arg[i];
    1433             :       long en;
    1434          14 :       if (tree[a].f==Fassign)
    1435             :       {
    1436           7 :         compilenode(tree[a].y,Ggen,0);
    1437           7 :         a=tree[a].x;
    1438           7 :         en=(long)getvardyn(a);
    1439           7 :         op_push(OCstoredyn,en,a);
    1440             :       }
    1441             :       else
    1442             :       {
    1443           7 :         en=(long)getvardyn(a);
    1444           7 :         op_push(OCpushdyn,en,a);
    1445           7 :         op_push(OCpop,1,a);
    1446             :       }
    1447             :     }
    1448           7 :     compilecast(n,Gvoid,mode);
    1449           7 :     set_avma(ltop);
    1450           7 :     return;
    1451             :   }
    1452     4662333 :   else if (is_func_named(ep,"O"))
    1453             :   {
    1454        4746 :     if (nb!=1)
    1455           0 :       compile_err("wrong number of arguments", tree[n].str+tree[n].len-1);
    1456        4746 :     ep=is_entry("O(_^_)");
    1457        4746 :     if (tree[arg[1]].f==Ffunction && tree[arg[1]].x==OPpow)
    1458             :     {
    1459        3598 :       arg = listtogen(tree[arg[1]].y,Flistarg);
    1460        3598 :       nb  = lg(arg)-1;
    1461        3598 :       lnc = first_safe_arg(arg,COsafelex|COsafedyn);
    1462        3598 :       lnl = first_safe_arg(arg,COsafelex);
    1463             :     }
    1464             :   }
    1465     4657587 :   else if (x==OPn && tree[y].f==Fsmall)
    1466             :   {
    1467     3726170 :     set_avma(ltop);
    1468     3726170 :     compilesmall(y, -tree[y].x, mode);
    1469     3726170 :     return;
    1470             :   }
    1471      931417 :   else if (x==OPtrans && tree[y].f==Fvec)
    1472             :   {
    1473        4375 :     set_avma(ltop);
    1474        4375 :     compilevec(y, mode, OCcol);
    1475        4375 :     return;
    1476      927042 :   } else if(x==OPlength && tree[y].f==Ffunction && tree[y].x==OPtrans)
    1477             :   {
    1478           7 :     arg[1] = tree[y].y;
    1479           7 :     lnc = first_safe_arg(arg,COsafelex|COsafedyn);
    1480           7 :     lnl = first_safe_arg(arg,COsafelex);
    1481           7 :     ep = is_entry("#_~");
    1482             :   }
    1483      927035 :   else if (x==OPpow && nb==2)
    1484       69862 :   {
    1485       69862 :     long a = arg[2];
    1486       69862 :     if (tree[a].f==Fsmall)
    1487             :     {
    1488       65239 :       if(tree[a].x==2) { nb--; ep=is_entry("sqr"); }
    1489       47056 :       else ep=is_entry("_^s");
    1490             :     }
    1491        4623 :     else if (tree[a].f == Ffunction && tree[a].x == OPn)
    1492             :     {
    1493        1309 :       long ay = tree[a].y;
    1494        1309 :       if (tree[ay].f==Fsmall)
    1495             :       {
    1496        1162 :         if (tree[ay].x==1) {nb--; ep=is_entry("_inv"); }
    1497         784 :         else ep=is_entry("_^s");
    1498             :       }
    1499             :     }
    1500             :   }
    1501      857173 :   else if (x==OPcat)
    1502           0 :     compile_err("expected character: ',' or ')' instead of",
    1503           0 :         tree[arg[1]].str+tree[arg[1]].len);
    1504      936583 :   p=ep->code;
    1505      936583 :   if (!ep->value)
    1506           0 :     compile_err("unknown function",tree[n].str);
    1507      936583 :   nbopcodes = s_opcode.n;
    1508      936583 :   ret_op = get_ret_type(&p, ep->arity, &ret_typ, &ret_flag);
    1509      936583 :   j=1;
    1510      936583 :   if (*p)
    1511             :   {
    1512      927633 :     q=p;
    1513     2434389 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    1514             :     {
    1515     1506798 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    1516     1400190 :           && (mod==PPdefault || mod==PPdefaultmulti))
    1517       65917 :         mod=PPstd;
    1518     1506798 :       switch(mod)
    1519             :       {
    1520     1385716 :       case PPstd:
    1521     1385716 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    1522     1385716 :         if (c!='I' && c!='E' && c!='J')
    1523             :         {
    1524     1365993 :           long x = tree[arg[j]].x, f = tree[arg[j]].f;
    1525     1365993 :           if (f==Fnoarg)
    1526           0 :             compile_err("missing mandatory argument", tree[arg[j]].str);
    1527     1365993 :           if (f==Fseq)
    1528           0 :             compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1529             :         }
    1530     1385716 :         switch(c)
    1531             :         {
    1532     1269418 :         case 'G':
    1533     1269418 :           compilenode(arg[j],Ggen,j>=lnl?(j>=lnc?FLnocopy:FLnocopylex):0);
    1534     1269418 :           j++;
    1535     1269418 :           break;
    1536         448 :         case 'W':
    1537             :           {
    1538         448 :             long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
    1539         448 :             entree *ep = getlvalue(a);
    1540         434 :             long vn = getmvar(ep);
    1541         434 :             if (vn)
    1542         224 :               op_push(OCcowvarlex, vn, a);
    1543         210 :             else op_push(OCcowvardyn, (long)ep, a);
    1544         434 :             compilenode(a, Ggen,FLnocopy);
    1545         434 :             j++;
    1546         434 :             break;
    1547             :           }
    1548          84 :         case 'M':
    1549          84 :           if (tree[arg[j]].f!=Fsmall)
    1550             :           {
    1551          35 :             const char *flags = ep->code;
    1552          35 :             flags = strchr(flags, '\n'); /* Skip to the following '\n' */
    1553          35 :             if (!flags)
    1554           0 :               compile_err("missing flag in string function signature",
    1555           0 :                            tree[n].str);
    1556          35 :             flags++;
    1557          35 :             if (tree[arg[j]].f==Fconst && tree[arg[j]].x==CSTstr)
    1558          35 :             {
    1559          35 :               GEN str=strntoGENexp(tree[arg[j]].str,tree[arg[j]].len);
    1560          35 :               op_push(OCpushlong, eval_mnemonic(str, flags),n);
    1561          35 :               j++;
    1562             :             } else
    1563             :             {
    1564           0 :               compilenode(arg[j++],Ggen,FLnocopy);
    1565           0 :               op_push(OCevalmnem,(long)ep,n);
    1566             :             }
    1567          35 :             break;
    1568             :           }
    1569             :         case 'P': case 'L':
    1570       73923 :           compilenode(arg[j++],Gsmall,0);
    1571       73916 :           break;
    1572         207 :         case 'U':
    1573         207 :           compilenode(arg[j++],Gusmall,0);
    1574         200 :           break;
    1575        3807 :         case 'n':
    1576        3807 :           compilenode(arg[j++],Gvar,0);
    1577        3800 :           break;
    1578        2266 :         case '&': case '*':
    1579             :           {
    1580        2266 :             long vn, a=arg[j++];
    1581             :             entree *ep;
    1582        2266 :             if (c=='&')
    1583             :             {
    1584        1498 :               if (tree[a].f!=Frefarg)
    1585           0 :                 compile_err("expected character: '&'", tree[a].str);
    1586        1498 :               a=tree[a].x;
    1587             :             }
    1588        2266 :             a=detag(a);
    1589        2266 :             ep=getlvalue(a);
    1590        2266 :             vn=getmvar(ep);
    1591        2266 :             if (tree[a].f==Fentry)
    1592             :             {
    1593        2070 :               if (vn)
    1594             :               {
    1595         509 :                 access_push(vn);
    1596         509 :                 op_push(OCsimpleptrlex, vn,n);
    1597             :               }
    1598             :               else
    1599        1561 :                 op_push(OCsimpleptrdyn, (long)ep,n);
    1600             :             }
    1601             :             else
    1602             :             {
    1603         196 :               compilenewptr(vn, ep, a);
    1604         196 :               compilelvalue(a);
    1605         196 :               op_push(OCpushptr, 0, a);
    1606             :             }
    1607        2266 :             nbpointers++;
    1608        2266 :             break;
    1609             :           }
    1610       19723 :         case 'I':
    1611             :         case 'E':
    1612             :         case 'J':
    1613             :           {
    1614       19723 :             long a = arg[j++];
    1615       19723 :             GEN  d = compilefuncinline(n, c, a, flag, is_func_named(ep,"if"), lev, ev);
    1616       19723 :             op_push(OCpushgen, data_push(d), a);
    1617       19723 :             if (lg(d)==8) op_push(OCsaveframe,FLsurvive,n);
    1618       19723 :             break;
    1619             :           }
    1620        5312 :         case 'V':
    1621             :           {
    1622        5312 :             long a = arg[j++];
    1623        5312 :             (void)getvar(a);
    1624        5305 :             ev[lev++] = a;
    1625        5305 :             break;
    1626             :           }
    1627        6742 :         case '=':
    1628             :           {
    1629        6742 :             long a = arg[j++];
    1630        6742 :             ev[lev++] = tree[a].x;
    1631        6742 :             compilenode(tree[a].y, Ggen, FLnocopy);
    1632             :           }
    1633        6742 :           break;
    1634        1104 :         case 'r':
    1635             :           {
    1636        1104 :             long a=arg[j++];
    1637        1104 :             if (tree[a].f==Fentry)
    1638             :             {
    1639        1025 :               op_push(OCpushgen, data_push(strntoGENstr(tree[tree[a].x].str,
    1640        1025 :                                                         tree[tree[a].x].len)),n);
    1641        1025 :               op_push(OCtostr, -1,n);
    1642             :             }
    1643             :             else
    1644             :             {
    1645          79 :               compilenode(a,Ggen,FLnocopy);
    1646          79 :               op_push(OCtostr, -1,n);
    1647             :             }
    1648        1104 :             break;
    1649             :           }
    1650        2731 :         case 's':
    1651             :           {
    1652        2731 :             long a = arg[j++];
    1653        2731 :             GEN g = cattovec(a, OPcat);
    1654        2731 :             long l, nb = lg(g)-1;
    1655        2731 :             if (nb==1)
    1656             :             {
    1657        2661 :               compilenode(g[1], Ggen, FLnocopy);
    1658        2661 :               op_push(OCtostr, -1, a);
    1659             :             } else
    1660             :             {
    1661          70 :               op_push(OCvec, nb+1, a);
    1662         210 :               for(l=1; l<=nb; l++)
    1663             :               {
    1664         140 :                 compilenode(g[l], Ggen, FLsurvive);
    1665         140 :                 op_push(OCstackgen,l, a);
    1666             :               }
    1667          70 :               op_push(OCpop, 1, a);
    1668          70 :               op_push(OCcallgen,(long)is_entry("Str"), a);
    1669          70 :               op_push(OCtostr, -1, a);
    1670             :             }
    1671        2731 :             break;
    1672             :           }
    1673           0 :         default:
    1674           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1675           0 :               tree[x].len, tree[x].str);
    1676             :         }
    1677     1385674 :         break;
    1678       32899 :       case PPauto:
    1679       32899 :         switch(c)
    1680             :         {
    1681       28646 :         case 'p':
    1682       28646 :           op_push(OCprecreal,0,n);
    1683       28646 :           break;
    1684        4200 :         case 'b':
    1685        4200 :           op_push(OCbitprecreal,0,n);
    1686        4200 :           break;
    1687           0 :         case 'P':
    1688           0 :           op_push(OCprecdl,0,n);
    1689           0 :           break;
    1690          53 :         case 'C':
    1691          53 :           op_push(OCpushgen,data_push(pack_localvars()),n);
    1692          53 :           break;
    1693           0 :         case 'f':
    1694             :           {
    1695             :             static long foo;
    1696           0 :             op_push(OCpushlong,(long)&foo,n);
    1697           0 :             break;
    1698             :           }
    1699             :         }
    1700       32899 :         break;
    1701       42520 :       case PPdefault:
    1702       42520 :         j++;
    1703       42520 :         switch(c)
    1704             :         {
    1705       32775 :         case 'G':
    1706             :         case '&':
    1707             :         case 'E':
    1708             :         case 'I':
    1709             :         case 'r':
    1710             :         case 's':
    1711       32775 :           op_push(OCpushlong,0,n);
    1712       32775 :           break;
    1713        8500 :         case 'n':
    1714        8500 :           op_push(OCpushlong,-1,n);
    1715        8500 :           break;
    1716         902 :         case 'V':
    1717         902 :           ev[lev++] = -1;
    1718         902 :           break;
    1719         343 :         case 'P':
    1720         343 :           op_push(OCprecdl,0,n);
    1721         343 :           break;
    1722           0 :         default:
    1723           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1724           0 :               tree[x].len, tree[x].str);
    1725             :         }
    1726       42520 :         break;
    1727       30750 :       case PPdefaultmulti:
    1728       30750 :         j++;
    1729       30750 :         switch(c)
    1730             :         {
    1731           0 :         case 'G':
    1732           0 :           op_push(OCpushstoi,strtol(q+1,NULL,10),n);
    1733           0 :           break;
    1734       30633 :         case 'L':
    1735             :         case 'M':
    1736       30633 :           op_push(OCpushlong,strtol(q+1,NULL,10),n);
    1737       30633 :           break;
    1738          42 :         case 'U':
    1739          42 :           op_push(OCpushlong,(long)strtoul(q+1,NULL,10),n);
    1740          42 :           break;
    1741          75 :         case 'r':
    1742             :         case 's':
    1743          75 :           str_defproto(p, q, tree[n].str);
    1744          75 :           op_push(OCtostr, -1, n);
    1745          75 :           break;
    1746           0 :         default:
    1747           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1748           0 :               tree[x].len, tree[x].str);
    1749             :         }
    1750       30750 :         break;
    1751       14913 :       case PPstar:
    1752       14913 :         switch(c)
    1753             :         {
    1754         119 :         case 'E':
    1755             :           {
    1756         119 :             long k, n=nb+1-j;
    1757         119 :             GEN g=cgetg(n+1,t_VEC);
    1758         119 :             int ismif = is_func_named(ep,"_multi_if");
    1759         602 :             for(k=1; k<=n; k++)
    1760         552 :               gel(g, k) = compilefuncinline(n, c, arg[j+k-1], flag,
    1761         483 :                           ismif && (k==n || odd(k)), lev, ev);
    1762         119 :             op_push(OCpushgen, data_push(g), arg[j]);
    1763         119 :             j=nb+1;
    1764         119 :             break;
    1765             :           }
    1766       14794 :         case 's':
    1767             :           {
    1768       14794 :             long n=nb+1-j;
    1769             :             long k,l,l1,m;
    1770       14794 :             GEN g=cgetg(n+1,t_VEC);
    1771       35665 :             for(l1=0,k=1;k<=n;k++)
    1772             :             {
    1773       20871 :               gel(g,k)=cattovec(arg[j+k-1],OPcat);
    1774       20871 :               l1+=lg(gel(g,k))-1;
    1775             :             }
    1776       14794 :             op_push_loc(OCvec, l1+1, str);
    1777       35665 :             for(m=1,k=1;k<=n;k++)
    1778       41777 :               for(l=1;l<lg(gel(g,k));l++,m++)
    1779             :               {
    1780       20906 :                 compilenode(mael(g,k,l),Ggen,FLsurvive);
    1781       20906 :                 op_push(OCstackgen,m,mael(g,k,l));
    1782             :               }
    1783       14794 :             op_push_loc(OCpop, 1, str);
    1784       14794 :             j=nb+1;
    1785       14794 :             break;
    1786             :           }
    1787           0 :         default:
    1788           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    1789           0 :               tree[x].len, tree[x].str);
    1790             :         }
    1791       14913 :         break;
    1792           0 :       default:
    1793           0 :         pari_err_BUG("compilefunc [unknown PPproto]");
    1794             :       }
    1795     1506756 :       q=p;
    1796             :     }
    1797             :   }
    1798      936541 :   if (j<=nb)
    1799           0 :     compile_err("too many arguments",tree[arg[j]].str);
    1800      936541 :   op_push_loc(ret_op, (long) ep, str);
    1801      936541 :   if (mode==Ggen && (ret_flag&FLnocopy) && !(flag&FLnocopy))
    1802       10667 :     op_push_loc(OCcopy,0,str);
    1803      936541 :   if (ret_typ==Ggen && nbpointers==0 && s_opcode.n>nbopcodes+128)
    1804             :   {
    1805        2940 :     op_insert_loc(nbopcodes,OCavma,0,str);
    1806        2940 :     op_push_loc(OCgerepile,0,str);
    1807             :   }
    1808      936541 :   compilecast(n,ret_typ,mode);
    1809      936541 :   if (nbpointers) op_push_loc(OCendptr,nbpointers, str);
    1810      936541 :   set_avma(ltop);
    1811             : }
    1812             : 
    1813             : static void
    1814     7987048 : genclosurectx(const char *loc, long nbdata)
    1815             : {
    1816             :   long i;
    1817     7987048 :   GEN vep = cgetg(nbdata+1,t_VECSMALL);
    1818    28244721 :   for(i = 1; i <= nbdata; i++)
    1819             :   {
    1820    20257699 :     vep[i] = 0;
    1821    20257699 :     op_push_loc(OCpushlex,-i,loc);
    1822             :   }
    1823     7987022 :   frame_push(vep);
    1824     7987130 : }
    1825             : 
    1826             : static GEN
    1827     7997533 : genclosure(entree *ep, const char *loc, long nbdata, int check)
    1828             : {
    1829             :   struct codepos pos;
    1830     7997533 :   long nb=0;
    1831     7997533 :   const char *code=ep->code,*p,*q;
    1832             :   char c;
    1833             :   GEN text;
    1834     7997533 :   long index=ep->arity;
    1835     7997533 :   long arity=0, maskarg=0, maskarg0=0, stop=0, dovararg=0;
    1836             :   PPproto mod;
    1837             :   Gtype ret_typ;
    1838             :   long ret_flag;
    1839     7997533 :   op_code ret_op=get_ret_type(&code,ep->arity,&ret_typ,&ret_flag);
    1840     7997514 :   p=code;
    1841    36252912 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1842             :   {
    1843    28255398 :     if (mod==PPauto)
    1844        1989 :       stop=1;
    1845             :     else
    1846             :     {
    1847    28253409 :       if (stop) return NULL;
    1848    28253409 :       if (c=='V') continue;
    1849    28253409 :       maskarg<<=1; maskarg0<<=1; arity++;
    1850    28253409 :       switch(mod)
    1851             :       {
    1852    28252190 :       case PPstd:
    1853    28252190 :         maskarg|=1L;
    1854    28252190 :         break;
    1855         482 :       case PPdefault:
    1856         482 :         switch(c)
    1857             :         {
    1858          28 :         case '&':
    1859             :         case 'E':
    1860             :         case 'I':
    1861          28 :           maskarg0|=1L;
    1862          28 :           break;
    1863             :         }
    1864         482 :         break;
    1865         737 :       default:
    1866         737 :         break;
    1867             :       }
    1868             :     }
    1869             :   }
    1870     7997411 :   if (check && EpSTATIC(ep) && maskarg==0)
    1871        8593 :     return gen_0;
    1872     7988818 :   getcodepos(&pos);
    1873     7988861 :   dbgstart = loc;
    1874     7988861 :   if (nbdata > arity)
    1875           0 :     pari_err(e_MISC,"too many parameters for closure `%s'", ep->name);
    1876     7988861 :   if (nbdata) genclosurectx(loc, nbdata);
    1877     7988939 :   text = strtoGENstr(ep->name);
    1878     7988882 :   arity -= nbdata;
    1879     7988882 :   if (maskarg)  op_push_loc(OCcheckargs,maskarg,loc);
    1880     7988827 :   if (maskarg0) op_push_loc(OCcheckargs0,maskarg0,loc);
    1881     7988828 :   p=code;
    1882    36242258 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1883             :   {
    1884    28253400 :     switch(mod)
    1885             :     {
    1886         652 :     case PPauto:
    1887         652 :       switch(c)
    1888             :       {
    1889         652 :       case 'p':
    1890         652 :         op_push_loc(OCprecreal,0,loc);
    1891         652 :         break;
    1892           0 :       case 'b':
    1893           0 :         op_push_loc(OCbitprecreal,0,loc);
    1894           0 :         break;
    1895           0 :       case 'P':
    1896           0 :         op_push_loc(OCprecdl,0,loc);
    1897           0 :         break;
    1898           0 :       case 'C':
    1899           0 :         op_push_loc(OCpushgen,data_push(pack_localvars()),loc);
    1900          30 :         break;
    1901           0 :       case 'f':
    1902             :         {
    1903             :           static long foo;
    1904           0 :           op_push_loc(OCpushlong,(long)&foo,loc);
    1905           0 :           break;
    1906             :         }
    1907             :       }
    1908             :     default:
    1909    28253430 :       break;
    1910             :     }
    1911             :   }
    1912     7988823 :   q = p = code;
    1913    36242201 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1914             :   {
    1915    28253378 :     switch(mod)
    1916             :     {
    1917    28251954 :     case PPstd:
    1918    28251954 :       switch(c)
    1919             :       {
    1920    28222895 :       case 'G':
    1921    28222895 :         break;
    1922       17649 :       case 'M':
    1923             :       case 'L':
    1924       17649 :         op_push_loc(OCitos,-index,loc);
    1925       17649 :         break;
    1926       11364 :       case 'U':
    1927       11364 :         op_push_loc(OCitou,-index,loc);
    1928       11364 :         break;
    1929           0 :       case 'n':
    1930           0 :         op_push_loc(OCvarn,-index,loc);
    1931           0 :         break;
    1932           0 :       case '&': case '*':
    1933             :       case 'I':
    1934             :       case 'E':
    1935             :       case 'V':
    1936             :       case '=':
    1937           0 :         return NULL;
    1938          37 :       case 'r':
    1939             :       case 's':
    1940          37 :         op_push_loc(OCtostr,-index,loc);
    1941          37 :         break;
    1942             :       }
    1943    28251954 :       break;
    1944         652 :     case PPauto:
    1945         652 :       break;
    1946         412 :     case PPdefault:
    1947         412 :       switch(c)
    1948             :       {
    1949         216 :       case 'G':
    1950             :       case '&':
    1951             :       case 'E':
    1952             :       case 'I':
    1953             :       case 'V':
    1954         216 :         break;
    1955          14 :       case 'r':
    1956             :       case 's':
    1957          14 :         op_push_loc(OCtostr,-index,loc);
    1958          14 :         break;
    1959         112 :       case 'n':
    1960         112 :         op_push_loc(OCvarn,-index,loc);
    1961         112 :         break;
    1962          70 :       case 'P':
    1963          70 :         op_push_loc(OCprecdl,0,loc);
    1964          70 :         op_push_loc(OCdefaultlong,-index,loc);
    1965          70 :         break;
    1966           0 :       default:
    1967           0 :         pari_err(e_MISC,"Unknown prototype code `D%c' for `%s'",c,ep->name);
    1968             :       }
    1969         412 :       break;
    1970         339 :     case PPdefaultmulti:
    1971         339 :       switch(c)
    1972             :       {
    1973           0 :       case 'G':
    1974           0 :         op_push_loc(OCpushstoi,strtol(q+1,NULL,10),loc);
    1975           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1976           0 :         break;
    1977         319 :       case 'L':
    1978             :       case 'M':
    1979         319 :         op_push_loc(OCpushlong,strtol(q+1,NULL,10),loc);
    1980         319 :         op_push_loc(OCdefaultlong,-index,loc);
    1981         319 :         break;
    1982           4 :       case 'U':
    1983           4 :         op_push_loc(OCpushlong,(long)strtoul(q+1,NULL,10),loc);
    1984           4 :         op_push_loc(OCdefaultulong,-index,loc);
    1985           4 :         break;
    1986          16 :       case 'r':
    1987             :       case 's':
    1988          16 :         str_defproto(p, q, loc);
    1989          16 :         op_push_loc(OCdefaultgen,-index,loc);
    1990          16 :         op_push_loc(OCtostr,-index,loc);
    1991          16 :         break;
    1992           0 :       default:
    1993           0 :         pari_err(e_MISC,
    1994             :             "Unknown prototype code `D...,%c,' for `%s'",c,ep->name);
    1995             :       }
    1996         339 :       break;
    1997          21 :     case PPstar:
    1998          21 :       switch(c)
    1999             :       {
    2000          21 :       case 's':
    2001          21 :         dovararg = 1;
    2002          21 :         break;
    2003           0 :       case 'E':
    2004           0 :         return NULL;
    2005           0 :       default:
    2006           0 :         pari_err(e_MISC,"Unknown prototype code `%c*' for `%s'",c,ep->name);
    2007             :       }
    2008          21 :       break;
    2009           0 :     default:
    2010           0 :       return NULL;
    2011             :     }
    2012    28253378 :     index--;
    2013    28253378 :     q = p;
    2014             :   }
    2015     7988770 :   op_push_loc(ret_op, (long) ep, loc);
    2016     7988817 :   if (ret_flag==FLnocopy) op_push_loc(OCcopy,0,loc);
    2017     7988817 :   compilecast_loc(ret_typ, Ggen, loc);
    2018     7988817 :   if (dovararg) nb|=VARARGBITS;
    2019     7988817 :   return getfunction(&pos,nb+arity,nbdata,text,0);
    2020             : }
    2021             : 
    2022             : GEN
    2023     7985433 : snm_closure(entree *ep, GEN data)
    2024             : {
    2025     7985433 :   long i, n = data ? lg(data)-1: 0;
    2026     7985433 :   GEN C = genclosure(ep,ep->name,n,0);
    2027    28238307 :   for(i = 1; i <= n; i++) gmael(C,7,i) = gel(data,i);
    2028     7985413 :   return C;
    2029             : }
    2030             : 
    2031             : GEN
    2032        1820 : strtoclosure(const char *s, long n,  ...)
    2033             : {
    2034        1820 :   pari_sp av = avma;
    2035        1820 :   entree *ep = is_entry(s);
    2036             :   GEN C;
    2037        1820 :   if (!ep) pari_err(e_NOTFUNC, strtoGENstr(s));
    2038        1820 :   ep = do_alias(ep);
    2039        1820 :   if ((!EpSTATIC(ep) && EpVALENCE(ep)!=EpINSTALL) || !ep->value)
    2040           0 :     pari_err(e_MISC,"not a built-in/install'ed function: \"%s\"",s);
    2041        1820 :   C = genclosure(ep,ep->name,n,0);
    2042        1820 :   if (!C) pari_err(e_MISC,"function prototype unsupported: \"%s\"",s);
    2043             :   else
    2044             :   {
    2045             :     va_list ap;
    2046             :     long i;
    2047        1820 :     va_start(ap,n);
    2048        6923 :     for(i = 1; i <= n; i++) gmael(C,7,i) = va_arg(ap, GEN);
    2049        1820 :     va_end(ap);
    2050             :   }
    2051        1820 :   return gerepilecopy(av, C);
    2052             : }
    2053             : 
    2054             : GEN
    2055           0 : closuretoinl(GEN C)
    2056             : {
    2057           0 :   long i, n = closure_arity(C);
    2058           0 :   GEN text = closure_get_text(C);
    2059             :   struct codepos pos;
    2060             :   const char *loc;
    2061           0 :   getcodepos(&pos);
    2062           0 :   if (typ(text)==t_VEC) text = gel(text, 2);
    2063           0 :   loc = GSTR(text);
    2064           0 :   dbgstart = loc;
    2065           0 :   op_push_loc(OCpushgen, data_push(C), loc);
    2066           0 :   for (i = n; i >= 1 ; i--)
    2067           0 :     op_push_loc(OCpushlex, -i, loc);
    2068           0 :   op_push_loc(OCcalluser, n, loc);
    2069           0 :   return getfunction(&pos,0,0,text,0);
    2070             : }
    2071             : 
    2072             : GEN
    2073         119 : strtofunction(const char *s) { return strtoclosure(s, 0); }
    2074             : 
    2075             : GEN
    2076          21 : call0(GEN fun, GEN args)
    2077             : {
    2078          21 :   if (!is_vec_t(typ(args))) pari_err_TYPE("call",args);
    2079          21 :   switch(typ(fun))
    2080             :   {
    2081           7 :     case t_STR:
    2082           7 :       fun = strtofunction(GSTR(fun));
    2083          21 :     case t_CLOSURE: /* fall through */
    2084          21 :       return closure_callgenvec(fun, args);
    2085           0 :     default:
    2086           0 :       pari_err_TYPE("call", fun);
    2087             :       return NULL; /* LCOV_EXCL_LINE */
    2088             :   }
    2089             : }
    2090             : 
    2091             : static void
    2092       10279 : closurefunc(entree *ep, long n, long mode)
    2093             : {
    2094       10279 :   pari_sp ltop=avma;
    2095             :   GEN C;
    2096       10279 :   if (!ep->value) compile_err("unknown function",tree[n].str);
    2097       10279 :   C = genclosure(ep,tree[n].str,0,1);
    2098       10279 :   if (!C) compile_err("sorry, closure not implemented",tree[n].str);
    2099       10279 :   if (C==gen_0)
    2100             :   {
    2101        8593 :     compilefunc(ep,n,mode,0);
    2102        8593 :     return;
    2103             :   }
    2104        1686 :   op_push(OCpushgen, data_push(C), n);
    2105        1686 :   compilecast(n,Gclosure,mode);
    2106        1686 :   set_avma(ltop);
    2107             : }
    2108             : 
    2109             : static void
    2110       14631 : compileseq(long n, int mode, long flag)
    2111             : {
    2112       14631 :   pari_sp av = avma;
    2113       14631 :   GEN L = listtogen(n, Fseq);
    2114       14631 :   long i, l = lg(L)-1;
    2115       46677 :   for(i = 1; i < l; i++)
    2116       32046 :     compilenode(L[i],Gvoid,0);
    2117       14631 :   compilenode(L[l],mode,flag&(FLreturn|FLsurvive));
    2118       14631 :   set_avma(av);
    2119       14631 : }
    2120             : 
    2121             : static void
    2122    18599900 : compilenode(long n, int mode, long flag)
    2123             : {
    2124             :   long x,y;
    2125             : #ifdef STACK_CHECK
    2126    18599900 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2127           0 :     pari_err(e_MISC, "expression nested too deeply");
    2128             : #endif
    2129    18599900 :   if (n<0) pari_err_BUG("compilenode");
    2130    18599900 :   x=tree[n].x;
    2131    18599900 :   y=tree[n].y;
    2132             : 
    2133    18599900 :   switch(tree[n].f)
    2134             :   {
    2135       14631 :   case Fseq:
    2136       14631 :     compileseq(n, mode, flag);
    2137    18599837 :     return;
    2138       13134 :   case Fmatcoeff:
    2139       13134 :     compilematcoeff(n,mode);
    2140       13127 :     if (mode==Ggen && !(flag&FLnocopy))
    2141        4171 :       op_push(OCcopy,0,n);
    2142       13127 :     return;
    2143       43744 :   case Fassign:
    2144       43744 :     x = detag(x);
    2145       43744 :     if (tree[x].f==Fvec && tree[x].x>=0)
    2146         781 :     {
    2147         781 :       GEN vars = listtogen(tree[x].x,Fmatrixelts);
    2148         781 :       long i, l = lg(vars)-1, d = mode==Gvoid? l-1: l;
    2149         781 :       compilenode(y,Ggen,mode==Gvoid?0:flag&FLsurvive);
    2150        2434 :       for (i=1; i<=l; i++)
    2151        1653 :         if (tree[vars[i]].f==Fnoarg) d--;
    2152         781 :       if (d) op_push(OCdup, d, x);
    2153        2434 :       for(i=1; i<=l; i++)
    2154        1653 :         if (tree[vars[i]].f!=Fnoarg)
    2155             :         {
    2156        1639 :           long a = detag(vars[i]);
    2157        1639 :           entree *ep=getlvalue(a);
    2158        1639 :           long vn=getmvar(ep);
    2159        1639 :           op_push(OCpushlong,i,a);
    2160        1639 :           op_push(OCcompo1,Ggen,a);
    2161        1639 :           if (tree[a].f==Fentry)
    2162        1632 :             compilestore(vn,ep,n);
    2163             :           else
    2164             :           {
    2165           7 :             compilenewptr(vn,ep,n);
    2166           7 :             compilelvalue(a);
    2167           7 :             op_push(OCstoreptr,0,a);
    2168             :           }
    2169             :         }
    2170         781 :       if (mode!=Gvoid)
    2171         445 :         compilecast(n,Ggen,mode);
    2172             :     }
    2173             :     else
    2174             :     {
    2175       42963 :       entree *ep=getlvalue(x);
    2176       42963 :       long vn=getmvar(ep);
    2177       42963 :       if (tree[x].f!=Fentry)
    2178             :       {
    2179         623 :         compilenewptr(vn,ep,n);
    2180         623 :         compilelvalue(x);
    2181             :       }
    2182       42963 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    2183       42963 :       if (mode!=Gvoid)
    2184       28243 :         op_push(OCdup,1,n);
    2185       42963 :       if (tree[x].f==Fentry)
    2186       42340 :         compilestore(vn,ep,n);
    2187             :       else
    2188         623 :         op_push(OCstoreptr,0,x);
    2189       42963 :       if (mode!=Gvoid)
    2190       28243 :         compilecast(n,Ggen,mode);
    2191             :     }
    2192       43744 :     return;
    2193     1729288 :   case Fconst:
    2194             :     {
    2195     1729288 :       pari_sp ltop=avma;
    2196     1729288 :       if (tree[n].x!=CSTquote)
    2197             :       {
    2198     1725645 :         if (mode==Gvoid) return;
    2199     1725645 :         if (mode==Gvar) compile_varerr(tree[n].str);
    2200             :       }
    2201     1729288 :       if (mode==Gsmall) L_compile_err(tree[n].str);
    2202     1729288 :       if (mode==Gusmall && tree[n].x != CSTint) U_compile_err(tree[n].str);
    2203     1729281 :       switch(tree[n].x)
    2204             :       {
    2205        5401 :       case CSTreal:
    2206        5401 :         op_push(OCpushreal, data_push(strntoGENstr(tree[n].str,tree[n].len)),n);
    2207        5401 :         break;
    2208      840276 :       case CSTint:
    2209      840276 :         op_push(OCpushgen,  data_push(strtoi((char*)tree[n].str)),n);
    2210      840276 :         compilecast(n,Ggen, mode);
    2211      840276 :         break;
    2212      879961 :       case CSTstr:
    2213      879961 :         op_push(OCpushgen,  data_push(strntoGENexp(tree[n].str,tree[n].len)),n);
    2214      879961 :         break;
    2215        3643 :       case CSTquote:
    2216             :         { /* skip ' */
    2217        3643 :           entree *ep = fetch_entry_raw(tree[n].str+1,tree[n].len-1);
    2218        3643 :           if (EpSTATIC(ep)) compile_varerr(tree[n].str+1);
    2219        3643 :           op_push(OCpushvar, (long)ep,n);
    2220        3643 :           compilecast(n,Ggen, mode);
    2221        3643 :           break;
    2222             :         }
    2223           0 :       default:
    2224           0 :         pari_err_BUG("compilenode, unsupported constant");
    2225             :       }
    2226     1729281 :       set_avma(ltop);
    2227     1729281 :       return;
    2228             :     }
    2229     7364690 :   case Fsmall:
    2230     7364690 :     compilesmall(n, x, mode);
    2231     7364683 :     return;
    2232     4457816 :   case Fvec:
    2233     4457816 :     compilevec(n, mode, OCvec);
    2234     4457816 :     return;
    2235        9604 :   case Fmat:
    2236        9604 :     compilemat(n, mode);
    2237        9604 :     return;
    2238           0 :   case Frefarg:
    2239           0 :     compile_err("unexpected character '&':",tree[n].str);
    2240           0 :     return;
    2241           0 :   case Findarg:
    2242           0 :     compile_err("unexpected character '~':",tree[n].str);
    2243           0 :     return;
    2244      272798 :   case Fentry:
    2245             :     {
    2246      272798 :       entree *ep=getentry(n);
    2247      272798 :       long vn=getmvar(ep);
    2248      272798 :       if (vn)
    2249             :       {
    2250       70766 :         access_push(vn);
    2251       70766 :         op_push(OCpushlex,(long)vn,n);
    2252       70766 :         addcopy(n,mode,flag,FLnocopy|FLnocopylex);
    2253       70766 :         compilecast(n,Ggen,mode);
    2254             :       }
    2255      202032 :       else if (ep->valence==EpVAR || ep->valence==EpNEW)
    2256             :       {
    2257      191753 :         if (DEBUGLEVEL && mode==Gvoid)
    2258           0 :           pari_warn(warner,"statement with no effect: `%s'",ep->name);
    2259      191753 :         op_push(OCpushdyn,(long)ep,n);
    2260      191753 :         addcopy(n,mode,flag,FLnocopy);
    2261      191753 :         compilecast(n,Ggen,mode);
    2262             :       }
    2263             :       else
    2264       10279 :         closurefunc(ep,n,mode);
    2265      272798 :       return;
    2266             :     }
    2267     4684487 :   case Ffunction:
    2268             :     {
    2269     4684487 :       entree *ep=getfunc(n);
    2270     4684487 :       if (getmvar(ep) || EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2271             :       {
    2272       22465 :         if (tree[n].x<OPnboperator) /* should not happen */
    2273           0 :           compile_err("operator unknown",tree[n].str);
    2274       22465 :         compilecall(n,mode,ep);
    2275             :       }
    2276             :       else
    2277     4662022 :         compilefunc(ep,n,mode,flag);
    2278     4684445 :       return;
    2279             :     }
    2280         322 :   case Fcall:
    2281         322 :     compilecall(n,mode,NULL);
    2282         322 :     return;
    2283        9099 :   case Flambda:
    2284             :     {
    2285        9099 :       pari_sp ltop=avma;
    2286             :       struct codepos pos;
    2287        9099 :       GEN arg=listtogen(x,Flistarg);
    2288        9099 :       long nb, lgarg, nbmvar, dovararg=0, gap;
    2289        9099 :       long strict = GP_DATA->strictargs;
    2290        9099 :       GEN vep = cgetg_copy(arg, &lgarg);
    2291        9099 :       GEN text=cgetg(3,t_VEC);
    2292        9099 :       gel(text,1)=strntoGENstr(tree[x].str,tree[x].len);
    2293        9099 :       if (lgarg==2 && tree[x].str[0]!='~' && tree[x].f==Findarg)
    2294             :         /* This occurs for member functions */
    2295          14 :         gel(text,1)=shallowconcat(strntoGENstr("~",1),gel(text,1));
    2296        9099 :       gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
    2297        9099 :       getcodepos(&pos);
    2298        9099 :       dbgstart=tree[x].str+tree[x].len;
    2299        9099 :       gap = tree[y].str-dbgstart;
    2300        9099 :       nbmvar = nblex;
    2301        9099 :       ctxmvar(nbmvar);
    2302        9099 :       nb = lgarg-1;
    2303        9099 :       if (nb)
    2304             :       {
    2305             :         long i;
    2306       13065 :         for(i=1;i<=nb;i++)
    2307             :         {
    2308        8022 :           long a = arg[i], f = tree[a].f;
    2309        8022 :           if (i==nb && f==Fvararg)
    2310             :           {
    2311          21 :             dovararg=1;
    2312          21 :             vep[i]=(long)getvar(tree[a].x);
    2313             :           }
    2314             :           else
    2315        8001 :             vep[i]=(long)getvar(f==Fassign||f==Findarg?tree[a].x:a);
    2316        8022 :           var_push(NULL,Lmy);
    2317             :         }
    2318        5043 :         checkdups(arg,vep);
    2319        5043 :         op_push(OCgetargs,nb,x);
    2320        5043 :         access_push(lg(vep)-1);
    2321        5043 :         frame_push(vep);
    2322       13065 :         for (i=1;i<=nb;i++)
    2323             :         {
    2324        8022 :           long a = arg[i], f = tree[a].f;
    2325        8022 :           long y = tree[a].y;
    2326        8022 :           if (f==Fassign && (strict || !is_node_zero(y)))
    2327             :           {
    2328         357 :             if (tree[y].f==Fsmall)
    2329         273 :               compilenode(y, Ggen, 0);
    2330             :             else
    2331             :             {
    2332             :               struct codepos lpos;
    2333          84 :               long nbmvar = nblex;
    2334          84 :               getcodepos(&lpos);
    2335          84 :               compilenode(y, Ggen, 0);
    2336          84 :               op_push(OCpushgen, data_push(getclosure(&lpos,nbmvar)),a);
    2337             :             }
    2338         357 :             op_push(OCdefaultarg,-nb+i-1,a);
    2339        7665 :           } else if (f==Findarg)
    2340          84 :             op_push(OCsetref, -nb+i-1, a);
    2341        8022 :           localvars[s_lvar.n-nb+i-1].ep=(entree*)vep[i];
    2342             :         }
    2343             :       }
    2344        9099 :       if (strict)
    2345          21 :         op_push(OCcheckuserargs,nb,x);
    2346        9099 :       dbgstart=tree[y].str;
    2347        9099 :       if (y>=0 && tree[y].f!=Fnoarg)
    2348        9099 :         compilenode(y,Ggen,FLsurvive|FLreturn);
    2349             :       else
    2350           0 :         compilecast(n,Gvoid,Ggen);
    2351        9099 :       if (dovararg) nb|=VARARGBITS;
    2352        9099 :       op_push(OCpushgen, data_push(getfunction(&pos,nb,nbmvar,text,gap)),n);
    2353        9099 :       if (nbmvar) op_push(OCsaveframe,!!(flag&FLsurvive),n);
    2354        9099 :       compilecast(n, Gclosure, mode);
    2355        9099 :       set_avma(ltop);
    2356        9099 :       return;
    2357             :     }
    2358           0 :   case Ftag:
    2359           0 :     compilenode(x, mode,flag);
    2360           0 :     return;
    2361           7 :   case Fnoarg:
    2362           7 :     compilecast(n,Gvoid,mode);
    2363           7 :     return;
    2364         280 :   case Fnorange:
    2365         280 :     op_push(OCpushlong,LONG_MAX,n);
    2366         280 :     compilecast(n,Gsmall,mode);
    2367         280 :     return;
    2368           0 :   default:
    2369           0 :     pari_err_BUG("compilenode");
    2370             :   }
    2371             : }
    2372             : 
    2373             : GEN
    2374      932060 : gp_closure(long n)
    2375             : {
    2376             :   struct codepos pos;
    2377      932060 :   getcodepos(&pos);
    2378      932060 :   dbgstart=tree[n].str;
    2379      932060 :   compilenode(n,Ggen,FLsurvive|FLreturn);
    2380      932018 :   return getfunction(&pos,0,0,strntoGENstr(tree[n].str,tree[n].len),0);
    2381             : }
    2382             : 
    2383             : GEN
    2384         105 : closure_derivn(GEN G, long n)
    2385             : {
    2386         105 :   pari_sp ltop = avma;
    2387             :   struct codepos pos;
    2388         105 :   long arity = closure_arity(G);
    2389             :   const char *code;
    2390             :   GEN t, text;
    2391             : 
    2392         105 :   if (arity == 0 || closure_is_variadic(G)) pari_err_TYPE("derivfun",G);
    2393         105 :   t = closure_get_text(G);
    2394         105 :   code = GSTR((typ(t) == t_STR)? t: GENtoGENstr(G));
    2395         105 :   if (n > 1)
    2396             :   {
    2397          49 :     text = cgetg(1+nchar2nlong(9+strlen(code)+n),t_STR);
    2398          49 :     sprintf(GSTR(text), "derivn(%s,%ld)", code, n);
    2399             :   }
    2400             :   else
    2401             :   {
    2402          56 :     text = cgetg(1+nchar2nlong(4+strlen(code)),t_STR);
    2403          56 :     sprintf(GSTR(text), (typ(t) == t_STR)? "%s'": "(%s)'",code);
    2404             :   }
    2405         105 :   getcodepos(&pos);
    2406         105 :   dbgstart = code;
    2407         105 :   op_push_loc(OCpackargs, arity, code);
    2408         105 :   op_push_loc(OCpushgen, data_push(G), code);
    2409         105 :   op_push_loc(OCpushlong, n, code);
    2410         105 :   op_push_loc(OCprecreal, 0, code);
    2411         105 :   op_push_loc(OCcallgen, (long)is_entry("_derivfun"), code);
    2412         105 :   return gerepilecopy(ltop, getfunction(&pos, arity, 0, text, 0));
    2413             : }
    2414             : 
    2415             : GEN
    2416           0 : closure_deriv(GEN G)
    2417           0 : { return closure_derivn(G, 1); }
    2418             : 
    2419             : static long
    2420     4558158 : vec_optimize(GEN arg)
    2421             : {
    2422     4558158 :   long fl = COsafelex|COsafedyn;
    2423             :   long i;
    2424    20732873 :   for (i=1; i<lg(arg); i++)
    2425             :   {
    2426    16174722 :     optimizenode(arg[i]);
    2427    16174715 :     fl &= tree[arg[i]].flags;
    2428             :   }
    2429     4558151 :   return fl;
    2430             : }
    2431             : 
    2432             : static void
    2433     4463378 : optimizevec(long n)
    2434             : {
    2435     4463378 :   pari_sp ltop=avma;
    2436     4463378 :   long x = tree[n].x;
    2437     4463378 :   GEN  arg = listtogen(x, Fmatrixelts);
    2438     4463378 :   tree[n].flags = vec_optimize(arg);
    2439     4463378 :   set_avma(ltop);
    2440     4463378 : }
    2441             : 
    2442             : static void
    2443        9604 : optimizemat(long n)
    2444             : {
    2445        9604 :   pari_sp ltop = avma;
    2446        9604 :   long x = tree[n].x;
    2447             :   long i;
    2448        9604 :   GEN line = listtogen(x,Fmatrixlines);
    2449        9604 :   long fl = COsafelex|COsafedyn;
    2450       47726 :   for(i=1;i<lg(line);i++)
    2451             :   {
    2452       38122 :     GEN col=listtogen(line[i],Fmatrixelts);
    2453       38122 :     fl &= vec_optimize(col);
    2454             :   }
    2455        9604 :   set_avma(ltop); tree[n].flags=fl;
    2456        9604 : }
    2457             : 
    2458             : static void
    2459       14114 : optimizematcoeff(long n)
    2460             : {
    2461       14114 :   long x=tree[n].x;
    2462       14114 :   long y=tree[n].y;
    2463       14114 :   long yx=tree[y].x;
    2464       14114 :   long yy=tree[y].y;
    2465             :   long fl;
    2466       14114 :   optimizenode(x);
    2467       14114 :   optimizenode(yx);
    2468       14114 :   fl=tree[x].flags&tree[yx].flags;
    2469       14114 :   if (yy>=0)
    2470             :   {
    2471        1750 :     optimizenode(yy);
    2472        1750 :     fl&=tree[yy].flags;
    2473             :   }
    2474       14114 :   tree[n].flags=fl;
    2475       14114 : }
    2476             : 
    2477             : static void
    2478     4665998 : optimizefunc(entree *ep, long n)
    2479             : {
    2480     4665998 :   pari_sp av=avma;
    2481             :   long j;
    2482     4665998 :   long x=tree[n].x;
    2483     4665998 :   long y=tree[n].y;
    2484             :   Gtype t;
    2485             :   PPproto mod;
    2486     4665998 :   long fl=COsafelex|COsafedyn;
    2487             :   const char *p;
    2488             :   char c;
    2489     4665998 :   GEN arg = listtogen(y,Flistarg);
    2490     4665998 :   long nb=lg(arg)-1, ret_flag;
    2491     4665998 :   if (is_func_named(ep,"if") && nb>=4)
    2492         119 :     ep=is_entry("_multi_if");
    2493     4665998 :   p = ep->code;
    2494     4665998 :   if (!p)
    2495        3382 :     fl=0;
    2496             :   else
    2497     4662616 :     (void) get_ret_type(&p, 2, &t, &ret_flag);
    2498     4665998 :   if (p && *p)
    2499             :   {
    2500     4655736 :     j=1;
    2501     9978070 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    2502             :     {
    2503     5322362 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    2504     5148638 :           && (mod==PPdefault || mod==PPdefaultmulti))
    2505       62424 :         mod=PPstd;
    2506     5322362 :       switch(mod)
    2507             :       {
    2508     5134199 :       case PPstd:
    2509     5134199 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    2510     5134171 :         if (tree[arg[j]].f==Fnoarg && c!='I' && c!='E')
    2511           0 :           compile_err("missing mandatory argument", tree[arg[j]].str);
    2512     5134171 :         switch(c)
    2513             :         {
    2514     5095824 :         case 'G':
    2515             :         case 'n':
    2516             :         case 'M':
    2517             :         case 'L':
    2518             :         case 'U':
    2519             :         case 'P':
    2520     5095824 :           optimizenode(arg[j]);
    2521     5095824 :           fl&=tree[arg[j++]].flags;
    2522     5095824 :           break;
    2523       19730 :         case 'I':
    2524             :         case 'E':
    2525             :         case 'J':
    2526       19730 :           optimizenode(arg[j]);
    2527       19730 :           fl&=tree[arg[j]].flags;
    2528       19730 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2529       19730 :           break;
    2530        2266 :         case '&': case '*':
    2531             :           {
    2532        2266 :             long a=arg[j];
    2533        2266 :             if (c=='&')
    2534             :             {
    2535        1498 :               if (tree[a].f!=Frefarg)
    2536           0 :                 compile_err("expected character: '&'", tree[a].str);
    2537        1498 :               a=tree[a].x;
    2538             :             }
    2539        2266 :             optimizenode(a);
    2540        2266 :             tree[arg[j++]].flags=COsafelex|COsafedyn;
    2541        2266 :             fl=0;
    2542        2266 :             break;
    2543             :           }
    2544         462 :         case 'W':
    2545             :         {
    2546         462 :           long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
    2547         462 :           optimizenode(a);
    2548         462 :           fl=0; j++;
    2549         462 :           break;
    2550             :         }
    2551        6416 :         case 'V':
    2552             :         case 'r':
    2553        6416 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2554        6416 :           break;
    2555        6742 :         case '=':
    2556             :           {
    2557        6742 :             long a=arg[j++], y=tree[a].y;
    2558        6742 :             if (tree[a].f!=Fassign)
    2559           0 :               compile_err("expected character: '=' instead of",
    2560           0 :                   tree[a].str+tree[a].len);
    2561        6742 :             optimizenode(y);
    2562        6742 :             fl&=tree[y].flags;
    2563             :           }
    2564        6742 :           break;
    2565        2731 :         case 's':
    2566        2731 :           fl &= vec_optimize(cattovec(arg[j++], OPcat));
    2567        2731 :           break;
    2568           0 :         default:
    2569           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    2570           0 :               tree[x].len, tree[x].str);
    2571             :         }
    2572     5134171 :         break;
    2573      101561 :       case PPauto:
    2574      101561 :         break;
    2575       71689 :       case PPdefault:
    2576             :       case PPdefaultmulti:
    2577       71689 :         if (j<=nb) optimizenode(arg[j++]);
    2578       71689 :         break;
    2579       14913 :       case PPstar:
    2580       14913 :         switch(c)
    2581             :         {
    2582         119 :         case 'E':
    2583             :           {
    2584         119 :             long n=nb+1-j;
    2585             :             long k;
    2586         602 :             for(k=1;k<=n;k++)
    2587             :             {
    2588         483 :               optimizenode(arg[j+k-1]);
    2589         483 :               fl &= tree[arg[j+k-1]].flags;
    2590             :             }
    2591         119 :             j=nb+1;
    2592         119 :             break;
    2593             :           }
    2594       14794 :         case 's':
    2595             :           {
    2596       14794 :             long n=nb+1-j;
    2597             :             long k;
    2598       35665 :             for(k=1;k<=n;k++)
    2599       20871 :               fl &= vec_optimize(cattovec(arg[j+k-1],OPcat));
    2600       14794 :             j=nb+1;
    2601       14794 :             break;
    2602             :           }
    2603           0 :         default:
    2604           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    2605           0 :               tree[x].len, tree[x].str);
    2606             :         }
    2607       14913 :         break;
    2608           0 :       default:
    2609           0 :         pari_err_BUG("optimizefun [unknown PPproto]");
    2610             :       }
    2611             :     }
    2612     4655708 :     if (j<=nb)
    2613           0 :       compile_err("too many arguments",tree[arg[j]].str);
    2614             :   }
    2615       10262 :   else (void)vec_optimize(arg);
    2616     4665970 :   set_avma(av); tree[n].flags=fl;
    2617     4665970 : }
    2618             : 
    2619             : static void
    2620       22794 : optimizecall(long n)
    2621             : {
    2622       22794 :   pari_sp av=avma;
    2623       22794 :   long x=tree[n].x;
    2624       22794 :   long y=tree[n].y;
    2625       22794 :   GEN arg=listtogen(y,Flistarg);
    2626       22794 :   optimizenode(x);
    2627       22794 :   tree[n].flags = COsafelex&tree[x].flags&vec_optimize(arg);
    2628       22787 :   set_avma(av);
    2629       22787 : }
    2630             : 
    2631             : static void
    2632       14631 : optimizeseq(long n)
    2633             : {
    2634       14631 :   pari_sp av = avma;
    2635       14631 :   GEN L = listtogen(n, Fseq);
    2636       14631 :   long i, l = lg(L)-1, flags=-1L;
    2637       61308 :   for(i = 1; i <= l; i++)
    2638             :   {
    2639       46677 :     optimizenode(L[i]);
    2640       46677 :     flags &= tree[L[i]].flags;
    2641             :   }
    2642       14631 :   set_avma(av);
    2643       14631 :   tree[n].flags = flags;
    2644       14631 : }
    2645             : 
    2646             : void
    2647    22472196 : optimizenode(long n)
    2648             : {
    2649             :   long x,y;
    2650             : #ifdef STACK_CHECK
    2651    22472196 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2652           0 :     pari_err(e_MISC, "expression nested too deeply");
    2653             : #endif
    2654    22472196 :   if (n<0)
    2655           0 :     pari_err_BUG("optimizenode");
    2656    22472196 :   x=tree[n].x;
    2657    22472196 :   y=tree[n].y;
    2658             : 
    2659    22472196 :   switch(tree[n].f)
    2660             :   {
    2661       14631 :   case Fseq:
    2662       14631 :     optimizeseq(n);
    2663    22394522 :     return;
    2664       15864 :   case Frange:
    2665       15864 :     optimizenode(x);
    2666       15864 :     optimizenode(y);
    2667       15864 :     tree[n].flags=tree[x].flags&tree[y].flags;
    2668       15864 :     break;
    2669       14114 :   case Fmatcoeff:
    2670       14114 :     optimizematcoeff(n);
    2671       14114 :     break;
    2672       47654 :   case Fassign:
    2673       47654 :     optimizenode(x);
    2674       47654 :     optimizenode(y);
    2675       47654 :     tree[n].flags=0;
    2676       47654 :     break;
    2677    13208927 :   case Fnoarg:
    2678             :   case Fnorange:
    2679             :   case Fsmall:
    2680             :   case Fconst:
    2681             :   case Fentry:
    2682    13208927 :     tree[n].flags=COsafelex|COsafedyn;
    2683    13208927 :     return;
    2684     4463378 :   case Fvec:
    2685     4463378 :     optimizevec(n);
    2686     4463378 :     return;
    2687        9604 :   case Fmat:
    2688        9604 :     optimizemat(n);
    2689        9604 :     return;
    2690           7 :   case Frefarg:
    2691           7 :     compile_err("unexpected character '&'",tree[n].str);
    2692           0 :     return;
    2693         126 :   case Findarg:
    2694         126 :     return;
    2695           0 :   case Fvararg:
    2696           0 :     compile_err("unexpected characters '..'",tree[n].str);
    2697           0 :     return;
    2698     4688470 :   case Ffunction:
    2699             :     {
    2700     4688470 :       entree *ep=getfunc(n);
    2701     4688470 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2702       22472 :         optimizecall(n);
    2703             :       else
    2704     4665998 :         optimizefunc(ep,n);
    2705     4688435 :       return;
    2706             :     }
    2707         322 :   case Fcall:
    2708         322 :     optimizecall(n);
    2709         322 :     return;
    2710        9099 :   case Flambda:
    2711        9099 :     optimizenode(y);
    2712        9099 :     tree[n].flags=COsafelex|COsafedyn;
    2713        9099 :     return;
    2714           0 :   case Ftag:
    2715           0 :     optimizenode(x);
    2716           0 :     tree[n].flags=tree[x].flags;
    2717           0 :     return;
    2718           0 :   default:
    2719           0 :     pari_err_BUG("optimizenode");
    2720             :   }
    2721             : }

Generated by: LCOV version 1.16