Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - compile.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.10.0 lcov report (development 21348-d75f58f) Lines: 1343 1493 90.0 %
Date: 2017-11-20 06:21:05 Functions: 77 80 96.2 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : #include "anal.h"
      17             : #include "tree.h"
      18             : #include "opcode.h"
      19             : 
      20             : #define tree pari_tree
      21             : 
      22             : enum COflags {COsafelex=1, COsafedyn=2};
      23             : 
      24             : /***************************************************************************
      25             :  **                                                                       **
      26             :  **                           String constant expansion                   **
      27             :  **                                                                       **
      28             :  ***************************************************************************/
      29             : 
      30             : static char *
      31     1107001 : translate(const char **src, char *s)
      32             : {
      33     1107001 :   const char *t = *src;
      34     8996833 :   while (*t)
      35             :   {
      36    15780196 :     while (*t == '\\')
      37             :     {
      38         532 :       switch(*++t)
      39             :       {
      40           0 :         case 'e':  *s='\033'; break; /* escape */
      41         350 :         case 'n':  *s='\n'; break;
      42          14 :         case 't':  *s='\t'; break;
      43         168 :         default:   *s=*t; if (!*t) { *src=s; return NULL; }
      44             :       }
      45         532 :       t++; s++;
      46             :     }
      47     7889832 :     if (*t == '"')
      48             :     {
      49     1107001 :       if (t[1] != '"') break;
      50           0 :       t += 2; continue;
      51             :     }
      52     6782831 :     *s++ = *t++;
      53             :   }
      54     1107001 :   *s=0; *src=t; return s;
      55             : }
      56             : 
      57             : static void
      58           0 : matchQ(const char *s, char *entry)
      59             : {
      60           0 :   if (*s != '"')
      61           0 :     pari_err(e_SYNTAX,"expected character: '\"' instead of",s,entry);
      62           0 : }
      63             : 
      64             : /*  Read a "string" from src. Format then copy it, starting at s. Return
      65             :  *  pointer to char following the end of the input string */
      66             : char *
      67           0 : pari_translate_string(const char *src, char *s, char *entry)
      68             : {
      69           0 :   matchQ(src, entry); src++; s = translate(&src, s);
      70           0 :   if (!s) pari_err(e_SYNTAX,"run-away string",src,entry);
      71           0 :   matchQ(src, entry); return (char*)src+1;
      72             : }
      73             : 
      74             : static GEN
      75     1107001 : strntoGENexp(const char *str, long len)
      76             : {
      77     1107001 :   GEN z = cgetg(1+nchar2nlong(len-1), t_STR);
      78     1107001 :   const char *t = str+1;
      79     1107001 :   if (!translate(&t, GSTR(z))) compile_err("run-away string",str);
      80     1107001 :   return z;
      81             : }
      82             : 
      83             : /***************************************************************************
      84             :  **                                                                       **
      85             :  **                           Byte-code compiler                          **
      86             :  **                                                                       **
      87             :  ***************************************************************************/
      88             : 
      89             : typedef enum {Llocal, Lmy} Ltype;
      90             : 
      91             : struct vars_s
      92             : {
      93             :   Ltype type; /*Only Llocal and Lmy are allowed */
      94             :   int inl;
      95             :   entree *ep;
      96             : };
      97             : 
      98             : struct frame_s
      99             : {
     100             :   long pc;
     101             :   GEN frame;
     102             : };
     103             : 
     104             : static THREAD pari_stack s_opcode, s_operand, s_data, s_lvar;
     105             : static THREAD pari_stack s_dbginfo, s_frame;
     106             : static THREAD char *opcode;
     107             : static THREAD long *operand;
     108             : static THREAD GEN *data;
     109             : static THREAD long offset;
     110             : static THREAD struct vars_s *localvars;
     111             : static THREAD const char **dbginfo, *dbgstart;
     112             : static THREAD struct frame_s *frames;
     113             : 
     114             : void
     115       92761 : pari_init_compiler(void)
     116             : {
     117       92761 :   pari_stack_init(&s_opcode,sizeof(*opcode),(void **)&opcode);
     118       92340 :   pari_stack_init(&s_operand,sizeof(*operand),(void **)&operand);
     119       92111 :   pari_stack_init(&s_data,sizeof(*data),(void **)&data);
     120       92046 :   pari_stack_init(&s_lvar,sizeof(*localvars),(void **)&localvars);
     121       92231 :   pari_stack_init(&s_dbginfo,sizeof(*dbginfo),(void **)&dbginfo);
     122       92608 :   pari_stack_init(&s_frame,sizeof(*frames),(void **)&frames);
     123       92761 :   offset=-1;
     124       92761 : }
     125             : void
     126       92710 : pari_close_compiler(void)
     127             : {
     128       92710 :   pari_stack_delete(&s_opcode);
     129       92828 :   pari_stack_delete(&s_operand);
     130       92783 :   pari_stack_delete(&s_data);
     131       92744 :   pari_stack_delete(&s_lvar);
     132       92759 : }
     133             : 
     134             : struct codepos
     135             : {
     136             :   long opcode, data, localvars, frames;
     137             :   long offset;
     138             :   const char *dbgstart;
     139             : };
     140             : 
     141             : static void
     142      323417 : getcodepos(struct codepos *pos)
     143             : {
     144      323417 :   pos->opcode=s_opcode.n;
     145      323417 :   pos->data=s_data.n;
     146      323417 :   pos->offset=offset;
     147      323417 :   pos->localvars=s_lvar.n;
     148      323417 :   pos->dbgstart=dbgstart;
     149      323417 :   pos->frames=s_frame.n;
     150      323417 :   offset=s_data.n-1;
     151      323417 : }
     152             : 
     153             : void
     154         263 : compilestate_reset(void)
     155             : {
     156         263 :   s_opcode.n=0;
     157         263 :   s_operand.n=0;
     158         263 :   s_dbginfo.n=0;
     159         263 :   s_data.n=0;
     160         263 :   s_lvar.n=0;
     161         263 :   s_frame.n=0;
     162         263 :   offset=-1;
     163         263 :   dbgstart=NULL;
     164         263 : }
     165             : 
     166             : void
     167     1356503 : compilestate_save(struct pari_compilestate *comp)
     168             : {
     169     1356503 :   comp->opcode=s_opcode.n;
     170     1356503 :   comp->operand=s_operand.n;
     171     1356503 :   comp->data=s_data.n;
     172     1356503 :   comp->offset=offset;
     173     1356503 :   comp->localvars=s_lvar.n;
     174     1356503 :   comp->dbgstart=dbgstart;
     175     1356503 :   comp->dbginfo=s_dbginfo.n;
     176     1356503 :   comp->frames=s_frame.n;
     177     1356503 : }
     178             : 
     179             : void
     180       41954 : compilestate_restore(struct pari_compilestate *comp)
     181             : {
     182       41954 :   s_opcode.n=comp->opcode;
     183       41954 :   s_operand.n=comp->operand;
     184       41954 :   s_data.n=comp->data;
     185       41954 :   offset=comp->offset;
     186       41954 :   s_lvar.n=comp->localvars;
     187       41954 :   dbgstart=comp->dbgstart;
     188       41954 :   s_dbginfo.n=comp->dbginfo;
     189       41954 :   s_frame.n=comp->frames;
     190       41954 : }
     191             : 
     192             : static GEN
     193      323403 : getfunction(const struct codepos *pos, long arity, long nbmvar, GEN text, long gap)
     194             : {
     195      323403 :   long lop =s_opcode.n+1-pos->opcode;
     196      323403 :   long ldat=s_data.n+1-pos->data;
     197      323403 :   long lfram=s_frame.n+1-pos->frames;
     198      323403 :   GEN cl=cgetg(nbmvar?8:(text?7:6),t_CLOSURE);
     199             :   GEN frpc, fram, dbg;
     200             :   char *s;
     201             :   long i;
     202      323403 :   cl[1] = arity;
     203      323403 :   gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
     204      323403 :   gel(cl,3) = cgetg(lop,  t_VECSMALL);
     205      323403 :   gel(cl,4) = cgetg(ldat, t_VEC);
     206      323403 :   dbg = cgetg(lop,  t_VECSMALL);
     207      323403 :   frpc = cgetg(lfram,  t_VECSMALL);
     208      323403 :   fram = cgetg(lfram,  t_VEC);
     209      323403 :   gel(cl,5) = mkvec3(dbg, frpc, fram);
     210      323403 :   if (text) gel(cl,6) = text;
     211      323403 :   if (nbmvar) gel(cl,7) = zerovec(nbmvar);
     212      323403 :   s=GSTR(gel(cl,2))-1;
     213    30653667 :   for(i=1;i<lop;i++)
     214             :   {
     215    30330264 :     s[i] = opcode[i+pos->opcode-1];
     216    30330264 :     mael(cl, 3, i) = operand[i+pos->opcode-1];
     217    30330264 :     dbg[i] = dbginfo[i+pos->opcode-1]-dbgstart;
     218    30330264 :     if (dbg[i]<0) dbg[i]+=gap;
     219             :   }
     220      323403 :   s[i]=0;
     221      323403 :   s_opcode.n=pos->opcode;
     222      323403 :   s_operand.n=pos->opcode;
     223      323403 :   s_dbginfo.n=pos->opcode;
     224     2110771 :   for(i=1;i<ldat;i++)
     225     1787368 :     if(data[i+pos->data-1])
     226             :     {
     227     1787368 :       gmael(cl, 4, i) = gcopy(data[i+pos->data-1]);
     228     1787368 :       gunclone(data[i+pos->data-1]);
     229             :     }
     230      323403 :   s_data.n=pos->data;
     231      665169 :   while (s_lvar.n>pos->localvars && !localvars[s_lvar.n-1].inl)
     232       18363 :     s_lvar.n--;
     233      556091 :   for(i=1;i<lfram;i++)
     234             :   {
     235      232688 :     long j=i+pos->frames-1;
     236      232688 :     frpc[i] = frames[j].pc-pos->opcode+1;
     237      232688 :     gel(fram, i) = gcopy(frames[j].frame);
     238      232688 :     gunclone(frames[j].frame);
     239             :   }
     240      323403 :   s_frame.n=pos->frames;
     241      323403 :   offset=pos->offset;
     242      323403 :   dbgstart=pos->dbgstart;
     243      323403 :   return cl;
     244             : }
     245             : 
     246             : static GEN
     247       14157 : getclosure(struct codepos *pos)
     248             : {
     249       14157 :   return getfunction(pos,0,0,NULL,0);
     250             : }
     251             : 
     252             : static void
     253    30328612 : op_push_loc(op_code o, long x, const char *loc)
     254             : {
     255    30328612 :   long n=pari_stack_new(&s_opcode);
     256    30328612 :   long m=pari_stack_new(&s_operand);
     257    30328612 :   long d=pari_stack_new(&s_dbginfo);
     258    30328612 :   opcode[n]=o;
     259    30328612 :   operand[m]=x;
     260    30328612 :   dbginfo[d]=loc;
     261    30328612 : }
     262             : 
     263             : static void
     264    28684348 : op_push(op_code o, long x, long n)
     265             : {
     266    28684348 :   op_push_loc(o,x,tree[n].str);
     267    28684348 : }
     268             : 
     269             : static void
     270        1673 : op_insert_loc(long k, op_code o, long x, const char *loc)
     271             : {
     272             :   long i;
     273        1673 :   long n=pari_stack_new(&s_opcode);
     274        1673 :   (void) pari_stack_new(&s_operand);
     275        1673 :   (void) pari_stack_new(&s_dbginfo);
     276      346746 :   for (i=n-1; i>=k; i--)
     277             :   {
     278      345073 :     opcode[i+1] = opcode[i];
     279      345073 :     operand[i+1]= operand[i];
     280      345073 :     dbginfo[i+1]= dbginfo[i];
     281             :   }
     282        1673 :   opcode[k]  = o;
     283        1673 :   operand[k] = x;
     284        1673 :   dbginfo[k] = loc;
     285        1673 : }
     286             : 
     287             : static long
     288     1787368 : data_push(GEN x)
     289             : {
     290     1787368 :   long n=pari_stack_new(&s_data);
     291     1787368 :   data[n] = x?gclone(x):x;
     292     1787368 :   return n-offset;
     293             : }
     294             : 
     295             : static void
     296       52086 : var_push(entree *ep, Ltype type)
     297             : {
     298       52086 :   long n=pari_stack_new(&s_lvar);
     299       52086 :   localvars[n].ep   = ep;
     300       52086 :   localvars[n].inl  = 0;
     301       52086 :   localvars[n].type = type;
     302       52086 : }
     303             : 
     304             : static void
     305      232688 : frame_push(GEN x)
     306             : {
     307      232688 :   long n=pari_stack_new(&s_frame);
     308      232688 :   frames[n].pc = s_opcode.n-1;
     309      232688 :   frames[n].frame = gclone(x);
     310      232688 : }
     311             : 
     312             : static GEN
     313          35 : pack_localvars(void)
     314             : {
     315          35 :   GEN pack=cgetg(3,t_VEC);
     316          35 :   long i,l=s_lvar.n;
     317          35 :   GEN t=cgetg(1+l,t_VECSMALL);
     318          35 :   GEN e=cgetg(1+l,t_VECSMALL);
     319          35 :   gel(pack,1)=t;
     320          35 :   gel(pack,2)=e;
     321          91 :   for(i=1;i<=l;i++)
     322             :   {
     323          56 :     t[i]=localvars[i-1].type;
     324          56 :     e[i]=(long)localvars[i-1].ep;
     325             :   }
     326          35 :   return pack;
     327             : }
     328             : 
     329             : void
     330         231 : push_frame(GEN C, long lpc, long dummy)
     331             : {
     332         231 :   const char *code=closure_codestr(C);
     333         231 :   GEN oper=closure_get_oper(C);
     334         231 :   GEN dbg=closure_get_dbg(C);
     335         231 :   GEN frpc=gel(dbg,2);
     336         231 :   GEN fram=gel(dbg,3);
     337         231 :   long pc, j=1, lfr = lg(frpc);
     338         231 :   if (lpc==-1)
     339             :   {
     340             :     long k;
     341          49 :     GEN e = gel(fram, 1);
     342          98 :     for(k=1; k<lg(e); k++)
     343          49 :       var_push(dummy?NULL:(entree*)e[k], Lmy);
     344         280 :     return;
     345             :   }
     346         182 :   if (lg(C)<8) while (j<lfr && frpc[j]==0) j++;
     347        1512 :   for(pc=0; pc<lpc; pc++) /* do not assume lpc was completed */
     348             :   {
     349        1330 :     if (pc>0 && (code[pc]==OClocalvar || code[pc]==OClocalvar0))
     350           0 :       var_push((entree*)oper[pc],Llocal);
     351        1330 :     if (j<lfr && pc==frpc[j])
     352             :     {
     353             :       long k;
     354         126 :       GEN e = gel(fram,j);
     355         322 :       for(k=1; k<lg(e); k++)
     356         196 :         var_push(dummy?NULL:(entree*)e[k], Lmy);
     357         126 :       j++;
     358             :     }
     359             :   }
     360             : }
     361             : 
     362             : void
     363           0 : debug_context(void)
     364             : {
     365             :   long i;
     366           0 :   for(i=0;i<s_lvar.n;i++)
     367             :   {
     368           0 :     entree *ep = localvars[i].ep;
     369           0 :     Ltype type = localvars[i].type;
     370           0 :     err_printf("%ld: %s: %s\n",i,(type==Lmy?"my":"local"),(ep?ep->name:"NULL"));
     371             :   }
     372           0 : }
     373             : 
     374             : GEN
     375       10108 : localvars_read_str(const char *x, GEN pack)
     376             : {
     377             :   GEN code;
     378       10108 :   long l=0;
     379       10108 :   if (pack)
     380             :   {
     381       10108 :     GEN t=gel(pack,1);
     382       10108 :     GEN e=gel(pack,2);
     383             :     long i;
     384       10108 :     l=lg(t)-1;
     385       43568 :     for(i=1;i<=l;i++)
     386       33460 :       var_push((entree*)e[i],(Ltype)t[i]);
     387             :   }
     388       10108 :   code = compile_str(x);
     389       10101 :   s_lvar.n -= l;
     390       10101 :   return closure_evalres(code);
     391             : }
     392             : 
     393             : long
     394           7 : localvars_find(GEN pack, entree *ep)
     395             : {
     396           7 :   GEN t=gel(pack,1);
     397           7 :   GEN e=gel(pack,2);
     398             :   long i;
     399           7 :   long vn=0;
     400           7 :   for(i=lg(e)-1;i>=1;i--)
     401             :   {
     402           0 :     if(t[i]==Lmy)
     403           0 :       vn--;
     404           0 :     if(e[i]==(long)ep)
     405           0 :       return t[i]==Lmy?vn:0;
     406             :   }
     407           7 :   return 0;
     408             : }
     409             : 
     410             : /*
     411             :  Flags for copy optimisation:
     412             :  -- Freturn: The result will be returned.
     413             :  -- FLsurvive: The result must survive the closure.
     414             :  -- FLnocopy: The result will never be updated nor part of a user variable.
     415             :  -- FLnocopylex: The result will never be updated nor part of dynamic variable.
     416             : */
     417             : enum FLflag {FLreturn=1, FLsurvive=2, FLnocopy=4, FLnocopylex=8};
     418             : 
     419             : static void
     420      162350 : addcopy(long n, long mode, long flag, long mask)
     421             : {
     422      162350 :   if (mode==Ggen && !(flag&mask))
     423             :   {
     424       17666 :     op_push(OCcopy,0,n);
     425       17666 :     if (!(flag&FLsurvive) && DEBUGLEVEL)
     426           0 :       pari_warn(warner,"compiler generates copy for `%.*s'",
     427           0 :                        tree[n].len,tree[n].str);
     428             :   }
     429      162350 : }
     430             : 
     431             : static void compilenode(long n, int mode, long flag);
     432             : 
     433             : typedef enum {PPend,PPstd,PPdefault,PPdefaultmulti,PPstar,PPauto} PPproto;
     434             : 
     435             : static PPproto
     436    10174549 : parseproto(char const **q, char *c, const char *str)
     437             : {
     438    10174549 :   char  const *p=*q;
     439             :   long i;
     440    10174549 :   switch(*p)
     441             :   {
     442             :   case 0:
     443             :   case '\n':
     444     3999017 :     return PPend;
     445             :   case 'D':
     446      135645 :     switch(p[1])
     447             :     {
     448             :     case 0:
     449           0 :       compile_err("function has incomplete prototype",str);
     450             :     case 'G':
     451             :     case '&':
     452             :     case 'W':
     453             :     case 'V':
     454             :     case 'I':
     455             :     case 'E':
     456             :     case 'J':
     457             :     case 'n':
     458             :     case 'P':
     459             :     case 'r':
     460             :     case 's':
     461       91509 :       *c=p[1];
     462       91509 :       *q=p+2;
     463       91509 :       return PPdefault;
     464             :     default:
     465       44136 :       for(i=0;*p && i<2;p++) i+=*p==',';
     466       44136 :       if (i<2)
     467           0 :         compile_err("function has incomplete prototype",str);
     468       44136 :       *c=p[-2];
     469       44136 :       *q=p;
     470       44136 :       return PPdefaultmulti;
     471             :     }
     472             :     break;
     473             :   case 'C':
     474             :   case 'p':
     475             :   case 'b':
     476             :   case 'P':
     477             :   case 'f':
     478       82216 :     *c=*p;
     479       82216 :     *q=p+1;
     480       82216 :     return PPauto;
     481             :   case '&':
     482         966 :     *c='*';
     483         966 :     *q=p+1;
     484         966 :     return PPstd;
     485             :   case 'V':
     486       13058 :     if (p[1]=='=')
     487             :     {
     488        9566 :       if (p[2]!='G')
     489           0 :         compile_err("function prototype is not supported",str);
     490        9566 :       *c='=';
     491        9566 :       p+=2;
     492             :     }
     493             :     else
     494        3492 :       *c=*p;
     495       13058 :     *q=p+1;
     496       13058 :     return PPstd;
     497             :   case 'E':
     498             :   case 's':
     499       31192 :     if (p[1]=='*')
     500             :     {
     501       19885 :       *c=*p++;
     502       19885 :       *q=p+1;
     503       19885 :       return PPstar;
     504             :     }
     505             :     /*fall through*/
     506             :   }
     507     5923762 :   *c=*p;
     508     5923762 :   *q=p+1;
     509     5923762 :   return PPstd;
     510             : }
     511             : 
     512             : static long
     513      259071 : detag(long n)
     514             : {
     515      518142 :   while (tree[n].f==Ftag)
     516           0 :     n=tree[n].x;
     517      259071 :   return n;
     518             : }
     519             : 
     520             : /* return type for GP functions */
     521             : static op_code
     522     3576516 : get_ret_type(const char **p, long arity, Gtype *t, long *flag)
     523             : {
     524     3576516 :   *flag = 0;
     525     3576516 :   if (**p == 'v') { (*p)++; *t=Gvoid; return OCcallvoid; }
     526     3545801 :   else if (**p == 'i') { (*p)++; *t=Gsmall;  return OCcallint; }
     527     3541482 :   else if (**p == 'l') { (*p)++; *t=Gsmall;  return OCcalllong; }
     528     3522870 :   else if (**p == 'u') { (*p)++; *t=Gusmall; return OCcalllong; }
     529     3522870 :   else if (**p == 'm') { (*p)++; *flag = FLnocopy; }
     530     3522870 :   *t=Ggen; return arity==2?OCcallgen2:OCcallgen;
     531             : }
     532             : 
     533             : /*supported types:
     534             :  * type: Gusmall, Gsmall, Ggen, Gvoid, Gvec, Gclosure
     535             :  * mode: Gusmall, Gsmall, Ggen, Gvar, Gvoid
     536             :  */
     537             : static void
     538     5634704 : compilecast_loc(int type, int mode, const char *loc)
     539             : {
     540    11269401 :   if (type==mode) return;
     541     3850900 :   switch (mode)
     542             :   {
     543             :   case Gusmall:
     544          32 :     if (type==Ggen)        op_push_loc(OCitou,-1,loc);
     545          32 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     546          32 :     else if (type!=Gsmall)
     547           0 :       compile_err("this should be a small integer >=0",loc);
     548          32 :     break;
     549             :   case Gsmall:
     550        3598 :     if (type==Ggen)        op_push_loc(OCitos,-1,loc);
     551           0 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     552           0 :     else if (type!=Gusmall)
     553           0 :       compile_err("this should be a small integer",loc);
     554        3598 :     break;
     555             :   case Ggen:
     556     3837336 :     if (type==Gsmall)      op_push_loc(OCstoi,0,loc);
     557     3827369 :     else if (type==Gusmall)op_push_loc(OCutoi,0,loc);
     558     3827369 :     else if (type==Gvoid)  op_push_loc(OCpushgnil,0,loc);
     559     3837336 :     break;
     560             :   case Gvoid:
     561        7372 :     op_push_loc(OCpop, 1,loc);
     562        7372 :     break;
     563             :   case Gvar:
     564        2562 :     if (type==Ggen)        op_push_loc(OCvarn,-1,loc);
     565           7 :     else compile_varerr(loc);
     566        2555 :      break;
     567             :   default:
     568           0 :     pari_err_BUG("compilecast [unknown type]");
     569             :   }
     570             : }
     571             : 
     572             : static void
     573     5417972 : compilecast(long n, int type, int mode) { compilecast_loc(type, mode, tree[n].str); }
     574             : 
     575             : static entree *
     576       20741 : fetch_member_raw(const char *s, long len)
     577             : {
     578       20741 :   pari_sp av = avma;
     579       20741 :   char *t = stack_malloc(len+2);
     580             :   entree *ep;
     581       20741 :   t[0] = '_'; strncpy(t+1, s, len); t[++len] = 0; /* prepend '_' */
     582       20741 :   ep = fetch_entry_raw(t, len);
     583       20741 :   avma = av; return ep;
     584             : }
     585             : static entree *
     586     5598240 : getfunc(long n)
     587             : {
     588     5598240 :   long x=tree[n].x;
     589     5598240 :   if (tree[x].x==CSTmember) /* str-1 points to '.' */
     590       20741 :     return do_alias(fetch_member_raw(tree[x].str - 1, tree[x].len + 1));
     591             :   else
     592     5577499 :     return do_alias(fetch_entry_raw(tree[x].str, tree[x].len));
     593             : }
     594             : 
     595             : static entree *
     596      219019 : getentry(long n)
     597             : {
     598      219019 :   n = detag(n);
     599      219019 :   if (tree[n].f!=Fentry)
     600             :   {
     601           7 :     if (tree[n].f==Fseq)
     602           0 :       compile_err("unexpected character: ';'", tree[tree[n].y].str-1);
     603           7 :     compile_varerr(tree[n].str);
     604             :   }
     605      219012 :   return getfunc(n);
     606             : }
     607             : 
     608             : /* match Fentry that are not actually EpSTATIC functions called without parens*/
     609             : static entree *
     610       49963 : getvar(long n)
     611             : {
     612       49963 :   entree *ep = getentry(n);
     613       49956 :   if (EpSTATIC(do_alias(ep)))
     614           0 :     compile_varerr(tree[n].str);
     615       49956 :   return ep;
     616             : }
     617             : 
     618             : static long
     619      215357 : getmvar(entree *ep)
     620             : {
     621             :   long i;
     622      215357 :   long vn=0;
     623      567358 :   for(i=s_lvar.n-1;i>=0;i--)
     624             :   {
     625      408399 :     if(localvars[i].type==Lmy)
     626      408189 :       vn--;
     627      408399 :     if(localvars[i].ep==ep)
     628       56398 :       return localvars[i].type==Lmy?vn:0;
     629             :   }
     630      158959 :   return 0;
     631             : }
     632             : 
     633             : static long
     634        7388 : ctxmvar(void)
     635             : {
     636        7388 :   pari_sp av=avma;
     637        7388 :   long i, n=0;
     638             :   GEN ctx;
     639       69892 :   for(i=s_lvar.n-1;i>=0;i--)
     640       62504 :     if(localvars[i].type==Lmy)
     641       62504 :       n++;
     642        7388 :   if (n==0) return 0;
     643        3865 :   ctx = cgetg(n+1,t_VECSMALL);
     644       66369 :   for(n=0, i=0; i<s_lvar.n; i++)
     645       62504 :     if(localvars[i].type==Lmy)
     646       62504 :       ctx[++n]=(long)localvars[i].ep;
     647        3865 :   frame_push(ctx);
     648        3865 :   avma=av; return n;
     649             : }
     650             : 
     651             : INLINE int
     652    24061823 : is_func_named(entree *ep, const char *s)
     653             : {
     654    24061823 :   return !strcmp(ep->name, s);
     655             : }
     656             : 
     657             : INLINE int
     658        2583 : is_node_zero(long n)
     659             : {
     660        2583 :   n = detag(n);
     661        2583 :   return (tree[n].f==Fsmall && tree[n].x==0);
     662             : }
     663             : 
     664             : static void
     665          39 : str_defproto(const char *p, const char *q, const char *loc)
     666             : {
     667          39 :   long len = p-4-q;
     668          39 :   if (q[1]!='"' || q[len]!='"')
     669           0 :     compile_err("default argument must be a string",loc);
     670          39 :   op_push_loc(OCpushgen,data_push(strntoGENexp(q+1,len)),loc);
     671          39 : }
     672             : 
     673             : static long
     674    13101079 : countlisttogen(long n, Ffunc f)
     675             : {
     676             :   long x,i;
     677    13101079 :   if (n==-1 || tree[n].f==Fnoarg) return 0;
     678    12006627 :   for(x=n, i=0; tree[x].f==f ;x=tree[x].x, i++);
     679    12006627 :   return i+1;
     680             : }
     681             : 
     682             : static GEN
     683    13100869 : listtogen(long n, Ffunc f)
     684             : {
     685    13100869 :   long x,i,nb = countlisttogen(n, f);
     686    13100869 :   GEN z=cgetg(nb+1, t_VECSMALL);
     687    13100869 :   if (nb)
     688             :   {
     689    12006417 :     for (x=n, i = nb-1; i>0; z[i+1]=tree[x].y, x=tree[x].x, i--);
     690    12006417 :     z[1]=x;
     691             :   }
     692    13100869 :   return z;
     693             : }
     694             : 
     695             : static long
     696     5392716 : first_safe_arg(GEN arg, long mask)
     697             : {
     698     5392716 :   long lnc, l=lg(arg);
     699     5392716 :   for (lnc=l-1; lnc>0 && (tree[arg[lnc]].flags&mask)==mask; lnc--);
     700     5392716 :   return lnc;
     701             : }
     702             : 
     703             : static void
     704       13564 : checkdups(GEN arg, GEN vep)
     705             : {
     706       13564 :   long l=vecsmall_duplicate(vep);
     707       13564 :   if (l!=0) compile_err("variable declared twice",tree[arg[l]].str);
     708       13564 : }
     709             : 
     710             : enum {MAT_range,MAT_std,MAT_line,MAT_column,VEC_std};
     711             : 
     712             : static int
     713        9593 : matindex_type(long n)
     714             : {
     715        9593 :   long x = tree[n].x, y = tree[n].y;
     716        9593 :   long fxx = tree[tree[x].x].f, fxy = tree[tree[x].y].f;
     717        9593 :   if (y==-1)
     718             :   {
     719        8438 :     if (fxy!=Fnorange) return MAT_range;
     720        8193 :     if (fxx==Fnorange) compile_err("missing index",tree[n].str);
     721        8193 :     return VEC_std;
     722             :   }
     723             :   else
     724             :   {
     725        1155 :     long fyx = tree[tree[y].x].f, fyy = tree[tree[y].y].f;
     726        1155 :     if (fxy!=Fnorange || fyy!=Fnorange) return MAT_range;
     727        1008 :     if (fxx==Fnorange && fyx==Fnorange)
     728           0 :       compile_err("missing index",tree[n].str);
     729        1008 :     if (fxx==Fnorange) return MAT_column;
     730         539 :     if (fyx==Fnorange) return MAT_line;
     731         343 :     return MAT_std;
     732             :   }
     733             : }
     734             : 
     735             : static entree *
     736       28299 : getlvalue(long n)
     737             : {
     738       57151 :   while ((tree[n].f==Fmatcoeff && matindex_type(tree[n].y)!=MAT_range) || tree[n].f==Ftag)
     739         553 :     n=tree[n].x;
     740       28299 :   return getvar(n);
     741             : }
     742             : 
     743             : INLINE void
     744       26444 : compilestore(long vn, entree *ep, long n)
     745             : {
     746       26444 :   if (vn)
     747        3189 :     op_push(OCstorelex,vn,n);
     748             :   else
     749       23255 :     op_push(OCstoredyn,(long)ep,n);
     750       26444 : }
     751             : 
     752             : INLINE void
     753         490 : compilenewptr(long vn, entree *ep, long n)
     754             : {
     755         490 :   if (vn)
     756         133 :     op_push(OCnewptrlex,vn,n);
     757             :   else
     758         357 :     op_push(OCnewptrdyn,(long)ep,n);
     759         490 : }
     760             : 
     761             : static void
     762        1043 : compilelvalue(long n)
     763             : {
     764        1043 :   n = detag(n);
     765        1043 :   if (tree[n].f==Fentry)
     766         490 :     return;
     767             :   else
     768             :   {
     769         553 :     long x = tree[n].x, y = tree[n].y;
     770         553 :     long yx = tree[y].x, yy = tree[y].y;
     771         553 :     long m = matindex_type(y);
     772         553 :     if (m == MAT_range)
     773           0 :       compile_err("not an lvalue",tree[n].str);
     774         553 :     if (m == VEC_std && tree[x].f==Fmatcoeff)
     775             :     {
     776          49 :       int mx = matindex_type(tree[x].y);
     777          49 :       if (mx==MAT_line)
     778             :       {
     779           0 :         int xy = tree[x].y, xyx = tree[xy].x;
     780           0 :         compilelvalue(tree[x].x);
     781           0 :         compilenode(tree[xyx].x,Gsmall,0);
     782           0 :         compilenode(tree[yx].x,Gsmall,0);
     783           0 :         op_push(OCcompo2ptr,0,y);
     784           0 :         return;
     785             :       }
     786             :     }
     787         553 :     compilelvalue(x);
     788         553 :     switch(m)
     789             :     {
     790             :     case VEC_std:
     791         308 :       compilenode(tree[yx].x,Gsmall,0);
     792         308 :       op_push(OCcompo1ptr,0,y);
     793         308 :       break;
     794             :     case MAT_std:
     795          91 :       compilenode(tree[yx].x,Gsmall,0);
     796          91 :       compilenode(tree[yy].x,Gsmall,0);
     797          91 :       op_push(OCcompo2ptr,0,y);
     798          91 :       break;
     799             :     case MAT_line:
     800          77 :       compilenode(tree[yx].x,Gsmall,0);
     801          77 :       op_push(OCcompoLptr,0,y);
     802          77 :       break;
     803             :     case MAT_column:
     804          77 :       compilenode(tree[yy].x,Gsmall,0);
     805          77 :       op_push(OCcompoCptr,0,y);
     806          77 :       break;
     807             :     }
     808             :   }
     809             : }
     810             : 
     811             : static void
     812        8438 : compilematcoeff(long n, int mode)
     813             : {
     814        8438 :   long x=tree[n].x, y=tree[n].y;
     815        8438 :   long yx=tree[y].x, yy=tree[y].y;
     816        8438 :   long m=matindex_type(y);
     817        8438 :   compilenode(x,Ggen,FLnocopy);
     818        8438 :   switch(m)
     819             :   {
     820             :   case VEC_std:
     821        7528 :     compilenode(tree[yx].x,Gsmall,0);
     822        7528 :     op_push(OCcompo1,mode,y);
     823        7528 :     return;
     824             :   case MAT_std:
     825         161 :     compilenode(tree[yx].x,Gsmall,0);
     826         161 :     compilenode(tree[yy].x,Gsmall,0);
     827         161 :     op_push(OCcompo2,mode,y);
     828         161 :     return;
     829             :   case MAT_line:
     830          42 :     compilenode(tree[yx].x,Gsmall,0);
     831          42 :     op_push(OCcompoL,0,y);
     832          42 :     compilecast(n,Gvec,mode);
     833          42 :     return;
     834             :   case MAT_column:
     835         315 :     compilenode(tree[yy].x,Gsmall,0);
     836         315 :     op_push(OCcompoC,0,y);
     837         315 :     compilecast(n,Gvec,mode);
     838         315 :     return;
     839             :   case MAT_range:
     840         392 :     compilenode(tree[yx].x,Gsmall,0);
     841         392 :     compilenode(tree[yx].y,Gsmall,0);
     842         392 :     if (yy==-1)
     843         245 :       op_push(OCcallgen,(long)is_entry("_[_.._]"),n);
     844             :     else
     845             :     {
     846         147 :       compilenode(tree[yy].x,Gsmall,0);
     847         147 :       compilenode(tree[yy].y,Gsmall,0);
     848         147 :       op_push(OCcallgen,(long)is_entry("_[_.._,_.._]"),n);
     849             :     }
     850         392 :     return;
     851             :   default:
     852           0 :     pari_err_BUG("compilematcoeff");
     853             :   }
     854             : }
     855             : 
     856             : static void
     857     6811684 : compilesmall(long n, long x, long mode)
     858             : {
     859     6811684 :   if (mode==Ggen)
     860     6752421 :     op_push(OCpushstoi, x, n);
     861             :   else
     862             :   {
     863       59263 :     if (mode==Gusmall && x < 0)
     864           0 :       compile_err("this should be a small integer >=0",tree[n].str);
     865       59263 :     op_push(OCpushlong, x, n);
     866       59263 :     compilecast(n,Gsmall,mode);
     867             :   }
     868     6811677 : }
     869             : 
     870             : static void
     871     3802431 : compilevec(long n, long mode, op_code op)
     872             : {
     873     3802431 :   pari_sp ltop=avma;
     874     3802431 :   long x=tree[n].x;
     875             :   long i;
     876     3802431 :   GEN arg=listtogen(x,Fmatrixelts);
     877     3802431 :   long l=lg(arg);
     878     3802431 :   op_push(op,l,n);
     879    15711259 :   for (i=1;i<l;i++)
     880             :   {
     881    11908828 :     compilenode(arg[i],Ggen,FLsurvive);
     882    11908828 :     op_push(OCstackgen,i,n);
     883             :   }
     884     3802431 :   avma=ltop;
     885     3802431 :   op_push(OCpop,1,n);
     886     3802431 :   compilecast(n,Gvec,mode);
     887     3802431 : }
     888             : 
     889             : static void
     890        7756 : compilemat(long n, long mode)
     891             : {
     892        7756 :   pari_sp ltop=avma;
     893        7756 :   long x=tree[n].x;
     894             :   long i,j;
     895        7756 :   GEN line=listtogen(x,Fmatrixlines);
     896        7756 :   long lglin = lg(line), lgcol=0;
     897        7756 :   op_push(OCpushlong, lglin,n);
     898        7756 :   if (lglin==1)
     899         714 :     op_push(OCmat,1,n);
     900       40418 :   for(i=1;i<lglin;i++)
     901             :   {
     902       32662 :     GEN col=listtogen(line[i],Fmatrixelts);
     903       32662 :     long l=lg(col), k;
     904       32662 :     if (i==1)
     905             :     {
     906        7042 :       lgcol=l;
     907        7042 :       op_push(OCmat,lgcol,n);
     908             :     }
     909       25620 :     else if (l!=lgcol)
     910           0 :       compile_err("matrix must be rectangular",tree[line[i]].str);
     911       32662 :     k=i;
     912      217042 :     for(j=1;j<lgcol;j++)
     913             :     {
     914      184380 :       k-=lglin;
     915      184380 :       compilenode(col[j], Ggen, FLsurvive);
     916      184380 :       op_push(OCstackgen,k,n);
     917             :     }
     918             :   }
     919        7756 :   avma=ltop;
     920        7756 :   op_push(OCpop,1,n);
     921        7756 :   compilecast(n,Gvec,mode);
     922        7756 : }
     923             : 
     924             : 
     925             : static GEN
     926       33926 : cattovec(long n, long fnum)
     927             : {
     928       33926 :   long x=n, y, i=0, nb;
     929             :   GEN stack;
     930       33926 :   if (tree[n].f==Fnoarg) return cgetg(1,t_VECSMALL);
     931             :   while(1)
     932             :   {
     933       34264 :     long xx=tree[x].x;
     934       34264 :     long xy=tree[x].y;
     935       34264 :     if (tree[x].f!=Ffunction || xx!=fnum) break;
     936         338 :     x=tree[xy].x;
     937         338 :     y=tree[xy].y;
     938         338 :     if (tree[y].f==Fnoarg)
     939           0 :       compile_err("unexpected character: ", tree[y].str);
     940         338 :     i++;
     941         338 :   }
     942       33926 :   if (tree[x].f==Fnoarg)
     943           0 :     compile_err("unexpected character: ", tree[x].str);
     944       33926 :   nb=i+1;
     945       33926 :   stack=cgetg(nb+1,t_VECSMALL);
     946       34264 :   for(x=n;i>0;i--)
     947             :   {
     948         338 :     long y=tree[x].y;
     949         338 :     x=tree[y].x;
     950         338 :     stack[i+1]=tree[y].y;
     951             :   }
     952       33926 :   stack[1]=x;
     953       33926 :   return stack;
     954             : }
     955             : 
     956             : static GEN
     957          66 : compilelambda(long n, long y, GEN vep, struct codepos *pos)
     958             : {
     959          66 :   long nbmvar, lev = vep ? lg(vep)-1 : 0;
     960          66 :   GEN text=cgetg(3,t_VEC);
     961          66 :   gel(text,1)=strtoGENstr(lev? ((entree*) vep[1])->name: "");
     962          66 :   gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
     963          66 :   nbmvar=ctxmvar()-lev;
     964          66 :   if (lev) op_push(OCgetargs,lev,n);
     965          66 :   compilenode(y,Ggen,FLsurvive|FLreturn);
     966          66 :   return getfunction(pos,lev,nbmvar,text,2);
     967             : }
     968             : 
     969             : static void
     970       18261 : compilecall(long n, int mode, entree *ep)
     971             : {
     972       18261 :   pari_sp ltop=avma;
     973             :   long j;
     974       18261 :   long x=tree[n].x;
     975       18261 :   long y=tree[n].y;
     976       18261 :   GEN arg=listtogen(y,Flistarg);
     977       18261 :   long nb=lg(arg)-1;
     978       18261 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
     979       18261 :   long lnl=first_safe_arg(arg, COsafelex);
     980       18261 :   long fl = lnl==0? (lnc==0? FLnocopy: FLnocopylex): 0;
     981       18261 :   if (ep==NULL)
     982         259 :     compilenode(x, Ggen, fl);
     983             :   else
     984             :   {
     985       18002 :     long vn=getmvar(ep);
     986       18002 :     if (vn)
     987         415 :       op_push(OCpushlex,vn,n);
     988             :     else
     989       17587 :       op_push(OCpushdyn,(long)ep,n);
     990             :   }
     991       48595 :   for (j=1;j<=nb;j++)
     992             :   {
     993       30334 :     long x = tree[arg[j]].x, f = tree[arg[j]].f;
     994       30334 :     if (f==Fseq)
     995           0 :       compile_err("unexpected ';'", tree[x].str+tree[x].len);
     996       30334 :     else if (f!=Fnoarg)
     997       30187 :       compilenode(arg[j], Ggen,j>=lnl?FLnocopylex:0);
     998             :     else
     999         147 :       op_push(OCpushlong,0,n);
    1000             :   }
    1001       18261 :   op_push(OCcalluser,nb,x);
    1002       18261 :   compilecast(n,Ggen,mode);
    1003       18261 :   avma=ltop;
    1004       18261 : }
    1005             : 
    1006             : static GEN
    1007       14160 : compilefuncinline(long n, long c, long a, long flag, long isif, long lev, long *ev)
    1008             : {
    1009             :   struct codepos pos;
    1010       14160 :   int type=c=='I'?Gvoid:Ggen;
    1011       14160 :   long rflag=c=='I'?0:FLsurvive;
    1012       14160 :   GEN vep = NULL;
    1013       14160 :   if (isif && (flag&FLreturn)) rflag|=FLreturn;
    1014       14160 :   getcodepos(&pos);
    1015       14160 :   if (lev)
    1016             :   {
    1017             :     long i;
    1018        8064 :     GEN varg=cgetg(lev+1,t_VECSMALL);
    1019        8064 :     vep=cgetg(lev+1,t_VECSMALL);
    1020       16457 :     for(i=0;i<lev;i++)
    1021             :     {
    1022             :       entree *ve;
    1023        8393 :       if (ev[i]<0)
    1024           0 :         compile_err("missing variable name", tree[a].str-1);
    1025        8393 :       ve = getvar(ev[i]);
    1026        8393 :       vep[i+1]=(long)ve;
    1027        8393 :       varg[i+1]=ev[i];
    1028        8393 :       var_push(ve,Lmy);
    1029             :     }
    1030        8064 :     checkdups(varg,vep);
    1031        8064 :     frame_push(vep);
    1032             :   }
    1033       14160 :   if (c=='J')
    1034          66 :     return compilelambda(n,a,vep,&pos);
    1035       14094 :   else if (tree[a].f==Fnoarg)
    1036         120 :     compilecast(a,Gvoid,type);
    1037             :   else
    1038       13974 :     compilenode(a,type,rflag);
    1039       14094 :   return getclosure(&pos);
    1040             : }
    1041             : 
    1042             : static long
    1043        2122 : countvar(GEN arg)
    1044             : {
    1045        2122 :   long i, l = lg(arg);
    1046        2122 :   long n = l-1;
    1047        6508 :   for(i=1; i<l; i++)
    1048             :   {
    1049        4386 :     long a=arg[i];
    1050        4386 :     if (tree[a].f==Fassign)
    1051             :     {
    1052        2478 :       long x = detag(tree[a].x);
    1053        2478 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1054         210 :         n += countlisttogen(tree[x].x,Fmatrixelts)-1;
    1055             :     }
    1056             :   }
    1057        2122 :   return n;
    1058             : }
    1059             : 
    1060             : static void
    1061          12 : compileuninline(GEN arg)
    1062             : {
    1063             :   long j;
    1064          12 :   if (lg(arg) > 1)
    1065           0 :     compile_err("too many arguments",tree[arg[1]].str);
    1066          30 :   for(j=0; j<s_lvar.n; j++)
    1067          18 :     if(!localvars[j].inl)
    1068           0 :       pari_err(e_MISC,"uninline is only valid at top level");
    1069          12 :   s_lvar.n = 0;
    1070          12 : }
    1071             : 
    1072             : static void
    1073        2115 : compilemy(GEN arg, const char *str, int inl)
    1074             : {
    1075        2115 :   long i, j, k, l = lg(arg);
    1076        2115 :   long n = countvar(arg);
    1077        2115 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1078        2115 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1079        2115 :   if (inl)
    1080             :   {
    1081          12 :     for(j=0; j<s_lvar.n; j++)
    1082           0 :       if(!localvars[j].inl)
    1083           0 :         pari_err(e_MISC,"inline is only valid at top level");
    1084             :   }
    1085        6466 :   for(k=0, i=1; i<l; i++)
    1086             :   {
    1087        4351 :     long a=arg[i];
    1088        4351 :     if (tree[a].f==Fassign)
    1089             :     {
    1090        2450 :       long x = detag(tree[a].x);
    1091        2450 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1092             :       {
    1093         203 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1094         203 :         long nv = lg(vars)-1;
    1095         665 :         for (j=1; j<=nv; j++)
    1096             :         {
    1097         462 :           ver[++k] = vars[j];
    1098         462 :           vep[k] = (long)getvar(ver[k]);
    1099             :         }
    1100         203 :         continue;
    1101        2247 :       } else ver[++k] = x;
    1102        1901 :     } else ver[++k] = a;
    1103        4148 :     vep[k] = (long)getvar(ver[k]);
    1104             :   }
    1105        2115 :   checkdups(ver,vep);
    1106        2115 :   for(i=1; i<=n; i++) var_push(NULL,Lmy);
    1107        2115 :   op_push_loc(OCnewframe,inl?-n:n,str);
    1108        2115 :   frame_push(vep);
    1109        6466 :   for (k=0, i=1; i<l; i++)
    1110             :   {
    1111        4351 :     long a=arg[i];
    1112        4351 :     if (tree[a].f==Fassign)
    1113             :     {
    1114        2450 :       long x = detag(tree[a].x);
    1115        2450 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1116             :       {
    1117         203 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1118         203 :         long nv = lg(vars)-1;
    1119         203 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1120         203 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1121         665 :         for (j=1; j<=nv; j++)
    1122             :         {
    1123         462 :           long v = detag(vars[j]);
    1124         462 :           op_push(OCpushlong,j,v);
    1125         462 :           op_push(OCcompo1,Ggen,v);
    1126         462 :           k++;
    1127         462 :           op_push(OCstorelex,-n+k-1,a);
    1128         462 :           localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1129         462 :           localvars[s_lvar.n-n+k-1].inl=inl;
    1130             :         }
    1131         203 :         continue;
    1132             :       }
    1133        2247 :       else if (!is_node_zero(tree[a].y))
    1134             :       {
    1135        2184 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1136        2184 :         op_push(OCstorelex,-n+k,a);
    1137             :       }
    1138             :     }
    1139        4148 :     k++;
    1140        4148 :     localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1141        4148 :     localvars[s_lvar.n-n+k-1].inl=inl;
    1142             :   }
    1143        2115 : }
    1144             : 
    1145             : static long
    1146          42 : localpush(op_code op, long a)
    1147             : {
    1148          42 :   entree *ep = getvar(a);
    1149          42 :   long vep  = (long) ep;
    1150          42 :   op_push(op,vep,a);
    1151          42 :   var_push(ep,Llocal);
    1152          42 :   return vep;
    1153             : }
    1154             : 
    1155             : static void
    1156           7 : compilelocal(GEN arg)
    1157             : {
    1158           7 :   long i, j, k, l = lg(arg);
    1159           7 :   long n = countvar(arg);
    1160           7 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1161           7 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1162          42 :   for(k=0, i=1; i<l; i++)
    1163             :   {
    1164          35 :     long a=arg[i];
    1165          35 :     if (tree[a].f==Fassign)
    1166             :     {
    1167          28 :       long x = detag(tree[a].x);
    1168          28 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1169             :       {
    1170           7 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1171           7 :         long nv = lg(vars)-1;
    1172           7 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1173           7 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1174          21 :         for (j=1; j<=nv; j++)
    1175             :         {
    1176          14 :           long v = detag(vars[j]);
    1177          14 :           op_push(OCpushlong,j,v);
    1178          14 :           op_push(OCcompo1,Ggen,v);
    1179          14 :           vep[++k] = localpush(OClocalvar, v);
    1180          14 :           ver[k] = v;
    1181             :         }
    1182           7 :         continue;
    1183          21 :       } else if (!is_node_zero(tree[a].y))
    1184             :       {
    1185          14 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1186          14 :         ver[++k] = x;
    1187          14 :         vep[k] = localpush(OClocalvar, ver[k]);
    1188          14 :         continue;
    1189             :       }
    1190             :       else
    1191           7 :         ver[++k] = x;
    1192             :     } else
    1193           7 :       ver[++k] = a;
    1194          14 :     vep[k] = localpush(OClocalvar0, ver[k]);
    1195             :   }
    1196           7 :   checkdups(ver,vep);
    1197           7 : }
    1198             : 
    1199             : static void
    1200     2675626 : compilefunc(entree *ep, long n, int mode, long flag)
    1201             : {
    1202     2675626 :   pari_sp ltop=avma;
    1203             :   long j;
    1204     2675626 :   long x=tree[n].x, y=tree[n].y;
    1205             :   op_code ret_op;
    1206             :   long ret_flag;
    1207             :   Gtype ret_typ;
    1208             :   char const *p,*q;
    1209             :   char c;
    1210     2675626 :   const char *flags = NULL;
    1211             :   const char *str;
    1212             :   PPproto mod;
    1213     2675626 :   GEN arg=listtogen(y,Flistarg);
    1214     2675626 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
    1215     2675626 :   long lnl=first_safe_arg(arg, COsafelex);
    1216     2675626 :   long nbpointers=0, nbopcodes;
    1217     2675626 :   long nb=lg(arg)-1, lev=0;
    1218             :   long ev[20];
    1219     2675626 :   if (x>=OPnboperator)
    1220      123471 :     str=tree[x].str;
    1221             :   else
    1222             :   {
    1223     2552155 :     if (nb==2)
    1224      251316 :       str=tree[arg[1]].str+tree[arg[1]].len;
    1225     2300839 :     else if (nb==1)
    1226     2300174 :       str=tree[arg[1]].str;
    1227             :     else
    1228         665 :       str=tree[n].str;
    1229     2552155 :     while(*str==')') str++;
    1230             :   }
    1231     2675626 :   if (tree[n].f==Fassign)
    1232             :   {
    1233           0 :     nb=2; lnc=2; lnl=2; arg=mkvecsmall2(x,y);
    1234             :   }
    1235     2675626 :   else if (is_func_named(ep,"if"))
    1236             :   {
    1237        3283 :     if (nb>=4)
    1238          91 :       ep=is_entry("_multi_if");
    1239        3192 :     else if (mode==Gvoid)
    1240        1937 :       ep=is_entry("_void_if");
    1241             :   }
    1242     2672343 :   else if (is_func_named(ep,"return") && (flag&FLreturn) && nb<=1)
    1243             :   {
    1244          84 :     if (nb==0) op_push(OCpushgnil,0,n);
    1245          84 :     else compilenode(arg[1],Ggen,FLsurvive|FLreturn);
    1246          84 :     avma=ltop;
    1247     1991889 :     return;
    1248             :   }
    1249     2672259 :   else if (is_func_named(ep,"inline"))
    1250             :   {
    1251          12 :     compilemy(arg, str, 1);
    1252          12 :     compilecast(n,Gvoid,mode);
    1253          12 :     avma=ltop;
    1254          12 :     return;
    1255             :   }
    1256     2672247 :   else if (is_func_named(ep,"uninline"))
    1257             :   {
    1258          12 :     compileuninline(arg);
    1259          12 :     compilecast(n,Gvoid,mode);
    1260          12 :     avma=ltop;
    1261          12 :     return;
    1262             :   }
    1263     2672235 :   else if (is_func_named(ep,"my"))
    1264             :   {
    1265        2103 :     compilemy(arg, str, 0);
    1266        2103 :     compilecast(n,Gvoid,mode);
    1267        2103 :     avma=ltop;
    1268        2103 :     return;
    1269             :   }
    1270     2670132 :   else if (is_func_named(ep,"local"))
    1271             :   {
    1272           7 :     compilelocal(arg);
    1273           7 :     compilecast(n,Gvoid,mode);
    1274           7 :     avma=ltop;
    1275           7 :     return;
    1276             :   }
    1277             :   /*We generate dummy code for global() for compatibility with gp2c*/
    1278     2670125 :   else if (is_func_named(ep,"global"))
    1279             :   {
    1280             :     long i;
    1281           0 :     for (i=1;i<=nb;i++)
    1282             :     {
    1283           0 :       long a=arg[i];
    1284             :       long en;
    1285           0 :       if (tree[a].f==Fassign)
    1286             :       {
    1287           0 :         compilenode(tree[a].y,Ggen,0);
    1288           0 :         a=tree[a].x;
    1289           0 :         en=(long)getvar(a);
    1290           0 :         op_push(OCstoredyn,en,a);
    1291             :       }
    1292             :       else
    1293             :       {
    1294           0 :         en=(long)getvar(a);
    1295           0 :         op_push(OCpushdyn,en,a);
    1296           0 :         op_push(OCpop,1,a);
    1297             :       }
    1298             :     }
    1299           0 :     compilecast(n,Gvoid,mode);
    1300           0 :     avma=ltop;
    1301           0 :     return;
    1302             :   }
    1303     2670125 :   else if (is_func_named(ep,"O"))
    1304             :   {
    1305        3199 :     if (nb!=1)
    1306           0 :       compile_err("wrong number of arguments", tree[n].str+tree[n].len-1);
    1307        3199 :     ep=is_entry("O(_^_)");
    1308        3199 :     if (tree[arg[1]].f==Ffunction && tree[arg[1]].x==OPpow)
    1309             :     {
    1310        2471 :       arg = listtogen(tree[arg[1]].y,Flistarg);
    1311        2471 :       nb  = lg(arg)-1;
    1312        2471 :       lnc = first_safe_arg(arg,COsafelex|COsafedyn);
    1313        2471 :       lnl = first_safe_arg(arg,COsafelex);
    1314             :     }
    1315             :   }
    1316     2666926 :   else if (x==OPn && tree[y].f==Fsmall)
    1317             :   {
    1318     1987186 :     avma=ltop;
    1319     1987186 :     compilesmall(y, -tree[y].x, mode);
    1320     1987186 :     return;
    1321             :   }
    1322      679740 :   else if (x==OPtrans && tree[y].f==Fvec)
    1323             :   {
    1324        2401 :     avma=ltop;
    1325        2401 :     compilevec(y, mode, OCcol);
    1326        2401 :     return;
    1327             :   }
    1328      677339 :   else if (x==OPpow && nb==2 && tree[arg[2]].f==Fsmall)
    1329       38622 :     ep=is_entry("_^s");
    1330      638717 :   else if (x==OPcat)
    1331           0 :     compile_err("expected character: ',' or ')' instead of",
    1332           0 :         tree[arg[1]].str+tree[arg[1]].len);
    1333      683821 :   p=ep->code;
    1334      683821 :   if (!ep->value)
    1335           0 :     compile_err("unknown function",tree[n].str);
    1336      683821 :   nbopcodes = s_opcode.n;
    1337      683821 :   ret_op = get_ret_type(&p, ep->arity, &ret_typ, &ret_flag);
    1338      683821 :   j=1;
    1339      683821 :   if (*p)
    1340             :   {
    1341      677872 :     q=p;
    1342     2426115 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    1343             :     {
    1344     1070385 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    1345     1012634 :           && (mod==PPdefault || mod==PPdefaultmulti))
    1346       30663 :         mod=PPstd;
    1347     1070385 :       switch(mod)
    1348             :       {
    1349             :       case PPstd:
    1350     1003015 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    1351     1003015 :         if (c!='I' && c!='E' && c!='J')
    1352             :         {
    1353      989219 :           long x = tree[arg[j]].x, f = tree[arg[j]].f;
    1354      989219 :           if (f==Fnoarg)
    1355           0 :             compile_err("missing mandatory argument", tree[arg[j]].str);
    1356      989219 :           if (f==Fseq)
    1357           0 :             compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1358             :         }
    1359     1003015 :         switch(c)
    1360             :         {
    1361             :         case 'G':
    1362      920072 :           compilenode(arg[j],Ggen,j>=lnl?(j>=lnc?FLnocopy:FLnocopylex):0);
    1363      920072 :           j++;
    1364      920072 :           break;
    1365             :         case 'W':
    1366             :           {
    1367         154 :             long a = arg[j];
    1368         154 :             entree *ep = getlvalue(a);
    1369         154 :             long vn = getmvar(ep);
    1370         154 :             if (vn) op_push(OCcowvarlex, vn, a);
    1371         126 :             else op_push(OCcowvardyn, (long)ep, a);
    1372         154 :             compilenode(arg[j++],Ggen,FLnocopy);
    1373         154 :             break;
    1374             :           }
    1375             :         case 'M':
    1376          28 :           if (tree[arg[j]].f!=Fsmall)
    1377             :           {
    1378          28 :             if (!flags) flags = ep->code;
    1379          28 :             flags = strchr(flags, '\n'); /* Skip to the following '\n' */
    1380          28 :             if (!flags)
    1381           0 :               compile_err("missing flag in string function signature",
    1382           0 :                            tree[n].str);
    1383          28 :             flags++;
    1384          28 :             if (tree[arg[j]].f==Fconst && tree[arg[j]].x==CSTstr)
    1385          28 :             {
    1386          28 :               GEN str=strntoGENexp(tree[arg[j]].str,tree[arg[j]].len);
    1387          28 :               op_push(OCpushlong, eval_mnemonic(str, flags),n);
    1388          28 :               j++;
    1389             :             } else
    1390             :             {
    1391           0 :               compilenode(arg[j++],Ggen,0);
    1392           0 :               op_push(OCpushlong,(long)flags,n);
    1393           0 :               op_push(OCcallgen2,(long)is_entry("_eval_mnemonic"),n);
    1394             :             }
    1395          28 :             break;
    1396             :           }
    1397             :         case 'P': case 'L':
    1398       53144 :           compilenode(arg[j++],Gsmall,0);
    1399       53144 :           break;
    1400             :         case 'U':
    1401          32 :           compilenode(arg[j++],Gusmall,0);
    1402          32 :           break;
    1403             :         case 'n':
    1404        2562 :           compilenode(arg[j++],Gvar,0);
    1405        2555 :           break;
    1406             :         case '&': case '*':
    1407             :           {
    1408        1309 :             long vn, a=arg[j++];
    1409             :             entree *ep;
    1410        1309 :             if (c=='&')
    1411             :             {
    1412         826 :               if (tree[a].f!=Frefarg)
    1413           0 :                 compile_err("expected character: '&'", tree[a].str);
    1414         826 :               a=tree[a].x;
    1415             :             }
    1416        1309 :             a=detag(a);
    1417        1309 :             ep=getlvalue(a);
    1418        1309 :             vn=getmvar(ep);
    1419        1309 :             if (tree[a].f==Fentry)
    1420             :             {
    1421        1211 :               if (vn)
    1422         350 :                 op_push(OCsimpleptrlex, vn,n);
    1423             :               else
    1424         861 :                 op_push(OCsimpleptrdyn, (long)ep,n);
    1425             :             }
    1426             :             else
    1427             :             {
    1428          98 :               compilenewptr(vn, ep, a);
    1429          98 :               compilelvalue(a);
    1430          98 :               op_push(OCpushptr, 0, a);
    1431             :             }
    1432        1309 :             nbpointers++;
    1433        1309 :             break;
    1434             :           }
    1435             :         case 'I':
    1436             :         case 'E':
    1437             :         case 'J':
    1438             :           {
    1439       13796 :             long a = arg[j++];
    1440       13796 :             GEN  d = compilefuncinline(n, c, a, flag, is_func_named(ep,"if"), lev, ev);
    1441       13796 :             op_push(OCpushgen, data_push(d), a);
    1442       13796 :             if (lg(d)==8) op_push(OCsaveframe,FLsurvive,n);
    1443       13796 :             break;
    1444             :           }
    1445             :         case 'V':
    1446             :           {
    1447        3283 :             long a = arg[j++];
    1448        3283 :             (void)getvar(a);
    1449        3276 :             ev[lev++] = a;
    1450        3276 :             break;
    1451             :           }
    1452             :         case '=':
    1453             :           {
    1454        4783 :             long a = arg[j++];
    1455        4783 :             ev[lev++] = tree[a].x;
    1456        4783 :             compilenode(tree[a].y, Ggen, FLnocopy);
    1457             :           }
    1458        4783 :           break;
    1459             :         case 'r':
    1460             :           {
    1461        1310 :             long a=arg[j++];
    1462        1310 :             if (tree[a].f==Fentry)
    1463             :             {
    1464        1236 :               op_push(OCpushgen, data_push(strntoGENstr(tree[tree[a].x].str,
    1465        1236 :                                                         tree[tree[a].x].len)),n);
    1466        1236 :               op_push(OCtostr, -1,n);
    1467             :             }
    1468             :             else
    1469             :             {
    1470          74 :               compilenode(a,Ggen,FLnocopy);
    1471          74 :               op_push(OCtostr, -1,n);
    1472             :             }
    1473        1310 :             break;
    1474             :           }
    1475             :         case 's':
    1476             :           {
    1477        2542 :             long a = arg[j++];
    1478        2542 :             GEN g = cattovec(a, OPcat);
    1479        2542 :             long l, nb = lg(g)-1;
    1480        2542 :             if (nb==1)
    1481             :             {
    1482        2492 :               compilenode(g[1], Ggen, FLnocopy);
    1483        2492 :               op_push(OCtostr, -1, a);
    1484             :             } else
    1485             :             {
    1486          50 :               op_push(OCvec, nb+1, a);
    1487         150 :               for(l=1; l<=nb; l++)
    1488             :               {
    1489         100 :                 compilenode(g[l], Ggen, FLsurvive);
    1490         100 :                 op_push(OCstackgen,l, a);
    1491             :               }
    1492          50 :               op_push(OCpop, 1, a);
    1493          50 :               op_push(OCcallgen,(long)is_entry("Str"), a);
    1494          50 :               op_push(OCtostr, -1, a);
    1495             :             }
    1496        2542 :             break;
    1497             :           }
    1498             :         default:
    1499           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1500           0 :               tree[x].len, tree[x].str);
    1501             :         }
    1502     1003001 :         break;
    1503             :       case PPauto:
    1504       19732 :         switch(c)
    1505             :         {
    1506             :         case 'p':
    1507       17422 :           op_push(OCprecreal,0,n);
    1508       17422 :           break;
    1509             :         case 'b':
    1510        2275 :           op_push(OCbitprecreal,0,n);
    1511        2275 :           break;
    1512             :         case 'P':
    1513           0 :           op_push(OCprecdl,0,n);
    1514           0 :           break;
    1515             :         case 'C':
    1516          35 :           op_push(OCpushgen,data_push(pack_localvars()),n);
    1517          35 :           break;
    1518             :         case 'f':
    1519             :           {
    1520             :             static long foo;
    1521           0 :             op_push(OCpushlong,(long)&foo,n);
    1522           0 :             break;
    1523             :           }
    1524             :         }
    1525       19732 :         break;
    1526             :       case PPdefault:
    1527       22659 :         j++;
    1528       22659 :         switch(c)
    1529             :         {
    1530             :         case 'G':
    1531             :         case '&':
    1532             :         case 'E':
    1533             :         case 'I':
    1534             :         case 'r':
    1535             :         case 's':
    1536       16881 :           op_push(OCpushlong,0,n);
    1537       16881 :           break;
    1538             :         case 'n':
    1539        5296 :           op_push(OCpushlong,-1,n);
    1540        5296 :           break;
    1541             :         case 'V':
    1542         363 :           ev[lev++] = -1;
    1543         363 :           break;
    1544             :         case 'P':
    1545         119 :           op_push(OCprecdl,0,n);
    1546         119 :           break;
    1547             :         default:
    1548           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1549           0 :               tree[x].len, tree[x].str);
    1550             :         }
    1551       22659 :         break;
    1552             :       case PPdefaultmulti:
    1553       15068 :         j++;
    1554       15068 :         switch(c)
    1555             :         {
    1556             :         case 'G':
    1557         371 :           op_push(OCpushstoi,strtol(q+1,NULL,10),n);
    1558         371 :           break;
    1559             :         case 'L':
    1560             :         case 'M':
    1561       14667 :           op_push(OCpushlong,strtol(q+1,NULL,10),n);
    1562       14667 :           break;
    1563             :         case 'U':
    1564           7 :           op_push(OCpushlong,(long)strtoul(q+1,NULL,10),n);
    1565           7 :           break;
    1566             :         case 'r':
    1567             :         case 's':
    1568          23 :           str_defproto(p, q, tree[n].str);
    1569          23 :           op_push(OCtostr, -1, n);
    1570          23 :           break;
    1571             :         default:
    1572           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1573           0 :               tree[x].len, tree[x].str);
    1574             :         }
    1575       15068 :         break;
    1576             :       case PPstar:
    1577        9911 :         switch(c)
    1578             :         {
    1579             :         case 'E':
    1580             :           {
    1581          91 :             long k, n=nb+1-j;
    1582          91 :             GEN g=cgetg(n+1,t_VEC);
    1583          91 :             int ismif = is_func_named(ep,"_multi_if");
    1584         455 :             for(k=1; k<=n; k++)
    1585         712 :               gel(g, k) = compilefuncinline(n, c, arg[j+k-1], flag,
    1586         364 :                           ismif && (k==n || odd(k)), lev, ev);
    1587          91 :             op_push(OCpushgen, data_push(g), arg[j]);
    1588          91 :             j=nb+1;
    1589          91 :             break;
    1590             :           }
    1591             :         case 's':
    1592             :           {
    1593        9820 :             long n=nb+1-j;
    1594             :             long k,l,l1,m;
    1595        9820 :             GEN g=cgetg(n+1,t_VEC);
    1596       24241 :             for(l1=0,k=1;k<=n;k++)
    1597             :             {
    1598       14421 :               gel(g,k)=cattovec(arg[j+k-1],OPcat);
    1599       14421 :               l1+=lg(gel(g,k))-1;
    1600             :             }
    1601        9820 :             op_push_loc(OCvec, l1+1, str);
    1602       24241 :             for(m=1,k=1;k<=n;k++)
    1603       28961 :               for(l=1;l<lg(gel(g,k));l++,m++)
    1604             :               {
    1605       14540 :                 compilenode(mael(g,k,l),Ggen,FLsurvive);
    1606       14540 :                 op_push(OCstackgen,m,mael(g,k,l));
    1607             :               }
    1608        9820 :             op_push_loc(OCpop, 1, str);
    1609        9820 :             j=nb+1;
    1610        9820 :             break;
    1611             :           }
    1612             :         default:
    1613           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    1614           0 :               tree[x].len, tree[x].str);
    1615             :         }
    1616        9911 :         break;
    1617             :       default:
    1618           0 :         pari_err_BUG("compilefunc [unknown PPproto]");
    1619             :       }
    1620     1070371 :       q=p;
    1621             :     }
    1622             :   }
    1623      683807 :   if (j<=nb)
    1624           0 :     compile_err("too many arguments",tree[arg[j]].str);
    1625      683807 :   op_push_loc(ret_op, (long) ep, str);
    1626      683807 :   if ((ret_flag&FLnocopy) && !(flag&FLnocopy))
    1627        9149 :     op_push_loc(OCcopy,0,str);
    1628      683807 :   if (ret_typ==Ggen && nbpointers==0 && s_opcode.n>nbopcodes+128)
    1629             :   {
    1630        1673 :     op_insert_loc(nbopcodes,OCavma,0,str);
    1631        1673 :     op_push_loc(OCgerepile,0,str);
    1632             :   }
    1633      683807 :   compilecast(n,ret_typ,mode);
    1634      683807 :   if (nbpointers) op_push_loc(OCendptr,nbpointers, str);
    1635      683807 :   avma=ltop;
    1636             : }
    1637             : 
    1638             : static void
    1639      215266 : genclosurectx(const char *loc, long nbdata)
    1640             : {
    1641             :   long i;
    1642      215266 :   GEN vep = cgetg(nbdata+1,t_VECSMALL);
    1643      660999 :   for(i = 1; i <= nbdata; i++)
    1644             :   {
    1645      445733 :     vep[i] = 0;
    1646      445733 :     op_push_loc(OCpushlex,-i,loc);
    1647             :   }
    1648      215266 :   frame_push(vep);
    1649      215266 : }
    1650             : 
    1651             : static GEN
    1652      221985 : genclosure(entree *ep, const char *loc, long  nbdata, int check)
    1653             : {
    1654      221985 :   pari_sp av = avma;
    1655             :   struct codepos pos;
    1656      221985 :   long nb=0;
    1657      221985 :   const char *code=ep->code,*p,*q;
    1658             :   char c;
    1659             :   GEN text;
    1660      221985 :   long index=ep->arity;
    1661      221985 :   long arity=0, maskarg=0, maskarg0=0, stop=0, dovararg=0;
    1662             :   PPproto mod;
    1663             :   Gtype ret_typ;
    1664             :   long ret_flag;
    1665      221985 :   op_code ret_op=get_ret_type(&code,ep->arity,&ret_typ,&ret_flag);
    1666      221985 :   p=code;
    1667     1113548 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1668             :   {
    1669      669578 :     if (mod==PPauto)
    1670        1351 :       stop=1;
    1671             :     else
    1672             :     {
    1673      668227 :       if (stop) return NULL;
    1674      668227 :       if (c=='V') continue;
    1675      668227 :       maskarg<<=1; maskarg0<<=1; arity++;
    1676      668227 :       switch(mod)
    1677             :       {
    1678             :       case PPstd:
    1679      667246 :         maskarg|=1L;
    1680      667246 :         break;
    1681             :       case PPdefault:
    1682         391 :         switch(c)
    1683             :         {
    1684             :         case '&':
    1685             :         case 'E':
    1686             :         case 'I':
    1687          28 :           maskarg0|=1L;
    1688          28 :           break;
    1689             :         }
    1690         391 :         break;
    1691             :       default:
    1692         590 :         break;
    1693             :       }
    1694             :     }
    1695             :   }
    1696      221985 :   if (check && EpSTATIC(ep) && maskarg==0)
    1697        5253 :     return gen_0;
    1698      216732 :   getcodepos(&pos);
    1699      216732 :   dbgstart = loc;
    1700      216732 :   if (nbdata > arity)
    1701           0 :     pari_err(e_MISC,"too many parameters for closure `%s'", ep->name);
    1702      216732 :   if (nbdata) genclosurectx(loc, nbdata);
    1703      216732 :   text = strtoGENstr(ep->name);
    1704      216732 :   arity -= nbdata;
    1705      216732 :   if (maskarg)  op_push_loc(OCcheckargs,maskarg,loc);
    1706      216732 :   if (maskarg0) op_push_loc(OCcheckargs0,maskarg0,loc);
    1707      216732 :   p=code;
    1708     1101944 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1709             :   {
    1710      668480 :     switch(mod)
    1711             :     {
    1712             :     case PPauto:
    1713         553 :       switch(c)
    1714             :       {
    1715             :       case 'p':
    1716         553 :         op_push_loc(OCprecreal,0,loc);
    1717         553 :         break;
    1718             :       case 'b':
    1719           0 :         op_push_loc(OCbitprecreal,0,loc);
    1720           0 :         break;
    1721             :       case 'P':
    1722           0 :         op_push_loc(OCprecdl,0,loc);
    1723           0 :         break;
    1724             :       case 'C':
    1725           0 :         op_push_loc(OCpushgen,data_push(pack_localvars()),loc);
    1726           0 :         break;
    1727             :       case 'f':
    1728             :         {
    1729             :           static long foo;
    1730           0 :           op_push_loc(OCpushlong,(long)&foo,loc);
    1731           0 :           break;
    1732             :         }
    1733             :       }
    1734             :     default:
    1735      668480 :       break;
    1736             :     }
    1737             :   }
    1738      216732 :   q = p = code;
    1739     1101944 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1740             :   {
    1741      668480 :     switch(mod)
    1742             :     {
    1743             :     case PPstd:
    1744      667246 :       switch(c)
    1745             :       {
    1746             :       case 'G':
    1747      653342 :         break;
    1748             :       case 'M':
    1749             :       case 'L':
    1750        4542 :         op_push_loc(OCitos,-index,loc);
    1751        4542 :         break;
    1752             :       case 'U':
    1753        9325 :         op_push_loc(OCitou,-index,loc);
    1754        9325 :         break;
    1755             :       case 'n':
    1756           0 :         op_push_loc(OCvarn,-index,loc);
    1757           0 :         break;
    1758             :       case '&': case '*':
    1759             :       case 'I':
    1760             :       case 'E':
    1761             :       case 'V':
    1762             :       case '=':
    1763           0 :         return NULL;
    1764             :       case 'r':
    1765             :       case 's':
    1766          37 :         op_push_loc(OCtostr,-index,loc);
    1767          37 :         break;
    1768             :       }
    1769      667246 :       break;
    1770             :     case PPauto:
    1771         553 :       break;
    1772             :     case PPdefault:
    1773         349 :       switch(c)
    1774             :       {
    1775             :       case 'G':
    1776             :       case '&':
    1777             :       case 'E':
    1778             :       case 'I':
    1779             :       case 'V':
    1780             :       case 'r':
    1781             :       case 's':
    1782         181 :         break;
    1783             :       case 'n':
    1784          98 :         op_push_loc(OCvarn,-index,loc);
    1785          98 :         break;
    1786             :       case 'P':
    1787          70 :         op_push_loc(OCprecdl,0,loc);
    1788          70 :         op_push_loc(OCdefaultlong,-index,loc);
    1789          70 :         break;
    1790             :       default:
    1791           0 :         pari_err(e_MISC,"Unknown prototype code `D%c' for `%s'",c,ep->name);
    1792             :       }
    1793         349 :       break;
    1794             :     case PPdefaultmulti:
    1795         311 :       switch(c)
    1796             :       {
    1797             :       case 'G':
    1798           0 :         op_push_loc(OCpushstoi,strtol(q+1,NULL,10),loc);
    1799           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1800           0 :         break;
    1801             :       case 'L':
    1802             :       case 'M':
    1803         291 :         op_push_loc(OCpushlong,strtol(q+1,NULL,10),loc);
    1804         291 :         op_push_loc(OCdefaultlong,-index,loc);
    1805         291 :         break;
    1806             :       case 'U':
    1807           4 :         op_push_loc(OCpushlong,(long)strtoul(q+1,NULL,10),loc);
    1808           4 :         op_push_loc(OCdefaultulong,-index,loc);
    1809           4 :         break;
    1810             :       case 'r':
    1811             :       case 's':
    1812          16 :         str_defproto(p, q, loc);
    1813          16 :         op_push_loc(OCdefaultgen,-index,loc);
    1814          16 :         op_push_loc(OCtostr,-index,loc);
    1815          16 :         break;
    1816             :       default:
    1817           0 :         pari_err(e_MISC,
    1818             :             "Unknown prototype code `D...,%c,' for `%s'",c,ep->name);
    1819             :       }
    1820         311 :       break;
    1821             :     case PPstar:
    1822          21 :       switch(c)
    1823             :       {
    1824             :       case 's':
    1825          21 :         dovararg = 1;
    1826          21 :         break;
    1827             :       case 'E':
    1828           0 :         return NULL;
    1829             :       default:
    1830           0 :         pari_err(e_MISC,"Unknown prototype code `%c*' for `%s'",c,ep->name);
    1831             :       }
    1832          21 :       break;
    1833             :     default:
    1834           0 :       return NULL;
    1835             :     }
    1836      668480 :     index--;
    1837      668480 :     q = p;
    1838             :   }
    1839      216732 :   op_push_loc(ret_op, (long) ep, loc);
    1840      216732 :   if (ret_flag==FLnocopy) op_push_loc(OCcopy,0,loc);
    1841      216732 :   compilecast_loc(ret_typ, Ggen, loc);
    1842      216732 :   if (dovararg) nb|=VARARGBITS;
    1843      216732 :   return gerepilecopy(av, getfunction(&pos,nb+arity,nbdata,text,0));
    1844             : }
    1845             : 
    1846             : GEN
    1847       16211 : snm_closure(entree *ep, GEN data)
    1848             : {
    1849             :   long i;
    1850       16211 :   long n = data ? lg(data)-1: 0;
    1851       16211 :   GEN C = genclosure(ep,ep->name,n,0);
    1852       80584 :   for(i=1; i<=n; i++)
    1853       64373 :     gmael(C,7,i) = gel(data,i);
    1854       16211 :   return C;
    1855             : }
    1856             : 
    1857             : GEN
    1858      199068 : strtoclosure(const char *s, long n,  ...)
    1859             : {
    1860      199068 :   pari_sp av = avma;
    1861      199068 :   entree *ep = is_entry(s);
    1862             :   GEN C;
    1863      199068 :   if (!ep) pari_err(e_NOTFUNC, strtoGENstr(s));
    1864      199068 :   ep = do_alias(ep);
    1865      199068 :   if ((!EpSTATIC(ep) && EpVALENCE(ep)!=EpINSTALL) || !ep->value)
    1866           0 :     pari_err(e_MISC,"not a built-in/install'ed function: \"%s\"",s);
    1867      199068 :   C = genclosure(ep,ep->name,n,0);
    1868      199068 :   if (!C) pari_err(e_MISC,"function prototype unsupported: \"%s\"",s);
    1869             :   else
    1870             :   {
    1871             :     va_list ap;
    1872             :     long i;
    1873      199068 :     va_start(ap,n);
    1874      580428 :     for(i=1; i<=n; i++)
    1875      381360 :       gmael(C,7,i) = va_arg(ap, GEN);
    1876      199068 :     va_end(ap);
    1877             :   }
    1878      199068 :   return gerepilecopy(av, C);
    1879             : }
    1880             : 
    1881             : GEN
    1882           7 : strtofunction(const char *s)
    1883             : {
    1884           7 :   return strtoclosure(s, 0);
    1885             : }
    1886             : 
    1887             : GEN
    1888          21 : call0(GEN fun, GEN args)
    1889             : {
    1890          21 :   if (!is_vec_t(typ(args))) pari_err_TYPE("call",args);
    1891          21 :   switch(typ(fun))
    1892             :   {
    1893             :     case t_STR:
    1894           7 :       fun = strtofunction(GSTR(fun));
    1895             :     case t_CLOSURE: /* fall through */
    1896          21 :       return closure_callgenvec(fun, args);
    1897             :     default:
    1898           0 :       pari_err_TYPE("call", fun);
    1899             :       return NULL; /* LCOV_EXCL_LINE */
    1900             :   }
    1901             : }
    1902             : 
    1903             : static void
    1904        6706 : closurefunc(entree *ep, long n, long mode)
    1905             : {
    1906        6706 :   pari_sp ltop=avma;
    1907             :   GEN C;
    1908        6706 :   if (!ep->value) compile_err("unknown function",tree[n].str);
    1909        6706 :   C = genclosure(ep,tree[n].str,0,1);
    1910        6706 :   if (!C) compile_err("sorry, closure not implemented",tree[n].str);
    1911        6706 :   if (C==gen_0)
    1912             :   {
    1913        5253 :     compilefunc(ep,n,mode,0);
    1914       11959 :     return;
    1915             :   }
    1916        1453 :   op_push(OCpushgen, data_push(C), n);
    1917        1453 :   compilecast(n,Gclosure,mode);
    1918        1453 :   avma=ltop;
    1919             : }
    1920             : 
    1921             : static void
    1922        9479 : compileseq(long n, int mode, long flag)
    1923             : {
    1924        9479 :   pari_sp av = avma;
    1925        9479 :   GEN L = listtogen(n, Fseq);
    1926        9479 :   long i, l = lg(L)-1;
    1927       32021 :   for(i = 1; i < l; i++)
    1928       22542 :     compilenode(L[i],Gvoid,0);
    1929        9479 :   compilenode(L[l],mode,flag&(FLreturn|FLsurvive));
    1930        9479 :   avma = av;
    1931        9479 : }
    1932             : 
    1933             : static void
    1934    13307517 : compilenode(long n, int mode, long flag)
    1935             : {
    1936             :   long x,y;
    1937             : #ifdef STACK_CHECK
    1938    13307517 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    1939           0 :     pari_err(e_MISC, "expression nested too deeply");
    1940             : #endif
    1941    13307517 :   if (n<0) pari_err_BUG("compilenode");
    1942    13307517 :   x=tree[n].x;
    1943    13307517 :   y=tree[n].y;
    1944             : 
    1945    13307517 :   switch(tree[n].f)
    1946             :   {
    1947             :   case Fseq:
    1948        9479 :     compileseq(n, mode, flag);
    1949        9479 :     return;
    1950             :   case Fmatcoeff:
    1951        8438 :     compilematcoeff(n,mode);
    1952        8438 :     if (mode==Ggen && !(flag&FLnocopy))
    1953        2020 :       op_push(OCcopy,0,n);
    1954        8438 :     return;
    1955             :   case Fassign:
    1956       26353 :     x = detag(x);
    1957       26353 :     if (tree[x].f==Fvec && tree[x].x>=0)
    1958         399 :     {
    1959         399 :       GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1960         399 :       long i, l = lg(vars)-1, d = mode==Gvoid? l-1: l;
    1961         399 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    1962         399 :       if (d) op_push(OCdup, d, x);
    1963        1281 :       for(i=1; i<=l; i++)
    1964             :       {
    1965         882 :         long a = detag(vars[i]);
    1966         882 :         entree *ep=getlvalue(a);
    1967         882 :         long vn=getmvar(ep);
    1968         882 :         op_push(OCpushlong,i,a);
    1969         882 :         op_push(OCcompo1,Ggen,a);
    1970         882 :         if (tree[a].f==Fentry)
    1971         875 :           compilestore(vn,ep,n);
    1972             :         else
    1973             :         {
    1974           7 :           compilenewptr(vn,ep,n);
    1975           7 :           compilelvalue(a);
    1976           7 :           op_push(OCstoreptr,0,a);
    1977             :         }
    1978             :       }
    1979         399 :       if (mode!=Gvoid)
    1980         210 :         compilecast(n,Ggen,mode);
    1981             :     }
    1982             :     else
    1983             :     {
    1984       25954 :       entree *ep=getlvalue(x);
    1985       25954 :       long vn=getmvar(ep);
    1986       25954 :       if (tree[x].f!=Fentry)
    1987             :       {
    1988         385 :         compilenewptr(vn,ep,n);
    1989         385 :         compilelvalue(x);
    1990             :       }
    1991       25954 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    1992       25954 :       if (mode!=Gvoid)
    1993       15882 :         op_push(OCdup,1,n);
    1994       25954 :       if (tree[x].f==Fentry)
    1995       25569 :         compilestore(vn,ep,n);
    1996             :       else
    1997         385 :         op_push(OCstoreptr,0,x);
    1998       25954 :       if (mode!=Gvoid)
    1999       15882 :         compilecast(n,Ggen,mode);
    2000             :     }
    2001       26353 :     return;
    2002             :   case Fconst:
    2003             :     {
    2004     1765741 :       pari_sp ltop=avma;
    2005     1765741 :       if (tree[n].x!=CSTquote)
    2006             :       {
    2007     1763277 :         if (mode==Gvoid) return;
    2008     1763277 :         if (mode==Gvar) compile_varerr(tree[n].str);
    2009             :       }
    2010     1765741 :       if (mode==Gsmall)
    2011           0 :         compile_err("this should be a small integer", tree[n].str);
    2012     1765741 :       switch(tree[n].x)
    2013             :       {
    2014             :       case CSTreal:
    2015        2391 :         op_push(OCpushreal, data_push(strntoGENstr(tree[n].str,tree[n].len)),n);
    2016        2391 :         break;
    2017             :       case CSTint:
    2018      653952 :         op_push(OCpushgen,  data_push(strtoi((char*)tree[n].str)),n);
    2019      653952 :         compilecast(n,Ggen, mode);
    2020      653952 :         break;
    2021             :       case CSTstr:
    2022     1106934 :         op_push(OCpushgen,  data_push(strntoGENexp(tree[n].str,tree[n].len)),n);
    2023     1106934 :         break;
    2024             :       case CSTquote:
    2025             :         { /* skip ' */
    2026        2464 :           entree *ep = fetch_entry_raw(tree[n].str+1,tree[n].len-1);
    2027        2464 :           if (EpSTATIC(ep)) compile_varerr(tree[n].str+1);
    2028        2464 :           op_push(OCpushvar, (long)ep,n);
    2029        2464 :           compilecast(n,Ggen, mode);
    2030        2464 :           break;
    2031             :         }
    2032             :       default:
    2033           0 :         pari_err_BUG("compilenode, unsupported constant");
    2034             :       }
    2035     1765741 :       avma=ltop;
    2036     1765741 :       return;
    2037             :     }
    2038             :   case Fsmall:
    2039     4824498 :     compilesmall(n, x, mode);
    2040     4824491 :     return;
    2041             :   case Fvec:
    2042     3800030 :     compilevec(n, mode, OCvec);
    2043     3800030 :     return;
    2044             :   case Fmat:
    2045        7756 :     compilemat(n, mode);
    2046        7756 :     return;
    2047             :   case Frefarg:
    2048           0 :     compile_err("unexpected character '&':",tree[n].str);
    2049           0 :     return;
    2050             :   case Fentry:
    2051             :     {
    2052      169056 :       entree *ep=getentry(n);
    2053      169056 :       long vn=getmvar(ep);
    2054      169056 :       if (vn)
    2055             :       {
    2056       52241 :         op_push(OCpushlex,(long)vn,n);
    2057       52241 :         addcopy(n,mode,flag,FLnocopy|FLnocopylex);
    2058       52241 :         compilecast(n,Ggen,mode);
    2059             :       }
    2060      116815 :       else if (ep->valence==EpVAR || ep->valence==EpNEW)
    2061             :       {
    2062      110109 :         if (DEBUGLEVEL && mode==Gvoid)
    2063           0 :           pari_warn(warner,"statement with no effect: `%s'",ep->name);
    2064      110109 :         op_push(OCpushdyn,(long)ep,n);
    2065      110109 :         addcopy(n,mode,flag,FLnocopy);
    2066      110109 :         compilecast(n,Ggen,mode);
    2067             :       }
    2068             :       else
    2069        6706 :         closurefunc(ep,n,mode);
    2070      169056 :       return;
    2071             :     }
    2072             :   case Ffunction:
    2073             :     {
    2074     2688375 :       entree *ep=getfunc(n);
    2075     2688375 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2076             :       {
    2077       18002 :         if (tree[n].x<OPnboperator) /* should not happen */
    2078           0 :           compile_err("operator unknown",tree[n].str);
    2079       18002 :         compilecall(n,mode,ep);
    2080             :       }
    2081             :       else
    2082     2670373 :         compilefunc(ep,n,mode,flag);
    2083     2688361 :       return;
    2084             :     }
    2085             :   case Fcall:
    2086         259 :     compilecall(n,mode,NULL);
    2087         259 :     return;
    2088             :   case Flambda:
    2089             :     {
    2090        7322 :       pari_sp ltop=avma;
    2091             :       struct codepos pos;
    2092        7322 :       GEN arg=listtogen(x,Flistarg);
    2093        7322 :       long nb, lgarg, nbmvar, dovararg=0, gap;
    2094        7322 :       long strict = GP_DATA->strictargs;
    2095        7322 :       GEN vep = cgetg_copy(arg, &lgarg);
    2096        7322 :       GEN text=cgetg(3,t_VEC);
    2097        7322 :       gel(text,1)=strntoGENstr(tree[x].str,tree[x].len);
    2098        7322 :       gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
    2099        7322 :       getcodepos(&pos);
    2100        7322 :       dbgstart=tree[x].str+tree[x].len;
    2101        7322 :       gap = tree[y].str-dbgstart;
    2102        7322 :       nbmvar=ctxmvar();
    2103        7322 :       nb = lgarg-1;
    2104        7322 :       if (nb)
    2105             :       {
    2106             :         long i;
    2107        8714 :         for(i=1;i<=nb;i++)
    2108             :         {
    2109        5336 :           long a=arg[i];
    2110        5336 :           if (i==nb && tree[a].f==Fvararg)
    2111             :           {
    2112          21 :             dovararg=1;
    2113          21 :             vep[i]=(long)getvar(tree[a].x);
    2114             :           }
    2115             :           else
    2116        5315 :             vep[i]=(long)getvar(tree[a].f==Fassign?tree[a].x:a);
    2117        5336 :           var_push(NULL,Lmy);
    2118             :         }
    2119        3378 :         checkdups(arg,vep);
    2120        3378 :         op_push(OCgetargs,nb,x);
    2121        3378 :         frame_push(vep);
    2122        8714 :         for (i=1;i<=nb;i++)
    2123             :         {
    2124        5336 :           long a=arg[i];
    2125        5336 :           long y = tree[a].y;
    2126        5336 :           if (tree[a].f==Fassign && (strict || !is_node_zero(y)))
    2127             :           {
    2128         231 :             if (tree[y].f==Fsmall)
    2129         168 :               compilenode(y, Ggen, 0);
    2130             :             else
    2131             :             {
    2132             :               struct codepos lpos;
    2133          63 :               getcodepos(&lpos);
    2134          63 :               compilenode(y, Ggen, 0);
    2135          63 :               op_push(OCpushgen, data_push(getclosure(&lpos)),a);
    2136             :             }
    2137         231 :             op_push(OCdefaultarg,-nb+i-1,a);
    2138             :           }
    2139        5336 :           localvars[s_lvar.n-nb+i-1].ep=(entree*)vep[i];
    2140             :         }
    2141             :       }
    2142        7322 :       if (strict)
    2143           7 :         op_push(OCcheckuserargs,nb,x);
    2144        7322 :       dbgstart=tree[y].str;
    2145        7322 :       if (y>=0 && tree[y].f!=Fnoarg)
    2146        7322 :         compilenode(y,Ggen,FLsurvive|FLreturn);
    2147             :       else
    2148           0 :         compilecast(n,Gvoid,Ggen);
    2149        7322 :       if (dovararg) nb|=VARARGBITS;
    2150        7322 :       op_push(OCpushgen, data_push(getfunction(&pos,nb,nbmvar,text,gap)),n);
    2151        7322 :       if (nbmvar) op_push(OCsaveframe,!!(flag&FLsurvive),n);
    2152        7322 :       compilecast(n, Gclosure, mode);
    2153        7322 :       avma=ltop;
    2154        7322 :       return;
    2155             :     }
    2156             :   case Ftag:
    2157           0 :     compilenode(x, mode,flag);
    2158           0 :     return;
    2159             :   case Fnoarg:
    2160           7 :     compilecast(n,Gvoid,mode);
    2161           7 :     return;
    2162             :   case Fnorange:
    2163         203 :     op_push(OCpushlong,LONG_MAX,n);
    2164         203 :     compilecast(n,Gsmall,mode);
    2165         203 :     return;
    2166             :   default:
    2167           0 :     pari_err_BUG("compilenode");
    2168             :   }
    2169             : }
    2170             : 
    2171             : GEN
    2172       85084 : gp_closure(long n)
    2173             : {
    2174             :   struct codepos pos;
    2175       85084 :   getcodepos(&pos);
    2176       85084 :   dbgstart=tree[n].str;
    2177       85084 :   compilenode(n,Ggen,FLsurvive|FLreturn);
    2178       85070 :   return getfunction(&pos,0,0,strntoGENstr(tree[n].str,tree[n].len),0);
    2179             : }
    2180             : 
    2181             : GEN
    2182          56 : closure_deriv(GEN G)
    2183             : {
    2184          56 :   pari_sp ltop=avma;
    2185             :   long i;
    2186             :   struct codepos pos;
    2187             :   const char *code;
    2188             :   GEN text;
    2189          56 :   long arity=closure_arity(G);
    2190          56 :   if (arity==0 || closure_is_variadic(G))
    2191           0 :     pari_err_TYPE("derivfun",G);
    2192          56 :   if (typ(gel(G,6))==t_STR)
    2193             :   {
    2194          56 :     code = GSTR(gel(G,6));
    2195          56 :     text = cgetg(1+nchar2nlong(2+strlen(code)),t_STR);
    2196          56 :     sprintf(GSTR(text),"%s'",code);
    2197             :   }
    2198             :   else
    2199             :   {
    2200           0 :     code = GSTR(GENtoGENstr(G));
    2201           0 :     text = cgetg(1+nchar2nlong(4+strlen(code)),t_STR);
    2202           0 :     sprintf(GSTR(text),"(%s)'",code);
    2203             :   }
    2204          56 :   getcodepos(&pos);
    2205          56 :   dbgstart=code;
    2206          56 :   op_push_loc(OCgetargs, arity,code);
    2207          56 :   op_push_loc(OCpushgen,data_push(G),code);
    2208          56 :   op_push_loc(OCvec,arity+1,code);
    2209         112 :   for (i=1;i<=arity;i++)
    2210             :   {
    2211          56 :     op_push_loc(OCpushlex,i-arity-1,code);
    2212          56 :     op_push_loc(OCstackgen,i,code);
    2213             :   }
    2214          56 :   op_push_loc(OCpop,1,code);
    2215          56 :   op_push_loc(OCprecreal,0,code);
    2216          56 :   op_push_loc(OCcallgen,(long)is_entry("_derivfun"),code);
    2217          56 :   return gerepilecopy(ltop, getfunction(&pos,arity,0,text,0));
    2218             : }
    2219             : 
    2220             : static long
    2221     3878060 : vec_optimize(GEN arg)
    2222             : {
    2223     3878060 :   long fl = COsafelex|COsafedyn;
    2224             :   long i;
    2225    16027684 :   for (i=1; i<lg(arg); i++)
    2226             :   {
    2227    12149631 :     optimizenode(arg[i]);
    2228    12149624 :     fl &= tree[arg[i]].flags;
    2229             :   }
    2230     3878053 :   return fl;
    2231             : }
    2232             : 
    2233             : static void
    2234     3803040 : optimizevec(long n)
    2235             : {
    2236     3803040 :   pari_sp ltop=avma;
    2237     3803040 :   long x = tree[n].x;
    2238     3803040 :   GEN  arg = listtogen(x, Fmatrixelts);
    2239     3803040 :   tree[n].flags = vec_optimize(arg);
    2240     3803040 :   avma = ltop;
    2241     3803040 : }
    2242             : 
    2243             : static void
    2244        7756 : optimizemat(long n)
    2245             : {
    2246        7756 :   pari_sp ltop = avma;
    2247        7756 :   long x = tree[n].x;
    2248             :   long i;
    2249        7756 :   GEN line = listtogen(x,Fmatrixlines);
    2250        7756 :   long fl = COsafelex|COsafedyn;
    2251       40418 :   for(i=1;i<lg(line);i++)
    2252             :   {
    2253       32662 :     GEN col=listtogen(line[i],Fmatrixelts);
    2254       32662 :     fl &= vec_optimize(col);
    2255             :   }
    2256        7756 :   avma=ltop; tree[n].flags=fl;
    2257        7756 : }
    2258             : 
    2259             : static void
    2260        8991 : optimizematcoeff(long n)
    2261             : {
    2262        8991 :   long x=tree[n].x;
    2263        8991 :   long y=tree[n].y;
    2264        8991 :   long yx=tree[y].x;
    2265        8991 :   long yy=tree[y].y;
    2266             :   long fl;
    2267        8991 :   optimizenode(x);
    2268        8991 :   optimizenode(yx);
    2269        8991 :   fl=tree[x].flags&tree[yx].flags;
    2270        8991 :   if (yy>=0)
    2271             :   {
    2272         910 :     optimizenode(yy);
    2273         910 :     fl&=tree[yy].flags;
    2274             :   }
    2275        8991 :   tree[n].flags=fl;
    2276        8991 : }
    2277             : 
    2278             : 
    2279             : static void
    2280     2672844 : optimizefunc(entree *ep, long n)
    2281             : {
    2282     2672844 :   pari_sp av=avma;
    2283             :   long j;
    2284     2672844 :   long x=tree[n].x;
    2285     2672844 :   long y=tree[n].y;
    2286             :   Gtype t;
    2287             :   PPproto mod;
    2288     2672844 :   long fl=COsafelex|COsafedyn;
    2289             :   const char *p;
    2290             :   char c;
    2291     2672844 :   GEN arg = listtogen(y,Flistarg);
    2292     2672844 :   long nb=lg(arg)-1, ret_flag;
    2293     2672844 :   if (is_func_named(ep,"if") && nb>=4)
    2294          91 :     ep=is_entry("_multi_if");
    2295     2672844 :   p = ep->code;
    2296     2672844 :   if (!p)
    2297        2134 :     fl=0;
    2298             :   else
    2299     2670710 :     (void) get_ret_type(&p, 2, &t, &ret_flag);
    2300     2672844 :   if (p && *p)
    2301             :   {
    2302     2665717 :     j=1;
    2303     8430036 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    2304             :     {
    2305     3098609 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    2306     3001577 :           && (mod==PPdefault || mod==PPdefaultmulti))
    2307       28276 :         mod=PPstd;
    2308     3098609 :       switch(mod)
    2309             :       {
    2310             :       case PPstd:
    2311     2991972 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    2312     2991965 :         if (tree[arg[j]].f==Fnoarg && c!='I' && c!='E')
    2313           0 :           compile_err("missing mandatory argument", tree[arg[j]].str);
    2314     2991965 :         switch(c)
    2315             :         {
    2316             :         case 'G':
    2317             :         case 'n':
    2318             :         case 'M':
    2319             :         case 'L':
    2320             :         case 'U':
    2321             :         case 'P':
    2322     2964781 :           optimizenode(arg[j]);
    2323     2964781 :           fl&=tree[arg[j++]].flags;
    2324     2964781 :           break;
    2325             :         case 'I':
    2326             :         case 'E':
    2327             :         case 'J':
    2328       13803 :           optimizenode(arg[j]);
    2329       13803 :           fl&=tree[arg[j]].flags;
    2330       13803 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2331       13803 :           break;
    2332             :         case '&': case '*':
    2333             :           {
    2334        1309 :             long a=arg[j];
    2335        1309 :             if (c=='&')
    2336             :             {
    2337         826 :               if (tree[a].f!=Frefarg)
    2338           0 :                 compile_err("expected character: '&'", tree[a].str);
    2339         826 :               a=tree[a].x;
    2340             :             }
    2341        1309 :             optimizenode(a);
    2342        1309 :             tree[arg[j++]].flags=COsafelex|COsafedyn;
    2343        1309 :             fl=0;
    2344        1309 :             break;
    2345             :           }
    2346             :         case 'W':
    2347         154 :           optimizenode(arg[j++]);
    2348         154 :           fl=0;
    2349         154 :           break;
    2350             :         case 'V':
    2351             :         case 'r':
    2352        4593 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2353        4593 :           break;
    2354             :         case '=':
    2355             :           {
    2356        4783 :             long a=arg[j++], y=tree[a].y;
    2357        4783 :             if (tree[a].f!=Fassign)
    2358           0 :               compile_err("expected character: '=' instead of",
    2359           0 :                   tree[a].str+tree[a].len);
    2360        4783 :             optimizenode(y);
    2361        4783 :             fl&=tree[y].flags;
    2362             :           }
    2363        4783 :           break;
    2364             :         case 's':
    2365        2542 :           fl &= vec_optimize(cattovec(arg[j++], OPcat));
    2366        2542 :           break;
    2367             :         default:
    2368           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    2369           0 :               tree[x].len, tree[x].str);
    2370             :         }
    2371     2991965 :         break;
    2372             :       case PPauto:
    2373       60027 :         break;
    2374             :       case PPdefault:
    2375             :       case PPdefaultmulti:
    2376       36699 :         if (j<=nb) optimizenode(arg[j++]);
    2377       36699 :         break;
    2378             :       case PPstar:
    2379        9911 :         switch(c)
    2380             :         {
    2381             :         case 'E':
    2382             :           {
    2383          91 :             long n=nb+1-j;
    2384             :             long k;
    2385         455 :             for(k=1;k<=n;k++)
    2386             :             {
    2387         364 :               optimizenode(arg[j+k-1]);
    2388         364 :               fl &= tree[arg[j+k-1]].flags;
    2389             :             }
    2390          91 :             j=nb+1;
    2391          91 :             break;
    2392             :           }
    2393             :         case 's':
    2394             :           {
    2395        9820 :             long n=nb+1-j;
    2396             :             long k;
    2397       24241 :             for(k=1;k<=n;k++)
    2398       14421 :               fl &= vec_optimize(cattovec(arg[j+k-1],OPcat));
    2399        9820 :             j=nb+1;
    2400        9820 :             break;
    2401             :           }
    2402             :         default:
    2403           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    2404           0 :               tree[x].len, tree[x].str);
    2405             :         }
    2406        9911 :         break;
    2407             :       default:
    2408           0 :         pari_err_BUG("optimizefun [unknown PPproto]");
    2409             :       }
    2410             :     }
    2411     5331420 :     if (j<=nb)
    2412           0 :       compile_err("too many arguments",tree[arg[j]].str);
    2413             :   }
    2414        7127 :   else (void)vec_optimize(arg);
    2415     2672837 :   avma=av; tree[n].flags=fl;
    2416     2672837 : }
    2417             : 
    2418             : static void
    2419       18268 : optimizecall(long n)
    2420             : {
    2421       18268 :   pari_sp av=avma;
    2422       18268 :   long x=tree[n].x;
    2423       18268 :   long y=tree[n].y;
    2424       18268 :   GEN arg=listtogen(y,Flistarg);
    2425       18268 :   optimizenode(x);
    2426       18268 :   tree[n].flags = COsafelex&tree[x].flags&vec_optimize(arg);
    2427       18261 :   avma=av;
    2428       18261 : }
    2429             : 
    2430             : static void
    2431        9479 : optimizeseq(long n)
    2432             : {
    2433        9479 :   pari_sp av = avma;
    2434        9479 :   GEN L = listtogen(n, Fseq);
    2435        9479 :   long i, l = lg(L)-1, flags=-1L;
    2436       41500 :   for(i = 1; i <= l; i++)
    2437             :   {
    2438       32021 :     optimizenode(L[i]);
    2439       32021 :     flags &= tree[L[i]].flags;
    2440             :   }
    2441        9479 :   avma = av;
    2442        9479 :   tree[n].flags = flags;
    2443        9479 : }
    2444             : 
    2445             : void
    2446    15374671 : optimizenode(long n)
    2447             : {
    2448             :   long x,y;
    2449             : #ifdef STACK_CHECK
    2450    15374671 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2451           0 :     pari_err(e_MISC, "expression nested too deeply");
    2452             : #endif
    2453    15374671 :   if (n<0)
    2454           0 :     pari_err_BUG("optimizenode");
    2455    15374671 :   x=tree[n].x;
    2456    15374671 :   y=tree[n].y;
    2457             : 
    2458    15374671 :   switch(tree[n].f)
    2459             :   {
    2460             :   case Fseq:
    2461        9479 :     optimizeseq(n);
    2462        9479 :     return;
    2463             :   case Frange:
    2464        9901 :     optimizenode(x);
    2465        9901 :     optimizenode(y);
    2466        9901 :     tree[n].flags=tree[x].flags&tree[y].flags;
    2467        9901 :     break;
    2468             :   case Fmatcoeff:
    2469        8991 :     optimizematcoeff(n);
    2470        8991 :     break;
    2471             :   case Fassign:
    2472       28831 :     optimizenode(x);
    2473       28831 :     optimizenode(y);
    2474       28831 :     tree[n].flags=0;
    2475       28831 :     break;
    2476             :   case Fnoarg:
    2477             :   case Fnorange:
    2478             :   case Fsmall:
    2479             :   case Fconst:
    2480             :   case Fentry:
    2481     8808232 :     tree[n].flags=COsafelex|COsafedyn;
    2482     8808232 :     return;
    2483             :   case Fvec:
    2484     3803040 :     optimizevec(n);
    2485     3803040 :     return;
    2486             :   case Fmat:
    2487        7756 :     optimizemat(n);
    2488        7756 :     return;
    2489             :   case Frefarg:
    2490           7 :     compile_err("unexpected character '&'",tree[n].str);
    2491           0 :     return;
    2492             :   case Fvararg:
    2493           0 :     compile_err("unexpected characters '..'",tree[n].str);
    2494           0 :     return;
    2495             :   case Ffunction:
    2496             :     {
    2497     2690853 :       entree *ep=getfunc(n);
    2498     2690853 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2499       18009 :         optimizecall(n);
    2500             :       else
    2501     2672844 :         optimizefunc(ep,n);
    2502     2690839 :       return;
    2503             :     }
    2504             :   case Fcall:
    2505         259 :     optimizecall(n);
    2506         259 :     return;
    2507             :   case Flambda:
    2508        7322 :     optimizenode(y);
    2509        7322 :     tree[n].flags=COsafelex|COsafedyn;
    2510        7322 :     return;
    2511             :   case Ftag:
    2512           0 :     optimizenode(x);
    2513           0 :     tree[n].flags=tree[x].flags;
    2514           0 :     return;
    2515             :   default:
    2516           0 :     pari_err_BUG("optimizenode");
    2517             :   }
    2518             : }

Generated by: LCOV version 1.11