Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - compile.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 24038-ebe36f6c4) Lines: 1387 1538 90.2 %
Date: 2019-07-23 05:53:17 Functions: 82 84 97.6 %
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     1108402 : translate(const char **src, char *s)
      32             : {
      33     1108402 :   const char *t = *src;
      34     9008304 :   while (*t)
      35             :   {
      36    15800357 :     while (*t == '\\')
      37             :     {
      38         553 :       switch(*++t)
      39             :       {
      40           0 :         case 'e':  *s='\033'; break; /* escape */
      41         371 :         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         553 :       t++; s++;
      46             :     }
      47     7899902 :     if (*t == '"')
      48             :     {
      49     1108402 :       if (t[1] != '"') break;
      50           0 :       t += 2; continue;
      51             :     }
      52     6791500 :     *s++ = *t++;
      53             :   }
      54     1108402 :   *s=0; *src=t; return s;
      55             : }
      56             : 
      57             : static void
      58           8 : matchQ(const char *s, char *entry)
      59             : {
      60           8 :   if (*s != '"')
      61           0 :     pari_err(e_SYNTAX,"expected character: '\"' instead of",s,entry);
      62           8 : }
      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           4 : pari_translate_string(const char *src, char *s, char *entry)
      68             : {
      69           4 :   matchQ(src, entry); src++; s = translate(&src, s);
      70           4 :   if (!s) pari_err(e_SYNTAX,"run-away string",src,entry);
      71           4 :   matchQ(src, entry); return (char*)src+1;
      72             : }
      73             : 
      74             : static GEN
      75     1108398 : strntoGENexp(const char *str, long len)
      76             : {
      77     1108398 :   GEN z = cgetg(1+nchar2nlong(len-1), t_STR);
      78     1108398 :   const char *t = str+1;
      79     1108398 :   if (!translate(&t, GSTR(z))) compile_err("run-away string",str);
      80     1108398 :   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      427162 : pari_init_compiler(void)
     116             : {
     117      427162 :   pari_stack_init(&s_opcode,sizeof(*opcode),(void **)&opcode);
     118      427080 :   pari_stack_init(&s_operand,sizeof(*operand),(void **)&operand);
     119      427092 :   pari_stack_init(&s_data,sizeof(*data),(void **)&data);
     120      427151 :   pari_stack_init(&s_lvar,sizeof(*localvars),(void **)&localvars);
     121      427053 :   pari_stack_init(&s_dbginfo,sizeof(*dbginfo),(void **)&dbginfo);
     122      426969 :   pari_stack_init(&s_frame,sizeof(*frames),(void **)&frames);
     123      426986 :   offset=-1;
     124      426986 : }
     125             : void
     126      424954 : pari_close_compiler(void)
     127             : {
     128      424954 :   pari_stack_delete(&s_opcode);
     129      424266 :   pari_stack_delete(&s_operand);
     130      423959 :   pari_stack_delete(&s_data);
     131      424249 :   pari_stack_delete(&s_lvar);
     132      423713 :   pari_stack_delete(&s_dbginfo);
     133      423771 :   pari_stack_delete(&s_frame);
     134      423893 : }
     135             : 
     136             : struct codepos
     137             : {
     138             :   long opcode, data, localvars, frames;
     139             :   long offset;
     140             :   const char *dbgstart;
     141             : };
     142             : 
     143             : static void
     144     8913120 : getcodepos(struct codepos *pos)
     145             : {
     146     8913120 :   pos->opcode=s_opcode.n;
     147     8913120 :   pos->data=s_data.n;
     148     8913120 :   pos->offset=offset;
     149     8913120 :   pos->localvars=s_lvar.n;
     150     8913120 :   pos->dbgstart=dbgstart;
     151     8913120 :   pos->frames=s_frame.n;
     152     8913120 :   offset=s_data.n-1;
     153     8913120 : }
     154             : 
     155             : void
     156         312 : compilestate_reset(void)
     157             : {
     158         312 :   s_opcode.n=0;
     159         312 :   s_operand.n=0;
     160         312 :   s_dbginfo.n=0;
     161         312 :   s_data.n=0;
     162         312 :   s_lvar.n=0;
     163         312 :   s_frame.n=0;
     164         312 :   offset=-1;
     165         312 :   dbgstart=NULL;
     166         312 : }
     167             : 
     168             : void
     169     1373903 : compilestate_save(struct pari_compilestate *comp)
     170             : {
     171     1373903 :   comp->opcode=s_opcode.n;
     172     1373903 :   comp->operand=s_operand.n;
     173     1373903 :   comp->data=s_data.n;
     174     1373903 :   comp->offset=offset;
     175     1373903 :   comp->localvars=s_lvar.n;
     176     1373903 :   comp->dbgstart=dbgstart;
     177     1373903 :   comp->dbginfo=s_dbginfo.n;
     178     1373903 :   comp->frames=s_frame.n;
     179     1373903 : }
     180             : 
     181             : void
     182       44200 : compilestate_restore(struct pari_compilestate *comp)
     183             : {
     184       44200 :   s_opcode.n=comp->opcode;
     185       44200 :   s_operand.n=comp->operand;
     186       44200 :   s_data.n=comp->data;
     187       44200 :   offset=comp->offset;
     188       44200 :   s_lvar.n=comp->localvars;
     189       44200 :   dbgstart=comp->dbgstart;
     190       44200 :   s_dbginfo.n=comp->dbginfo;
     191       44200 :   s_frame.n=comp->frames;
     192       44200 : }
     193             : 
     194             : static GEN
     195    10758065 : gcopyunclone(GEN x) { GEN y = gcopy(x); gunclone(x); return y; }
     196             : 
     197             : static GEN
     198     8913086 : getfunction(const struct codepos *pos, long arity, long nbmvar, GEN text,
     199             :             long gap)
     200             : {
     201     8913086 :   long lop  = s_opcode.n+1 - pos->opcode;
     202     8913086 :   long ldat = s_data.n+1 - pos->data;
     203     8913086 :   long lfram = s_frame.n+1 - pos->frames;
     204     8913086 :   GEN cl = cgetg(nbmvar? 8: (text? 7: 6), t_CLOSURE);
     205             :   GEN frpc, fram, dbg, op, dat;
     206             :   char *s;
     207             :   long i;
     208             : 
     209     8913084 :   cl[1] = arity;
     210     8913084 :   gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
     211     8913084 :   gel(cl,3) = op = cgetg(lop, t_VECSMALL);
     212     8913086 :   gel(cl,4) = dat = cgetg(ldat, t_VEC);
     213     8913086 :   dbg = cgetg(lop,  t_VECSMALL);
     214     8913085 :   frpc = cgetg(lfram,  t_VECSMALL);
     215     8913085 :   fram = cgetg(lfram,  t_VEC);
     216     8913086 :   gel(cl,5) = mkvec3(dbg, frpc, fram);
     217     8913087 :   if (text) gel(cl,6) = text;
     218     8913087 :   if (nbmvar) gel(cl,7) = zerovec(nbmvar);
     219     8913087 :   s = GSTR(gel(cl,2)) - 1;
     220    82866717 :   for (i = 1; i < lop; i++)
     221             :   {
     222    73953630 :     long j = i+pos->opcode-1;
     223    73953630 :     s[i] = opcode[j];
     224    73953630 :     op[i] = operand[j];
     225    73953630 :     dbg[i] = dbginfo[j] - dbgstart;
     226    73953630 :     if (dbg[i] < 0) dbg[i] += gap;
     227             :   }
     228     8913087 :   s[i] = 0;
     229     8913087 :   s_opcode.n = pos->opcode;
     230     8913087 :   s_operand.n = pos->opcode;
     231     8913087 :   s_dbginfo.n = pos->opcode;
     232    10863143 :   for (i = 1; i < ldat; i++)
     233     1950056 :     if (data[i+pos->data-1]) gel(dat,i) = gcopyunclone(data[i+pos->data-1]);
     234     8913087 :   s_data.n = pos->data;
     235     8913087 :   while (s_lvar.n > pos->localvars && !localvars[s_lvar.n-1].inl) s_lvar.n--;
     236    17721093 :   for (i = 1; i < lfram; i++)
     237             :   {
     238     8808008 :     long j = i+pos->frames-1;
     239     8808008 :     frpc[i] = frames[j].pc - pos->opcode+1;
     240     8808008 :     gel(fram, i) = gcopyunclone(frames[j].frame);
     241             :   }
     242     8913085 :   s_frame.n = pos->frames;
     243     8913085 :   offset = pos->offset;
     244     8913085 :   dbgstart = pos->dbgstart;
     245     8913085 :   return cl;
     246             : }
     247             : 
     248             : static GEN
     249       15571 : getclosure(struct codepos *pos)
     250             : {
     251       15571 :   return getfunction(pos,0,0,NULL,0);
     252             : }
     253             : 
     254             : static void
     255    73951909 : op_push_loc(op_code o, long x, const char *loc)
     256             : {
     257    73951909 :   long n=pari_stack_new(&s_opcode);
     258    73951914 :   long m=pari_stack_new(&s_operand);
     259    73951913 :   long d=pari_stack_new(&s_dbginfo);
     260    73951909 :   opcode[n]=o;
     261    73951909 :   operand[m]=x;
     262    73951909 :   dbginfo[d]=loc;
     263    73951909 : }
     264             : 
     265             : static void
     266    29365819 : op_push(op_code o, long x, long n)
     267             : {
     268    29365819 :   op_push_loc(o,x,tree[n].str);
     269    29365819 : }
     270             : 
     271             : static void
     272        1764 : op_insert_loc(long k, op_code o, long x, const char *loc)
     273             : {
     274             :   long i;
     275        1764 :   long n=pari_stack_new(&s_opcode);
     276        1764 :   (void) pari_stack_new(&s_operand);
     277        1764 :   (void) pari_stack_new(&s_dbginfo);
     278      362461 :   for (i=n-1; i>=k; i--)
     279             :   {
     280      360697 :     opcode[i+1] = opcode[i];
     281      360697 :     operand[i+1]= operand[i];
     282      360697 :     dbginfo[i+1]= dbginfo[i];
     283             :   }
     284        1764 :   opcode[k]  = o;
     285        1764 :   operand[k] = x;
     286        1764 :   dbginfo[k] = loc;
     287        1764 : }
     288             : 
     289             : static long
     290     1950056 : data_push(GEN x)
     291             : {
     292     1950056 :   long n=pari_stack_new(&s_data);
     293     1950056 :   data[n] = x?gclone(x):x;
     294     1950056 :   return n-offset;
     295             : }
     296             : 
     297             : static void
     298       56268 : var_push(entree *ep, Ltype type)
     299             : {
     300       56268 :   long n=pari_stack_new(&s_lvar);
     301       56268 :   localvars[n].ep   = ep;
     302       56268 :   localvars[n].inl  = 0;
     303       56268 :   localvars[n].type = type;
     304       56268 : }
     305             : 
     306             : static void
     307     8808006 : frame_push(GEN x)
     308             : {
     309     8808006 :   long n=pari_stack_new(&s_frame);
     310     8808008 :   frames[n].pc = s_opcode.n-1;
     311     8808008 :   frames[n].frame = gclone(x);
     312     8808007 : }
     313             : 
     314             : static GEN
     315          42 : pack_localvars(void)
     316             : {
     317          42 :   GEN pack=cgetg(3,t_VEC);
     318          42 :   long i,l=s_lvar.n;
     319          42 :   GEN t=cgetg(1+l,t_VECSMALL);
     320          42 :   GEN e=cgetg(1+l,t_VECSMALL);
     321          42 :   gel(pack,1)=t;
     322          42 :   gel(pack,2)=e;
     323          98 :   for(i=1;i<=l;i++)
     324             :   {
     325          56 :     t[i]=localvars[i-1].type;
     326          56 :     e[i]=(long)localvars[i-1].ep;
     327             :   }
     328          42 :   return pack;
     329             : }
     330             : 
     331             : void
     332         231 : push_frame(GEN C, long lpc, long dummy)
     333             : {
     334         231 :   const char *code=closure_codestr(C);
     335         231 :   GEN oper=closure_get_oper(C);
     336         231 :   GEN dbg=closure_get_dbg(C);
     337         231 :   GEN frpc=gel(dbg,2);
     338         231 :   GEN fram=gel(dbg,3);
     339         231 :   long pc, j=1, lfr = lg(frpc);
     340         231 :   if (lpc==-1)
     341             :   {
     342             :     long k;
     343          49 :     GEN e = gel(fram, 1);
     344          98 :     for(k=1; k<lg(e); k++)
     345          49 :       var_push(dummy?NULL:(entree*)e[k], Lmy);
     346          49 :     return;
     347             :   }
     348         182 :   if (lg(C)<8) while (j<lfr && frpc[j]==0) j++;
     349        1512 :   for(pc=0; pc<lpc; pc++) /* do not assume lpc was completed */
     350             :   {
     351        1330 :     if (pc>0 && (code[pc]==OClocalvar || code[pc]==OClocalvar0))
     352           0 :       var_push((entree*)oper[pc],Llocal);
     353        1330 :     if (j<lfr && pc==frpc[j])
     354             :     {
     355             :       long k;
     356         126 :       GEN e = gel(fram,j);
     357         322 :       for(k=1; k<lg(e); k++)
     358         196 :         var_push(dummy?NULL:(entree*)e[k], Lmy);
     359         126 :       j++;
     360             :     }
     361             :   }
     362             : }
     363             : 
     364             : void
     365           0 : debug_context(void)
     366             : {
     367             :   long i;
     368           0 :   for(i=0;i<s_lvar.n;i++)
     369             :   {
     370           0 :     entree *ep = localvars[i].ep;
     371           0 :     Ltype type = localvars[i].type;
     372           0 :     err_printf("%ld: %s: %s\n",i,(type==Lmy?"my":"local"),(ep?ep->name:"NULL"));
     373             :   }
     374           0 : }
     375             : 
     376             : GEN
     377       10738 : localvars_read_str(const char *x, GEN pack)
     378             : {
     379       10738 :   pari_sp av = avma;
     380             :   GEN code;
     381       10738 :   long l=0;
     382       10738 :   if (pack)
     383             :   {
     384       10738 :     GEN t=gel(pack,1);
     385       10738 :     GEN e=gel(pack,2);
     386             :     long i;
     387       10738 :     l=lg(t)-1;
     388       46088 :     for(i=1;i<=l;i++)
     389       35350 :       var_push((entree*)e[i],(Ltype)t[i]);
     390             :   }
     391       10738 :   code = compile_str(x);
     392       10731 :   s_lvar.n -= l;
     393       10731 :   return gerepileupto(av, closure_evalres(code));
     394             : }
     395             : 
     396             : long
     397           7 : localvars_find(GEN pack, entree *ep)
     398             : {
     399           7 :   GEN t=gel(pack,1);
     400           7 :   GEN e=gel(pack,2);
     401             :   long i;
     402           7 :   long vn=0;
     403           7 :   for(i=lg(e)-1;i>=1;i--)
     404             :   {
     405           0 :     if(t[i]==Lmy)
     406           0 :       vn--;
     407           0 :     if(e[i]==(long)ep)
     408           0 :       return t[i]==Lmy?vn:0;
     409             :   }
     410           7 :   return 0;
     411             : }
     412             : 
     413             : /*
     414             :  Flags for copy optimisation:
     415             :  -- Freturn: The result will be returned.
     416             :  -- FLsurvive: The result must survive the closure.
     417             :  -- FLnocopy: The result will never be updated nor part of a user variable.
     418             :  -- FLnocopylex: The result will never be updated nor part of dynamic variable.
     419             : */
     420             : enum FLflag {FLreturn=1, FLsurvive=2, FLnocopy=4, FLnocopylex=8};
     421             : 
     422             : static void
     423      189722 : addcopy(long n, long mode, long flag, long mask)
     424             : {
     425      189722 :   if (mode==Ggen && !(flag&mask))
     426             :   {
     427       19534 :     op_push(OCcopy,0,n);
     428       19534 :     if (!(flag&FLsurvive) && DEBUGLEVEL)
     429           0 :       pari_warn(warner,"compiler generates copy for `%.*s'",
     430           0 :                        tree[n].len,tree[n].str);
     431             :   }
     432      189722 : }
     433             : 
     434             : static void compilenode(long n, int mode, long flag);
     435             : 
     436             : typedef enum {PPend,PPstd,PPdefault,PPdefaultmulti,PPstar,PPauto} PPproto;
     437             : 
     438             : static PPproto
     439   139227045 : parseproto(char const **q, char *c, const char *str)
     440             : {
     441   139227045 :   char  const *p=*q;
     442             :   long i;
     443   139227045 :   switch(*p)
     444             :   {
     445             :   case 0:
     446             :   case '\n':
     447    29967842 :     return PPend;
     448             :   case 'D':
     449      169514 :     switch(p[1])
     450             :     {
     451             :     case 0:
     452           0 :       compile_err("function has incomplete prototype",str);
     453             :     case 'G':
     454             :     case '&':
     455             :     case 'W':
     456             :     case 'V':
     457             :     case 'I':
     458             :     case 'E':
     459             :     case 'J':
     460             :     case 'n':
     461             :     case 'P':
     462             :     case 'r':
     463             :     case 's':
     464      110626 :       *c=p[1];
     465      110626 :       *q=p+2;
     466      110626 :       return PPdefault;
     467             :     default:
     468       58888 :       for(i=0;*p && i<2;p++) i+=*p==',';
     469       58888 :       if (i<2)
     470           0 :         compile_err("function has incomplete prototype",str);
     471       58888 :       *c=p[-2];
     472       58888 :       *q=p;
     473       58888 :       return PPdefaultmulti;
     474             :     }
     475             :     break;
     476             :   case 'C':
     477             :   case 'p':
     478             :   case 'b':
     479             :   case 'P':
     480             :   case 'f':
     481       95426 :     *c=*p;
     482       95426 :     *q=p+1;
     483       95426 :     return PPauto;
     484             :   case '&':
     485        1148 :     *c='*';
     486        1148 :     *q=p+1;
     487        1148 :     return PPstd;
     488             :   case 'V':
     489       14382 :     if (p[1]=='=')
     490             :     {
     491       10722 :       if (p[2]!='G')
     492           0 :         compile_err("function prototype is not supported",str);
     493       10722 :       *c='=';
     494       10722 :       p+=2;
     495             :     }
     496             :     else
     497        3660 :       *c=*p;
     498       14382 :     *q=p+1;
     499       14382 :     return PPstd;
     500             :   case 'E':
     501             :   case 's':
     502       34398 :     if (p[1]=='*')
     503             :     {
     504       22463 :       *c=*p++;
     505       22463 :       *q=p+1;
     506       22463 :       return PPstar;
     507             :     }
     508             :     /*fall through*/
     509             :   }
     510   108956270 :   *c=*p;
     511   108956270 :   *q=p+1;
     512   108956270 :   return PPstd;
     513             : }
     514             : 
     515             : static long
     516      301282 : detag(long n)
     517             : {
     518      602564 :   while (tree[n].f==Ftag)
     519           0 :     n=tree[n].x;
     520      301282 :   return n;
     521             : }
     522             : 
     523             : /* return type for GP functions */
     524             : static op_code
     525    12399073 : get_ret_type(const char **p, long arity, Gtype *t, long *flag)
     526             : {
     527    12399073 :   *flag = 0;
     528    12399073 :   if (**p == 'v') { (*p)++; *t=Gvoid; return OCcallvoid; }
     529    12364258 :   else if (**p == 'i') { (*p)++; *t=Gsmall;  return OCcallint; }
     530    12359547 :   else if (**p == 'l') { (*p)++; *t=Gsmall;  return OCcalllong; }
     531    12339616 :   else if (**p == 'u') { (*p)++; *t=Gusmall; return OCcalllong; }
     532    12339616 :   else if (**p == 'm') { (*p)++; *flag = FLnocopy; }
     533    12339616 :   *t=Ggen; return arity==2?OCcallgen2:OCcallgen;
     534             : }
     535             : 
     536             : /*supported types:
     537             :  * type: Gusmall, Gsmall, Ggen, Gvoid, Gvec, Gclosure
     538             :  * mode: Gusmall, Gsmall, Ggen, Gvar, Gvoid
     539             :  */
     540             : static void
     541    14564928 : compilecast_loc(int type, int mode, const char *loc)
     542             : {
     543    14564928 :   if (type==mode) return;
     544     3891793 :   switch (mode)
     545             :   {
     546             :   case Gusmall:
     547          98 :     if (type==Ggen)        op_push_loc(OCitou,-1,loc);
     548          77 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     549          77 :     else if (type!=Gsmall)
     550           0 :       compile_err("this should be a small integer >=0",loc);
     551          98 :     break;
     552             :   case Gsmall:
     553        4104 :     if (type==Ggen)        op_push_loc(OCitos,-1,loc);
     554           7 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     555           7 :     else if (type!=Gusmall)
     556           7 :       compile_err("this should be a small integer",loc);
     557        4097 :     break;
     558             :   case Ggen:
     559     3876788 :     if (type==Gsmall)      op_push_loc(OCstoi,0,loc);
     560     3865987 :     else if (type==Gusmall)op_push_loc(OCutoi,0,loc);
     561     3865987 :     else if (type==Gvoid)  op_push_loc(OCpushgnil,0,loc);
     562     3876788 :     break;
     563             :   case Gvoid:
     564        7730 :     op_push_loc(OCpop, 1,loc);
     565        7730 :     break;
     566             :   case Gvar:
     567        3073 :     if (type==Ggen)        op_push_loc(OCvarn,-1,loc);
     568           7 :     else compile_varerr(loc);
     569        3066 :      break;
     570             :   default:
     571           0 :     pari_err_BUG("compilecast [unknown type]");
     572             :   }
     573             : }
     574             : 
     575             : static void
     576     5774338 : compilecast(long n, int type, int mode) { compilecast_loc(type, mode, tree[n].str); }
     577             : 
     578             : static entree *
     579       22533 : fetch_member_raw(const char *s, long len)
     580             : {
     581       22533 :   pari_sp av = avma;
     582       22533 :   char *t = stack_malloc(len+2);
     583             :   entree *ep;
     584       22533 :   t[0] = '_'; strncpy(t+1, s, len); t[++len] = 0; /* prepend '_' */
     585       22533 :   ep = fetch_entry_raw(t, len);
     586       22533 :   set_avma(av); return ep;
     587             : }
     588             : static entree *
     589     5894966 : getfunc(long n)
     590             : {
     591     5894966 :   long x=tree[n].x;
     592     5894966 :   if (tree[x].x==CSTmember) /* str-1 points to '.' */
     593       22533 :     return do_alias(fetch_member_raw(tree[x].str - 1, tree[x].len + 1));
     594             :   else
     595     5872433 :     return do_alias(fetch_entry_raw(tree[x].str, tree[x].len));
     596             : }
     597             : 
     598             : static entree *
     599      254770 : getentry(long n)
     600             : {
     601      254770 :   n = detag(n);
     602      254770 :   if (tree[n].f!=Fentry)
     603             :   {
     604          21 :     if (tree[n].f==Fseq)
     605           0 :       compile_err("unexpected character: ';'", tree[tree[n].y].str-1);
     606          21 :     compile_varerr(tree[n].str);
     607             :   }
     608      254749 :   return getfunc(n);
     609             : }
     610             : 
     611             : /* match Fentry that are not actually EpSTATIC functions called without parens*/
     612             : static entree *
     613       57155 : getvar(long n)
     614             : {
     615       57155 :   entree *ep = getentry(n);
     616       57134 :   if (EpSTATIC(do_alias(ep)))
     617           0 :     compile_varerr(tree[n].str);
     618       57134 :   return ep;
     619             : }
     620             : 
     621             : static long
     622      249968 : getmvar(entree *ep)
     623             : {
     624             :   long i;
     625      249968 :   long vn=0;
     626      621162 :   for(i=s_lvar.n-1;i>=0;i--)
     627             :   {
     628      433692 :     if(localvars[i].type==Lmy)
     629      433482 :       vn--;
     630      433692 :     if(localvars[i].ep==ep)
     631       62498 :       return localvars[i].type==Lmy?vn:0;
     632             :   }
     633      187470 :   return 0;
     634             : }
     635             : 
     636             : static long
     637        7888 : ctxmvar(void)
     638             : {
     639        7888 :   pari_sp av=avma;
     640        7888 :   long i, n=0;
     641             :   GEN ctx;
     642       70250 :   for(i=s_lvar.n-1;i>=0;i--)
     643       62362 :     if(localvars[i].type==Lmy)
     644       62362 :       n++;
     645        7888 :   if (n==0) return 0;
     646        3812 :   ctx = cgetg(n+1,t_VECSMALL);
     647       66174 :   for(n=0, i=0; i<s_lvar.n; i++)
     648       62362 :     if(localvars[i].type==Lmy)
     649       62362 :       ctx[++n]=(long)localvars[i].ep;
     650        3812 :   frame_push(ctx);
     651        3812 :   set_avma(av); return n;
     652             : }
     653             : 
     654             : INLINE int
     655    30828315 : is_func_named(entree *ep, const char *s)
     656             : {
     657    30828315 :   return !strcmp(ep->name, s);
     658             : }
     659             : 
     660             : INLINE int
     661        2935 : is_node_zero(long n)
     662             : {
     663        2935 :   n = detag(n);
     664        2935 :   return (tree[n].f==Fsmall && tree[n].x==0);
     665             : }
     666             : 
     667             : static void
     668           7 : str_defproto(const char *p, const char *q, const char *loc)
     669             : {
     670           7 :   long len = p-4-q;
     671           7 :   if (q[1]!='"' || q[len]!='"')
     672           0 :     compile_err("default argument must be a string",loc);
     673           7 :   op_push_loc(OCpushgen,data_push(strntoGENexp(q+1,len)),loc);
     674           7 : }
     675             : 
     676             : static long
     677    13446031 : countlisttogen(long n, Ffunc f)
     678             : {
     679             :   long x,i;
     680    13446031 :   if (n==-1 || tree[n].f==Fnoarg) return 0;
     681    12349716 :   for(x=n, i=0; tree[x].f==f ;x=tree[x].x, i++);
     682    12349716 :   return i+1;
     683             : }
     684             : 
     685             : static GEN
     686    13445758 : listtogen(long n, Ffunc f)
     687             : {
     688    13445758 :   long x,i,nb = countlisttogen(n, f);
     689    13445758 :   GEN z=cgetg(nb+1, t_VECSMALL);
     690    13445758 :   if (nb)
     691             :   {
     692    12349443 :     for (x=n, i = nb-1; i>0; z[i+1]=tree[x].y, x=tree[x].x, i--);
     693    12349443 :     z[1]=x;
     694             :   }
     695    13445758 :   return z;
     696             : }
     697             : 
     698             : static long
     699     5656428 : first_safe_arg(GEN arg, long mask)
     700             : {
     701     5656428 :   long lnc, l=lg(arg);
     702     5656428 :   for (lnc=l-1; lnc>0 && (tree[arg[lnc]].flags&mask)==mask; lnc--);
     703     5656428 :   return lnc;
     704             : }
     705             : 
     706             : static void
     707       15134 : checkdups(GEN arg, GEN vep)
     708             : {
     709       15134 :   long l=vecsmall_duplicate(vep);
     710       15134 :   if (l!=0) compile_err("variable declared twice",tree[arg[l]].str);
     711       15134 : }
     712             : 
     713             : enum {MAT_range,MAT_std,MAT_line,MAT_column,VEC_std};
     714             : 
     715             : static int
     716       11275 : matindex_type(long n)
     717             : {
     718       11275 :   long x = tree[n].x, y = tree[n].y;
     719       11275 :   long fxx = tree[tree[x].x].f, fxy = tree[tree[x].y].f;
     720       11275 :   if (y==-1)
     721             :   {
     722        9777 :     if (fxy!=Fnorange) return MAT_range;
     723        9399 :     if (fxx==Fnorange) compile_err("missing index",tree[n].str);
     724        9399 :     return VEC_std;
     725             :   }
     726             :   else
     727             :   {
     728        1498 :     long fyx = tree[tree[y].x].f, fyy = tree[tree[y].y].f;
     729        1498 :     if (fxy!=Fnorange || fyy!=Fnorange) return MAT_range;
     730        1351 :     if (fxx==Fnorange && fyx==Fnorange)
     731           0 :       compile_err("missing index",tree[n].str);
     732        1351 :     if (fxx==Fnorange) return MAT_column;
     733         672 :     if (fyx==Fnorange) return MAT_line;
     734         441 :     return MAT_std;
     735             :   }
     736             : }
     737             : 
     738             : static entree *
     739       32962 : getlvalue(long n)
     740             : {
     741       66652 :   while ((tree[n].f==Fmatcoeff && matindex_type(tree[n].y)!=MAT_range) || tree[n].f==Ftag)
     742         728 :     n=tree[n].x;
     743       32962 :   return getvar(n);
     744             : }
     745             : 
     746             : INLINE void
     747       30687 : compilestore(long vn, entree *ep, long n)
     748             : {
     749       30687 :   if (vn)
     750        3450 :     op_push(OCstorelex,vn,n);
     751             :   else
     752       27237 :     op_push(OCstoredyn,(long)ep,n);
     753       30687 : }
     754             : 
     755             : INLINE void
     756         623 : compilenewptr(long vn, entree *ep, long n)
     757             : {
     758         623 :   if (vn)
     759         231 :     op_push(OCnewptrlex,vn,n);
     760             :   else
     761         392 :     op_push(OCnewptrdyn,(long)ep,n);
     762         623 : }
     763             : 
     764             : static void
     765        1344 : compilelvalue(long n)
     766             : {
     767        1344 :   n = detag(n);
     768        1344 :   if (tree[n].f==Fentry)
     769         623 :     return;
     770             :   else
     771             :   {
     772         721 :     long x = tree[n].x, y = tree[n].y;
     773         721 :     long yx = tree[y].x, yy = tree[y].y;
     774         721 :     long m = matindex_type(y);
     775         721 :     if (m == MAT_range)
     776           0 :       compile_err("not an lvalue",tree[n].str);
     777         721 :     if (m == VEC_std && tree[x].f==Fmatcoeff)
     778             :     {
     779          70 :       int mx = matindex_type(tree[x].y);
     780          70 :       if (mx==MAT_line)
     781             :       {
     782           0 :         int xy = tree[x].y, xyx = tree[xy].x;
     783           0 :         compilelvalue(tree[x].x);
     784           0 :         compilenode(tree[xyx].x,Gsmall,0);
     785           0 :         compilenode(tree[yx].x,Gsmall,0);
     786           0 :         op_push(OCcompo2ptr,0,y);
     787           0 :         return;
     788             :       }
     789             :     }
     790         721 :     compilelvalue(x);
     791         721 :     switch(m)
     792             :     {
     793             :     case VEC_std:
     794         427 :       compilenode(tree[yx].x,Gsmall,0);
     795         427 :       op_push(OCcompo1ptr,0,y);
     796         427 :       break;
     797             :     case MAT_std:
     798         112 :       compilenode(tree[yx].x,Gsmall,0);
     799         112 :       compilenode(tree[yy].x,Gsmall,0);
     800         112 :       op_push(OCcompo2ptr,0,y);
     801         112 :       break;
     802             :     case MAT_line:
     803          91 :       compilenode(tree[yx].x,Gsmall,0);
     804          91 :       op_push(OCcompoLptr,0,y);
     805          91 :       break;
     806             :     case MAT_column:
     807          91 :       compilenode(tree[yy].x,Gsmall,0);
     808          91 :       op_push(OCcompoCptr,0,y);
     809          91 :       break;
     810             :     }
     811             :   }
     812             : }
     813             : 
     814             : static void
     815        9756 : compilematcoeff(long n, int mode)
     816             : {
     817        9756 :   long x=tree[n].x, y=tree[n].y;
     818        9756 :   long yx=tree[y].x, yy=tree[y].y;
     819        9756 :   long m=matindex_type(y);
     820        9756 :   compilenode(x,Ggen,FLnocopy);
     821        9756 :   switch(m)
     822             :   {
     823             :   case VEC_std:
     824        8468 :     compilenode(tree[yx].x,Gsmall,0);
     825        8468 :     op_push(OCcompo1,mode,y);
     826        8468 :     return;
     827             :   case MAT_std:
     828         217 :     compilenode(tree[yx].x,Gsmall,0);
     829         217 :     compilenode(tree[yy].x,Gsmall,0);
     830         217 :     op_push(OCcompo2,mode,y);
     831         217 :     return;
     832             :   case MAT_line:
     833          49 :     compilenode(tree[yx].x,Gsmall,0);
     834          49 :     op_push(OCcompoL,0,y);
     835          49 :     compilecast(n,Gvec,mode);
     836          49 :     return;
     837             :   case MAT_column:
     838         497 :     compilenode(tree[yy].x,Gsmall,0);
     839         497 :     op_push(OCcompoC,0,y);
     840         497 :     compilecast(n,Gvec,mode);
     841         497 :     return;
     842             :   case MAT_range:
     843         525 :     compilenode(tree[yx].x,Gsmall,0);
     844         525 :     compilenode(tree[yx].y,Gsmall,0);
     845         525 :     if (yy==-1)
     846         378 :       op_push(OCcallgen,(long)is_entry("_[_.._]"),n);
     847             :     else
     848             :     {
     849         147 :       compilenode(tree[yy].x,Gsmall,0);
     850         147 :       compilenode(tree[yy].y,Gsmall,0);
     851         147 :       op_push(OCcallgen,(long)is_entry("_[_.._,_.._]"),n);
     852             :     }
     853         525 :     compilecast(n,Gvec,mode);
     854         518 :     return;
     855             :   default:
     856           0 :     pari_err_BUG("compilematcoeff");
     857             :   }
     858             : }
     859             : 
     860             : static void
     861     6921482 : compilesmall(long n, long x, long mode)
     862             : {
     863     6921482 :   if (mode==Ggen)
     864     6852594 :     op_push(OCpushstoi, x, n);
     865             :   else
     866             :   {
     867       68888 :     if (mode==Gusmall && x < 0)
     868           0 :       compile_err("this should be a small integer >=0",tree[n].str);
     869       68888 :     op_push(OCpushlong, x, n);
     870       68888 :     compilecast(n,Gsmall,mode);
     871             :   }
     872     6921475 : }
     873             : 
     874             : static void
     875     3837807 : compilevec(long n, long mode, op_code op)
     876             : {
     877     3837807 :   pari_sp ltop=avma;
     878     3837807 :   long x=tree[n].x;
     879             :   long i;
     880     3837807 :   GEN arg=listtogen(x,Fmatrixelts);
     881     3837807 :   long l=lg(arg);
     882     3837807 :   op_push(op,l,n);
     883    15968956 :   for (i=1;i<l;i++)
     884             :   {
     885    12131149 :     compilenode(arg[i],Ggen,FLsurvive);
     886    12131149 :     op_push(OCstackgen,i,n);
     887             :   }
     888     3837807 :   set_avma(ltop);
     889     3837807 :   op_push(OCpop,1,n);
     890     3837807 :   compilecast(n,Gvec,mode);
     891     3837807 : }
     892             : 
     893             : static void
     894        8617 : compilemat(long n, long mode)
     895             : {
     896        8617 :   pari_sp ltop=avma;
     897        8617 :   long x=tree[n].x;
     898             :   long i,j;
     899        8617 :   GEN line=listtogen(x,Fmatrixlines);
     900        8617 :   long lglin = lg(line), lgcol=0;
     901        8617 :   op_push(OCpushlong, lglin,n);
     902        8617 :   if (lglin==1)
     903         805 :     op_push(OCmat,1,n);
     904       44366 :   for(i=1;i<lglin;i++)
     905             :   {
     906       35749 :     GEN col=listtogen(line[i],Fmatrixelts);
     907       35749 :     long l=lg(col), k;
     908       35749 :     if (i==1)
     909             :     {
     910        7812 :       lgcol=l;
     911        7812 :       op_push(OCmat,lgcol,n);
     912             :     }
     913       27937 :     else if (l!=lgcol)
     914           0 :       compile_err("matrix must be rectangular",tree[line[i]].str);
     915       35749 :     k=i;
     916      274169 :     for(j=1;j<lgcol;j++)
     917             :     {
     918      238420 :       k-=lglin;
     919      238420 :       compilenode(col[j], Ggen, FLsurvive);
     920      238420 :       op_push(OCstackgen,k,n);
     921             :     }
     922             :   }
     923        8617 :   set_avma(ltop);
     924        8617 :   op_push(OCpop,1,n);
     925        8617 :   compilecast(n,Gvec,mode);
     926        8617 : }
     927             : 
     928             : 
     929             : static GEN
     930       37240 : cattovec(long n, long fnum)
     931             : {
     932       37240 :   long x=n, y, i=0, nb;
     933             :   GEN stack;
     934       37240 :   if (tree[n].f==Fnoarg) return cgetg(1,t_VECSMALL);
     935             :   while(1)
     936         224 :   {
     937       37464 :     long xx=tree[x].x;
     938       37464 :     long xy=tree[x].y;
     939       37464 :     if (tree[x].f!=Ffunction || xx!=fnum) break;
     940         224 :     x=tree[xy].x;
     941         224 :     y=tree[xy].y;
     942         224 :     if (tree[y].f==Fnoarg)
     943           0 :       compile_err("unexpected character: ", tree[y].str);
     944         224 :     i++;
     945             :   }
     946       37240 :   if (tree[x].f==Fnoarg)
     947           0 :     compile_err("unexpected character: ", tree[x].str);
     948       37240 :   nb=i+1;
     949       37240 :   stack=cgetg(nb+1,t_VECSMALL);
     950       37464 :   for(x=n;i>0;i--)
     951             :   {
     952         224 :     long y=tree[x].y;
     953         224 :     x=tree[y].x;
     954         224 :     stack[i+1]=tree[y].y;
     955             :   }
     956       37240 :   stack[1]=x;
     957       37240 :   return stack;
     958             : }
     959             : 
     960             : static GEN
     961          28 : compilelambda(long n, long y, GEN vep, struct codepos *pos)
     962             : {
     963          28 :   long nbmvar, lev = vep ? lg(vep)-1 : 0;
     964          28 :   GEN text=cgetg(3,t_VEC);
     965          28 :   gel(text,1)=strtoGENstr(lev? ((entree*) vep[1])->name: "");
     966          28 :   gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
     967          28 :   dbgstart = tree[y].str;
     968          28 :   nbmvar=ctxmvar()-lev;
     969          28 :   if (lev) op_push(OCgetargs,lev,n);
     970          28 :   compilenode(y,Ggen,FLsurvive|FLreturn);
     971          28 :   return getfunction(pos,lev,nbmvar,text,2);
     972             : }
     973             : 
     974             : static void
     975       19720 : compilecall(long n, int mode, entree *ep)
     976             : {
     977       19720 :   pari_sp ltop=avma;
     978             :   long j;
     979       19720 :   long x=tree[n].x, tx = tree[x].x;
     980       19720 :   long y=tree[n].y;
     981       19720 :   GEN arg=listtogen(y,Flistarg);
     982       19720 :   long nb=lg(arg)-1;
     983       19720 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
     984       19720 :   long lnl=first_safe_arg(arg, COsafelex);
     985       19720 :   long fl = lnl==0? (lnc==0? FLnocopy: FLnocopylex): 0;
     986       19720 :   if (ep==NULL)
     987         315 :     compilenode(x, Ggen, fl);
     988             :   else
     989             :   {
     990       19405 :     long vn=getmvar(ep);
     991       19405 :     if (vn)
     992         404 :       op_push(OCpushlex,vn,n);
     993             :     else
     994       19001 :       op_push(OCpushdyn,(long)ep,n);
     995             :   }
     996       52856 :   for (j=1;j<=nb;j++)
     997             :   {
     998       33136 :     long x = tree[arg[j]].x, f = tree[arg[j]].f;
     999       33136 :     if (f==Fseq)
    1000           0 :       compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1001       33136 :     else if (f==Findarg)
    1002             :     {
    1003          63 :       compilenode(tree[arg[j]].x, Ggen,FLnocopy);
    1004          63 :       op_push(OClock,0,n);
    1005       33073 :     } else if (tx==CSTmember)
    1006             :     {
    1007          28 :       compilenode(arg[j], Ggen,FLnocopy);
    1008          28 :       op_push(OClock,0,n);
    1009             :     }
    1010       33045 :     else if (f!=Fnoarg)
    1011       32730 :       compilenode(arg[j], Ggen,j>=lnl?FLnocopylex:0);
    1012             :     else
    1013         315 :       op_push(OCpushlong,0,n);
    1014             :   }
    1015       19720 :   op_push(OCcalluser,nb,x);
    1016       19720 :   compilecast(n,Ggen,mode);
    1017       19720 :   set_avma(ltop);
    1018       19720 : }
    1019             : 
    1020             : static GEN
    1021       15522 : compilefuncinline(long n, long c, long a, long flag, long isif, long lev, long *ev)
    1022             : {
    1023             :   struct codepos pos;
    1024       15522 :   int type=c=='I'?Gvoid:Ggen;
    1025       15522 :   long rflag=c=='I'?0:FLsurvive;
    1026       15522 :   GEN vep = NULL;
    1027       15522 :   if (isif && (flag&FLreturn)) rflag|=FLreturn;
    1028       15522 :   getcodepos(&pos);
    1029       15522 :   if (lev)
    1030             :   {
    1031             :     long i;
    1032        8853 :     GEN varg=cgetg(lev+1,t_VECSMALL);
    1033        8853 :     vep=cgetg(lev+1,t_VECSMALL);
    1034       18042 :     for(i=0;i<lev;i++)
    1035             :     {
    1036             :       entree *ve;
    1037        9189 :       if (ev[i]<0)
    1038           0 :         compile_err("missing variable name", tree[a].str-1);
    1039        9189 :       ve = getvar(ev[i]);
    1040        9189 :       vep[i+1]=(long)ve;
    1041        9189 :       varg[i+1]=ev[i];
    1042        9189 :       var_push(ve,Lmy);
    1043             :     }
    1044        8853 :     checkdups(varg,vep);
    1045        8853 :     frame_push(vep);
    1046             :   }
    1047       15522 :   if (c=='J')
    1048          28 :     return compilelambda(n,a,vep,&pos);
    1049       15494 :   else if (tree[a].f==Fnoarg)
    1050         112 :     compilecast(a,Gvoid,type);
    1051             :   else
    1052       15382 :     compilenode(a,type,rflag);
    1053       15494 :   return getclosure(&pos);
    1054             : }
    1055             : 
    1056             : static long
    1057        2364 : countvar(GEN arg)
    1058             : {
    1059        2364 :   long i, l = lg(arg);
    1060        2364 :   long n = l-1;
    1061        7258 :   for(i=1; i<l; i++)
    1062             :   {
    1063        4894 :     long a=arg[i];
    1064        4894 :     if (tree[a].f==Fassign)
    1065             :     {
    1066        2809 :       long x = detag(tree[a].x);
    1067        2809 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1068         273 :         n += countlisttogen(tree[x].x,Fmatrixelts)-1;
    1069             :     }
    1070             :   }
    1071        2364 :   return n;
    1072             : }
    1073             : 
    1074             : static void
    1075           2 : compileuninline(GEN arg)
    1076             : {
    1077             :   long j;
    1078           2 :   if (lg(arg) > 1)
    1079           0 :     compile_err("too many arguments",tree[arg[1]].str);
    1080           6 :   for(j=0; j<s_lvar.n; j++)
    1081           4 :     if(!localvars[j].inl)
    1082           0 :       pari_err(e_MISC,"uninline is only valid at top level");
    1083           2 :   s_lvar.n = 0;
    1084           2 : }
    1085             : 
    1086             : static void
    1087        2357 : compilemy(GEN arg, const char *str, int inl)
    1088             : {
    1089        2357 :   long i, j, k, l = lg(arg);
    1090        2357 :   long n = countvar(arg);
    1091        2357 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1092        2357 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1093        2357 :   if (inl)
    1094             :   {
    1095           2 :     for(j=0; j<s_lvar.n; j++)
    1096           0 :       if(!localvars[j].inl)
    1097           0 :         pari_err(e_MISC,"inline is only valid at top level");
    1098             :   }
    1099        7216 :   for(k=0, i=1; i<l; i++)
    1100             :   {
    1101        4859 :     long a=arg[i];
    1102        4859 :     if (tree[a].f==Fassign)
    1103             :     {
    1104        2781 :       long x = detag(tree[a].x);
    1105        2781 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1106             :       {
    1107         266 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1108         266 :         long nv = lg(vars)-1;
    1109         882 :         for (j=1; j<=nv; j++)
    1110             :         {
    1111         616 :           ver[++k] = vars[j];
    1112         616 :           vep[k] = (long)getvar(ver[k]);
    1113             :         }
    1114         266 :         continue;
    1115        2515 :       } else ver[++k] = x;
    1116        2078 :     } else ver[++k] = a;
    1117        4593 :     vep[k] = (long)getvar(ver[k]);
    1118             :   }
    1119        2357 :   checkdups(ver,vep);
    1120        2357 :   for(i=1; i<=n; i++) var_push(NULL,Lmy);
    1121        2357 :   op_push_loc(OCnewframe,inl?-n:n,str);
    1122        2357 :   frame_push(vep);
    1123        7216 :   for (k=0, i=1; i<l; i++)
    1124             :   {
    1125        4859 :     long a=arg[i];
    1126        4859 :     if (tree[a].f==Fassign)
    1127             :     {
    1128        2781 :       long x = detag(tree[a].x);
    1129        2781 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1130             :       {
    1131         266 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1132         266 :         long nv = lg(vars)-1;
    1133         266 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1134         266 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1135         882 :         for (j=1; j<=nv; j++)
    1136             :         {
    1137         616 :           long v = detag(vars[j]);
    1138         616 :           op_push(OCpushlong,j,v);
    1139         616 :           op_push(OCcompo1,Ggen,v);
    1140         616 :           k++;
    1141         616 :           op_push(OCstorelex,-n+k-1,a);
    1142         616 :           localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1143         616 :           localvars[s_lvar.n-n+k-1].inl=inl;
    1144             :         }
    1145         266 :         continue;
    1146             :       }
    1147        2515 :       else if (!is_node_zero(tree[a].y))
    1148             :       {
    1149        2452 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1150        2452 :         op_push(OCstorelex,-n+k,a);
    1151             :       }
    1152             :     }
    1153        4593 :     k++;
    1154        4593 :     localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1155        4593 :     localvars[s_lvar.n-n+k-1].inl=inl;
    1156             :   }
    1157        2357 : }
    1158             : 
    1159             : static long
    1160          42 : localpush(op_code op, long a)
    1161             : {
    1162          42 :   entree *ep = getvar(a);
    1163          42 :   long vep  = (long) ep;
    1164          42 :   op_push(op,vep,a);
    1165          42 :   var_push(ep,Llocal);
    1166          42 :   return vep;
    1167             : }
    1168             : 
    1169             : static void
    1170           7 : compilelocal(GEN arg)
    1171             : {
    1172           7 :   long i, j, k, l = lg(arg);
    1173           7 :   long n = countvar(arg);
    1174           7 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1175           7 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1176          42 :   for(k=0, i=1; i<l; i++)
    1177             :   {
    1178          35 :     long a=arg[i];
    1179          35 :     if (tree[a].f==Fassign)
    1180             :     {
    1181          28 :       long x = detag(tree[a].x);
    1182          28 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1183             :       {
    1184           7 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1185           7 :         long nv = lg(vars)-1;
    1186           7 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1187           7 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1188          21 :         for (j=1; j<=nv; j++)
    1189             :         {
    1190          14 :           long v = detag(vars[j]);
    1191          14 :           op_push(OCpushlong,j,v);
    1192          14 :           op_push(OCcompo1,Ggen,v);
    1193          14 :           vep[++k] = localpush(OClocalvar, v);
    1194          14 :           ver[k] = v;
    1195             :         }
    1196           7 :         continue;
    1197          21 :       } else if (!is_node_zero(tree[a].y))
    1198             :       {
    1199          14 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1200          14 :         ver[++k] = x;
    1201          14 :         vep[k] = localpush(OClocalvar, ver[k]);
    1202          14 :         continue;
    1203             :       }
    1204             :       else
    1205           7 :         ver[++k] = x;
    1206             :     } else
    1207           7 :       ver[++k] = a;
    1208          14 :     vep[k] = localpush(OClocalvar0, ver[k]);
    1209             :   }
    1210           7 :   checkdups(ver,vep);
    1211           7 : }
    1212             : 
    1213             : static void
    1214           2 : compileexport(GEN arg)
    1215             : {
    1216           2 :   long i, l = lg(arg);
    1217           4 :   for (i=1; i<l; i++)
    1218             :   {
    1219           2 :     long a=arg[i];
    1220           2 :     if (tree[a].f==Fassign)
    1221             :     {
    1222           0 :       long x = detag(tree[a].x);
    1223           0 :       long v = (long) getvar(x);
    1224           0 :       compilenode(tree[a].y,Ggen,FLnocopy);
    1225           0 :       op_push(OCexportvar,v,x);
    1226             :     } else
    1227             :     {
    1228           2 :       long x = detag(a);
    1229           2 :       long v = (long) getvar(x);
    1230           2 :       op_push(OCpushdyn,v,x);
    1231           2 :       op_push(OCexportvar,v,x);
    1232             :     }
    1233             :   }
    1234           2 : }
    1235             : 
    1236             : static void
    1237           2 : compileunexport(GEN arg)
    1238             : {
    1239           2 :   long i, l = lg(arg);
    1240           4 :   for (i=1; i<l; i++)
    1241             :   {
    1242           2 :     long a = arg[i];
    1243           2 :     long x = detag(a);
    1244           2 :     long v = (long) getvar(x);
    1245           2 :     op_push(OCunexportvar,v,x);
    1246             :   }
    1247           2 : }
    1248             : 
    1249             : static void
    1250     2805673 : compilefunc(entree *ep, long n, int mode, long flag)
    1251             : {
    1252     2805673 :   pari_sp ltop=avma;
    1253             :   long j;
    1254     2805673 :   long x=tree[n].x, y=tree[n].y;
    1255             :   op_code ret_op;
    1256             :   long ret_flag;
    1257             :   Gtype ret_typ;
    1258             :   char const *p,*q;
    1259             :   char c;
    1260     2805673 :   const char *flags = NULL;
    1261             :   const char *str;
    1262             :   PPproto mod;
    1263     2805673 :   GEN arg=listtogen(y,Flistarg);
    1264     2805673 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
    1265     2805673 :   long lnl=first_safe_arg(arg, COsafelex);
    1266     2805673 :   long nbpointers=0, nbopcodes;
    1267     2805673 :   long nb=lg(arg)-1, lev=0;
    1268             :   long ev[20];
    1269     2805673 :   if (x>=OPnboperator)
    1270      145403 :     str=tree[x].str;
    1271             :   else
    1272             :   {
    1273     2660270 :     if (nb==2)
    1274      273127 :       str=tree[arg[1]].str+tree[arg[1]].len;
    1275     2387143 :     else if (nb==1)
    1276     2386422 :       str=tree[arg[1]].str;
    1277             :     else
    1278         721 :       str=tree[n].str;
    1279     2660270 :     while(*str==')') str++;
    1280             :   }
    1281     2805673 :   if (tree[n].f==Fassign)
    1282             :   {
    1283           0 :     nb=2; lnc=2; lnl=2; arg=mkvecsmall2(x,y);
    1284             :   }
    1285     2805673 :   else if (is_func_named(ep,"if"))
    1286             :   {
    1287        3673 :     if (nb>=4)
    1288         119 :       ep=is_entry("_multi_if");
    1289        3554 :     else if (mode==Gvoid)
    1290        2195 :       ep=is_entry("_void_if");
    1291             :   }
    1292     2802000 :   else if (is_func_named(ep,"return") && (flag&FLreturn) && nb<=1)
    1293             :   {
    1294          98 :     if (nb==0) op_push(OCpushgnil,0,n);
    1295          98 :     else compilenode(arg[1],Ggen,FLsurvive|FLreturn);
    1296          98 :     set_avma(ltop);
    1297          98 :     return;
    1298             :   }
    1299     2801902 :   else if (is_func_named(ep,"inline"))
    1300             :   {
    1301           2 :     compilemy(arg, str, 1);
    1302           2 :     compilecast(n,Gvoid,mode);
    1303           2 :     set_avma(ltop);
    1304           2 :     return;
    1305             :   }
    1306     2801900 :   else if (is_func_named(ep,"uninline"))
    1307             :   {
    1308           2 :     compileuninline(arg);
    1309           2 :     compilecast(n,Gvoid,mode);
    1310           2 :     set_avma(ltop);
    1311           2 :     return;
    1312             :   }
    1313     2801898 :   else if (is_func_named(ep,"my"))
    1314             :   {
    1315        2355 :     compilemy(arg, str, 0);
    1316        2355 :     compilecast(n,Gvoid,mode);
    1317        2355 :     set_avma(ltop);
    1318        2355 :     return;
    1319             :   }
    1320     2799543 :   else if (is_func_named(ep,"local"))
    1321             :   {
    1322           7 :     compilelocal(arg);
    1323           7 :     compilecast(n,Gvoid,mode);
    1324           7 :     set_avma(ltop);
    1325           7 :     return;
    1326             :   }
    1327     2799536 :   else if (is_func_named(ep,"export"))
    1328             :   {
    1329           2 :     compileexport(arg);
    1330           2 :     compilecast(n,Gvoid,mode);
    1331           2 :     set_avma(ltop);
    1332           2 :     return;
    1333             :   }
    1334     2799534 :   else if (is_func_named(ep,"unexport"))
    1335             :   {
    1336           2 :     compileunexport(arg);
    1337           2 :     compilecast(n,Gvoid,mode);
    1338           2 :     set_avma(ltop);
    1339           2 :     return;
    1340             :   }
    1341             :   /*We generate dummy code for global() for compatibility with gp2c*/
    1342     2799532 :   else if (is_func_named(ep,"global"))
    1343             :   {
    1344             :     long i;
    1345           0 :     for (i=1;i<=nb;i++)
    1346             :     {
    1347           0 :       long a=arg[i];
    1348             :       long en;
    1349           0 :       if (tree[a].f==Fassign)
    1350             :       {
    1351           0 :         compilenode(tree[a].y,Ggen,0);
    1352           0 :         a=tree[a].x;
    1353           0 :         en=(long)getvar(a);
    1354           0 :         op_push(OCstoredyn,en,a);
    1355             :       }
    1356             :       else
    1357             :       {
    1358           0 :         en=(long)getvar(a);
    1359           0 :         op_push(OCpushdyn,en,a);
    1360           0 :         op_push(OCpop,1,a);
    1361             :       }
    1362             :     }
    1363           0 :     compilecast(n,Gvoid,mode);
    1364           0 :     set_avma(ltop);
    1365           0 :     return;
    1366             :   }
    1367     2799532 :   else if (is_func_named(ep,"O"))
    1368             :   {
    1369        3626 :     if (nb!=1)
    1370           0 :       compile_err("wrong number of arguments", tree[n].str+tree[n].len-1);
    1371        3626 :     ep=is_entry("O(_^_)");
    1372        3626 :     if (tree[arg[1]].f==Ffunction && tree[arg[1]].x==OPpow)
    1373             :     {
    1374        2821 :       arg = listtogen(tree[arg[1]].y,Flistarg);
    1375        2821 :       nb  = lg(arg)-1;
    1376        2821 :       lnc = first_safe_arg(arg,COsafelex|COsafedyn);
    1377        2821 :       lnl = first_safe_arg(arg,COsafelex);
    1378             :     }
    1379             :   }
    1380     2795906 :   else if (x==OPn && tree[y].f==Fsmall)
    1381             :   {
    1382     1997661 :     set_avma(ltop);
    1383     1997661 :     compilesmall(y, -tree[y].x, mode);
    1384     1997661 :     return;
    1385             :   }
    1386      798245 :   else if (x==OPtrans && tree[y].f==Fvec)
    1387             :   {
    1388        3178 :     set_avma(ltop);
    1389        3178 :     compilevec(y, mode, OCcol);
    1390        3178 :     return;
    1391             :   }
    1392      795067 :   else if (x==OPpow && nb==2 && tree[arg[2]].f==Fsmall)
    1393       43179 :     ep=is_entry("_^s");
    1394      751888 :   else if (x==OPcat)
    1395           0 :     compile_err("expected character: ',' or ')' instead of",
    1396           0 :         tree[arg[1]].str+tree[arg[1]].len);
    1397      802366 :   p=ep->code;
    1398      802366 :   if (!ep->value)
    1399           0 :     compile_err("unknown function",tree[n].str);
    1400      802366 :   nbopcodes = s_opcode.n;
    1401      802366 :   ret_op = get_ret_type(&p, ep->arity, &ret_typ, &ret_flag);
    1402      802366 :   j=1;
    1403      802366 :   if (*p)
    1404             :   {
    1405      795467 :     q=p;
    1406     2832622 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    1407             :     {
    1408     1241723 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    1409     1170363 :           && (mod==PPdefault || mod==PPdefaultmulti))
    1410       38231 :         mod=PPstd;
    1411     1241723 :       switch(mod)
    1412             :       {
    1413             :       case PPstd:
    1414     1159443 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    1415     1159443 :         if (c!='I' && c!='E' && c!='J')
    1416             :         {
    1417     1144404 :           long x = tree[arg[j]].x, f = tree[arg[j]].f;
    1418     1144404 :           if (f==Fnoarg)
    1419           0 :             compile_err("missing mandatory argument", tree[arg[j]].str);
    1420     1144404 :           if (f==Fseq)
    1421           0 :             compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1422             :         }
    1423     1159443 :         switch(c)
    1424             :         {
    1425             :         case 'G':
    1426     1064857 :           compilenode(arg[j],Ggen,j>=lnl?(j>=lnc?FLnocopy:FLnocopylex):0);
    1427     1064857 :           j++;
    1428     1064857 :           break;
    1429             :         case 'W':
    1430             :           {
    1431         273 :             long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
    1432         273 :             entree *ep = getlvalue(a);
    1433         259 :             long vn = getmvar(ep);
    1434         259 :             if (vn) op_push(OCcowvarlex, vn, a);
    1435         196 :             else op_push(OCcowvardyn, (long)ep, a);
    1436         259 :             compilenode(a, Ggen,FLnocopy);
    1437         259 :             j++;
    1438         259 :             break;
    1439             :           }
    1440             :         case 'M':
    1441          42 :           if (tree[arg[j]].f!=Fsmall)
    1442             :           {
    1443          28 :             if (!flags) flags = ep->code;
    1444          28 :             flags = strchr(flags, '\n'); /* Skip to the following '\n' */
    1445          28 :             if (!flags)
    1446           0 :               compile_err("missing flag in string function signature",
    1447           0 :                            tree[n].str);
    1448          28 :             flags++;
    1449          28 :             if (tree[arg[j]].f==Fconst && tree[arg[j]].x==CSTstr)
    1450          28 :             {
    1451          28 :               GEN str=strntoGENexp(tree[arg[j]].str,tree[arg[j]].len);
    1452          28 :               op_push(OCpushlong, eval_mnemonic(str, flags),n);
    1453          28 :               j++;
    1454             :             } else
    1455             :             {
    1456           0 :               compilenode(arg[j++],Ggen,0);
    1457           0 :               op_push(OCpushlong,(long)flags,n);
    1458           0 :               op_push(OCcallgen2,(long)is_entry("_eval_mnemonic"),n);
    1459             :             }
    1460          28 :             break;
    1461             :           }
    1462             :         case 'P': case 'L':
    1463       61544 :           compilenode(arg[j++],Gsmall,0);
    1464       61537 :           break;
    1465             :         case 'U':
    1466          98 :           compilenode(arg[j++],Gusmall,0);
    1467          98 :           break;
    1468             :         case 'n':
    1469        3073 :           compilenode(arg[j++],Gvar,0);
    1470        3066 :           break;
    1471             :         case '&': case '*':
    1472             :           {
    1473        1561 :             long vn, a=arg[j++];
    1474             :             entree *ep;
    1475        1561 :             if (c=='&')
    1476             :             {
    1477         987 :               if (tree[a].f!=Frefarg)
    1478           0 :                 compile_err("expected character: '&'", tree[a].str);
    1479         987 :               a=tree[a].x;
    1480             :             }
    1481        1561 :             a=detag(a);
    1482        1561 :             ep=getlvalue(a);
    1483        1561 :             vn=getmvar(ep);
    1484        1561 :             if (tree[a].f==Fentry)
    1485             :             {
    1486        1379 :               if (vn)
    1487         343 :                 op_push(OCsimpleptrlex, vn,n);
    1488             :               else
    1489        1036 :                 op_push(OCsimpleptrdyn, (long)ep,n);
    1490             :             }
    1491             :             else
    1492             :             {
    1493         182 :               compilenewptr(vn, ep, a);
    1494         182 :               compilelvalue(a);
    1495         182 :               op_push(OCpushptr, 0, a);
    1496             :             }
    1497        1561 :             nbpointers++;
    1498        1561 :             break;
    1499             :           }
    1500             :         case 'I':
    1501             :         case 'E':
    1502             :         case 'J':
    1503             :           {
    1504       15039 :             long a = arg[j++];
    1505       15039 :             GEN  d = compilefuncinline(n, c, a, flag, is_func_named(ep,"if"), lev, ev);
    1506       15039 :             op_push(OCpushgen, data_push(d), a);
    1507       15039 :             if (lg(d)==8) op_push(OCsaveframe,FLsurvive,n);
    1508       15039 :             break;
    1509             :           }
    1510             :         case 'V':
    1511             :           {
    1512        3516 :             long a = arg[j++];
    1513        3516 :             (void)getvar(a);
    1514        3509 :             ev[lev++] = a;
    1515        3509 :             break;
    1516             :           }
    1517             :         case '=':
    1518             :           {
    1519        5361 :             long a = arg[j++];
    1520        5361 :             ev[lev++] = tree[a].x;
    1521        5361 :             compilenode(tree[a].y, Ggen, FLnocopy);
    1522             :           }
    1523        5361 :           break;
    1524             :         case 'r':
    1525             :           {
    1526        1411 :             long a=arg[j++];
    1527        1411 :             if (tree[a].f==Fentry)
    1528             :             {
    1529        1341 :               op_push(OCpushgen, data_push(strntoGENstr(tree[tree[a].x].str,
    1530        1341 :                                                         tree[tree[a].x].len)),n);
    1531        1341 :               op_push(OCtostr, -1,n);
    1532             :             }
    1533             :             else
    1534             :             {
    1535          70 :               compilenode(a,Ggen,FLnocopy);
    1536          70 :               op_push(OCtostr, -1,n);
    1537             :             }
    1538        1411 :             break;
    1539             :           }
    1540             :         case 's':
    1541             :           {
    1542        2682 :             long a = arg[j++];
    1543        2682 :             GEN g = cattovec(a, OPcat);
    1544        2682 :             long l, nb = lg(g)-1;
    1545        2682 :             if (nb==1)
    1546             :             {
    1547        2633 :               compilenode(g[1], Ggen, FLnocopy);
    1548        2633 :               op_push(OCtostr, -1, a);
    1549             :             } else
    1550             :             {
    1551          49 :               op_push(OCvec, nb+1, a);
    1552         147 :               for(l=1; l<=nb; l++)
    1553             :               {
    1554          98 :                 compilenode(g[l], Ggen, FLsurvive);
    1555          98 :                 op_push(OCstackgen,l, a);
    1556             :               }
    1557          49 :               op_push(OCpop, 1, a);
    1558          49 :               op_push(OCcallgen,(long)is_entry("Str"), a);
    1559          49 :               op_push(OCtostr, -1, a);
    1560             :             }
    1561        2682 :             break;
    1562             :           }
    1563             :         default:
    1564           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1565           0 :               tree[x].len, tree[x].str);
    1566             :         }
    1567     1159408 :         break;
    1568             :       case PPauto:
    1569       23789 :         switch(c)
    1570             :         {
    1571             :         case 'p':
    1572       20975 :           op_push(OCprecreal,0,n);
    1573       20975 :           break;
    1574             :         case 'b':
    1575        2772 :           op_push(OCbitprecreal,0,n);
    1576        2772 :           break;
    1577             :         case 'P':
    1578           0 :           op_push(OCprecdl,0,n);
    1579           0 :           break;
    1580             :         case 'C':
    1581          42 :           op_push(OCpushgen,data_push(pack_localvars()),n);
    1582          42 :           break;
    1583             :         case 'f':
    1584             :           {
    1585             :             static long foo;
    1586           0 :             op_push(OCpushlong,(long)&foo,n);
    1587           0 :             break;
    1588             :           }
    1589             :         }
    1590       23789 :         break;
    1591             :       case PPdefault:
    1592       27038 :         j++;
    1593       27038 :         switch(c)
    1594             :         {
    1595             :         case 'G':
    1596             :         case '&':
    1597             :         case 'E':
    1598             :         case 'I':
    1599             :         case 'r':
    1600             :         case 's':
    1601       19769 :           op_push(OCpushlong,0,n);
    1602       19769 :           break;
    1603             :         case 'n':
    1604        6441 :           op_push(OCpushlong,-1,n);
    1605        6441 :           break;
    1606             :         case 'V':
    1607         527 :           ev[lev++] = -1;
    1608         527 :           break;
    1609             :         case 'P':
    1610         301 :           op_push(OCprecdl,0,n);
    1611         301 :           break;
    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       27038 :         break;
    1617             :       case PPdefaultmulti:
    1618       20253 :         j++;
    1619       20253 :         switch(c)
    1620             :         {
    1621             :         case 'G':
    1622         392 :           op_push(OCpushstoi,strtol(q+1,NULL,10),n);
    1623         392 :           break;
    1624             :         case 'L':
    1625             :         case 'M':
    1626       19812 :           op_push(OCpushlong,strtol(q+1,NULL,10),n);
    1627       19812 :           break;
    1628             :         case 'U':
    1629          42 :           op_push(OCpushlong,(long)strtoul(q+1,NULL,10),n);
    1630          42 :           break;
    1631             :         case 'r':
    1632             :         case 's':
    1633           7 :           str_defproto(p, q, tree[n].str);
    1634           7 :           op_push(OCtostr, -1, n);
    1635           7 :           break;
    1636             :         default:
    1637           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1638           0 :               tree[x].len, tree[x].str);
    1639             :         }
    1640       20253 :         break;
    1641             :       case PPstar:
    1642       11200 :         switch(c)
    1643             :         {
    1644             :         case 'E':
    1645             :           {
    1646         119 :             long k, n=nb+1-j;
    1647         119 :             GEN g=cgetg(n+1,t_VEC);
    1648         119 :             int ismif = is_func_named(ep,"_multi_if");
    1649         602 :             for(k=1; k<=n; k++)
    1650         945 :               gel(g, k) = compilefuncinline(n, c, arg[j+k-1], flag,
    1651         483 :                           ismif && (k==n || odd(k)), lev, ev);
    1652         119 :             op_push(OCpushgen, data_push(g), arg[j]);
    1653         119 :             j=nb+1;
    1654         119 :             break;
    1655             :           }
    1656             :         case 's':
    1657             :           {
    1658       11081 :             long n=nb+1-j;
    1659             :             long k,l,l1,m;
    1660       11081 :             GEN g=cgetg(n+1,t_VEC);
    1661       27019 :             for(l1=0,k=1;k<=n;k++)
    1662             :             {
    1663       15938 :               gel(g,k)=cattovec(arg[j+k-1],OPcat);
    1664       15938 :               l1+=lg(gel(g,k))-1;
    1665             :             }
    1666       11081 :             op_push_loc(OCvec, l1+1, str);
    1667       27019 :             for(m=1,k=1;k<=n;k++)
    1668       31939 :               for(l=1;l<lg(gel(g,k));l++,m++)
    1669             :               {
    1670       16001 :                 compilenode(mael(g,k,l),Ggen,FLsurvive);
    1671       16001 :                 op_push(OCstackgen,m,mael(g,k,l));
    1672             :               }
    1673       11081 :             op_push_loc(OCpop, 1, str);
    1674       11081 :             j=nb+1;
    1675       11081 :             break;
    1676             :           }
    1677             :         default:
    1678           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    1679           0 :               tree[x].len, tree[x].str);
    1680             :         }
    1681       11200 :         break;
    1682             :       default:
    1683           0 :         pari_err_BUG("compilefunc [unknown PPproto]");
    1684             :       }
    1685     1241688 :       q=p;
    1686             :     }
    1687             :   }
    1688      802331 :   if (j<=nb)
    1689           0 :     compile_err("too many arguments",tree[arg[j]].str);
    1690      802331 :   op_push_loc(ret_op, (long) ep, str);
    1691      802331 :   if ((ret_flag&FLnocopy) && !(flag&FLnocopy))
    1692        9919 :     op_push_loc(OCcopy,0,str);
    1693      802331 :   if (ret_typ==Ggen && nbpointers==0 && s_opcode.n>nbopcodes+128)
    1694             :   {
    1695        1764 :     op_insert_loc(nbopcodes,OCavma,0,str);
    1696        1764 :     op_push_loc(OCgerepile,0,str);
    1697             :   }
    1698      802331 :   compilecast(n,ret_typ,mode);
    1699      802331 :   if (nbpointers) op_push_loc(OCendptr,nbpointers, str);
    1700      802331 :   set_avma(ltop);
    1701             : }
    1702             : 
    1703             : static void
    1704     8789068 : genclosurectx(const char *loc, long nbdata)
    1705             : {
    1706             :   long i;
    1707     8789068 :   GEN vep = cgetg(nbdata+1,t_VECSMALL);
    1708    34898811 :   for(i = 1; i <= nbdata; i++)
    1709             :   {
    1710    26109743 :     vep[i] = 0;
    1711    26109743 :     op_push_loc(OCpushlex,-i,loc);
    1712             :   }
    1713     8789068 :   frame_push(vep);
    1714     8789068 : }
    1715             : 
    1716             : static GEN
    1717     8796970 : genclosure(entree *ep, const char *loc, long nbdata, int check)
    1718             : {
    1719     8796970 :   pari_sp av = avma;
    1720             :   struct codepos pos;
    1721     8796970 :   long nb=0;
    1722     8796970 :   const char *code=ep->code,*p,*q;
    1723             :   char c;
    1724             :   GEN text;
    1725     8796970 :   long index=ep->arity;
    1726     8796970 :   long arity=0, maskarg=0, maskarg0=0, stop=0, dovararg=0;
    1727             :   PPproto mod;
    1728             :   Gtype ret_typ;
    1729             :   long ret_flag;
    1730     8796970 :   op_code ret_op=get_ret_type(&code,ep->arity,&ret_typ,&ret_flag);
    1731     8796970 :   p=code;
    1732    52505382 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1733             :   {
    1734    34911442 :     if (mod==PPauto)
    1735        1567 :       stop=1;
    1736             :     else
    1737             :     {
    1738    34909875 :       if (stop) return NULL;
    1739    34909875 :       if (c=='V') continue;
    1740    34909875 :       maskarg<<=1; maskarg0<<=1; arity++;
    1741    34909875 :       switch(mod)
    1742             :       {
    1743             :       case PPstd:
    1744    34908843 :         maskarg|=1L;
    1745    34908843 :         break;
    1746             :       case PPdefault:
    1747         422 :         switch(c)
    1748             :         {
    1749             :         case '&':
    1750             :         case 'E':
    1751             :         case 'I':
    1752          28 :           maskarg0|=1L;
    1753          28 :           break;
    1754             :         }
    1755         422 :         break;
    1756             :       default:
    1757         610 :         break;
    1758             :       }
    1759             :     }
    1760             :   }
    1761     8796970 :   if (check && EpSTATIC(ep) && maskarg==0)
    1762        6380 :     return gen_0;
    1763     8790590 :   getcodepos(&pos);
    1764     8790590 :   dbgstart = loc;
    1765     8790590 :   if (nbdata > arity)
    1766           0 :     pari_err(e_MISC,"too many parameters for closure `%s'", ep->name);
    1767     8790590 :   if (nbdata) genclosurectx(loc, nbdata);
    1768     8790590 :   text = strtoGENstr(ep->name);
    1769     8790589 :   arity -= nbdata;
    1770     8790589 :   if (maskarg)  op_push_loc(OCcheckargs,maskarg,loc);
    1771     8790589 :   if (maskarg0) op_push_loc(OCcheckargs0,maskarg0,loc);
    1772     8790589 :   p=code;
    1773    52491319 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1774             :   {
    1775    34910141 :     switch(mod)
    1776             :     {
    1777             :     case PPauto:
    1778         616 :       switch(c)
    1779             :       {
    1780             :       case 'p':
    1781         616 :         op_push_loc(OCprecreal,0,loc);
    1782         616 :         break;
    1783             :       case 'b':
    1784           0 :         op_push_loc(OCbitprecreal,0,loc);
    1785           0 :         break;
    1786             :       case 'P':
    1787           0 :         op_push_loc(OCprecdl,0,loc);
    1788           0 :         break;
    1789             :       case 'C':
    1790           0 :         op_push_loc(OCpushgen,data_push(pack_localvars()),loc);
    1791           0 :         break;
    1792             :       case 'f':
    1793             :         {
    1794             :           static long foo;
    1795           0 :           op_push_loc(OCpushlong,(long)&foo,loc);
    1796           0 :           break;
    1797             :         }
    1798             :       }
    1799             :     default:
    1800    34910141 :       break;
    1801             :     }
    1802             :   }
    1803     8790589 :   q = p = code;
    1804    52491315 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1805             :   {
    1806    34910137 :     switch(mod)
    1807             :     {
    1808             :     case PPstd:
    1809    34908834 :       switch(c)
    1810             :       {
    1811             :       case 'G':
    1812    34890603 :         break;
    1813             :       case 'M':
    1814             :       case 'L':
    1815        4813 :         op_push_loc(OCitos,-index,loc);
    1816        4813 :         break;
    1817             :       case 'U':
    1818       13397 :         op_push_loc(OCitou,-index,loc);
    1819       13397 :         break;
    1820             :       case 'n':
    1821           0 :         op_push_loc(OCvarn,-index,loc);
    1822           0 :         break;
    1823             :       case '&': case '*':
    1824             :       case 'I':
    1825             :       case 'E':
    1826             :       case 'V':
    1827             :       case '=':
    1828           0 :         return NULL;
    1829             :       case 'r':
    1830             :       case 's':
    1831          21 :         op_push_loc(OCtostr,-index,loc);
    1832          21 :         break;
    1833             :       }
    1834    34908834 :       break;
    1835             :     case PPauto:
    1836         616 :       break;
    1837             :     case PPdefault:
    1838         373 :       switch(c)
    1839             :       {
    1840             :       case 'G':
    1841             :       case '&':
    1842             :       case 'E':
    1843             :       case 'I':
    1844             :       case 'V':
    1845             :       case 'r':
    1846             :       case 's':
    1847         198 :         break;
    1848             :       case 'n':
    1849         105 :         op_push_loc(OCvarn,-index,loc);
    1850         105 :         break;
    1851             :       case 'P':
    1852          70 :         op_push_loc(OCprecdl,0,loc);
    1853          70 :         op_push_loc(OCdefaultlong,-index,loc);
    1854          70 :         break;
    1855             :       default:
    1856           0 :         pari_err(e_MISC,"Unknown prototype code `D%c' for `%s'",c,ep->name);
    1857             :       }
    1858         373 :       break;
    1859             :     case PPdefaultmulti:
    1860         293 :       switch(c)
    1861             :       {
    1862             :       case 'G':
    1863           0 :         op_push_loc(OCpushstoi,strtol(q+1,NULL,10),loc);
    1864           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1865           0 :         break;
    1866             :       case 'L':
    1867             :       case 'M':
    1868         293 :         op_push_loc(OCpushlong,strtol(q+1,NULL,10),loc);
    1869         293 :         op_push_loc(OCdefaultlong,-index,loc);
    1870         293 :         break;
    1871             :       case 'U':
    1872           0 :         op_push_loc(OCpushlong,(long)strtoul(q+1,NULL,10),loc);
    1873           0 :         op_push_loc(OCdefaultulong,-index,loc);
    1874           0 :         break;
    1875             :       case 'r':
    1876             :       case 's':
    1877           0 :         str_defproto(p, q, loc);
    1878           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1879           0 :         op_push_loc(OCtostr,-index,loc);
    1880           0 :         break;
    1881             :       default:
    1882           0 :         pari_err(e_MISC,
    1883             :             "Unknown prototype code `D...,%c,' for `%s'",c,ep->name);
    1884             :       }
    1885         293 :       break;
    1886             :     case PPstar:
    1887          21 :       switch(c)
    1888             :       {
    1889             :       case 's':
    1890          21 :         dovararg = 1;
    1891          21 :         break;
    1892             :       case 'E':
    1893           0 :         return NULL;
    1894             :       default:
    1895           0 :         pari_err(e_MISC,"Unknown prototype code `%c*' for `%s'",c,ep->name);
    1896             :       }
    1897          21 :       break;
    1898             :     default:
    1899           0 :       return NULL;
    1900             :     }
    1901    34910137 :     index--;
    1902    34910137 :     q = p;
    1903             :   }
    1904     8790587 :   op_push_loc(ret_op, (long) ep, loc);
    1905     8790591 :   if (ret_flag==FLnocopy) op_push_loc(OCcopy,0,loc);
    1906     8790591 :   compilecast_loc(ret_typ, Ggen, loc);
    1907     8790590 :   if (dovararg) nb|=VARARGBITS;
    1908     8790590 :   return gerepilecopy(av, getfunction(&pos,nb+arity,nbdata,text,0));
    1909             : }
    1910             : 
    1911             : GEN
    1912      104513 : snm_closure(entree *ep, GEN data)
    1913             : {
    1914             :   long i;
    1915      104513 :   long n = data ? lg(data)-1: 0;
    1916      104513 :   GEN C = genclosure(ep,ep->name,n,0);
    1917      522447 :   for(i=1; i<=n; i++)
    1918      417934 :     gmael(C,7,i) = gel(data,i);
    1919      104513 :   return C;
    1920             : }
    1921             : 
    1922             : GEN
    1923     8684563 : strtoclosure(const char *s, long n,  ...)
    1924             : {
    1925     8684563 :   pari_sp av = avma;
    1926     8684563 :   entree *ep = is_entry(s);
    1927             :   GEN C;
    1928     8684564 :   if (!ep) pari_err(e_NOTFUNC, strtoGENstr(s));
    1929     8684564 :   ep = do_alias(ep);
    1930     8684564 :   if ((!EpSTATIC(ep) && EpVALENCE(ep)!=EpINSTALL) || !ep->value)
    1931           0 :     pari_err(e_MISC,"not a built-in/install'ed function: \"%s\"",s);
    1932     8684564 :   C = genclosure(ep,ep->name,n,0);
    1933     8684566 :   if (!C) pari_err(e_MISC,"function prototype unsupported: \"%s\"",s);
    1934             :   else
    1935             :   {
    1936             :     va_list ap;
    1937             :     long i;
    1938     8684566 :     va_start(ap,n);
    1939    34376382 :     for(i=1; i<=n; i++)
    1940    25691816 :       gmael(C,7,i) = va_arg(ap, GEN);
    1941     8684566 :     va_end(ap);
    1942             :   }
    1943     8684566 :   return gerepilecopy(av, C);
    1944             : }
    1945             : 
    1946             : GEN
    1947           7 : strtofunction(const char *s)
    1948             : {
    1949           7 :   return strtoclosure(s, 0);
    1950             : }
    1951             : 
    1952             : GEN
    1953          21 : call0(GEN fun, GEN args)
    1954             : {
    1955          21 :   if (!is_vec_t(typ(args))) pari_err_TYPE("call",args);
    1956          21 :   switch(typ(fun))
    1957             :   {
    1958             :     case t_STR:
    1959           7 :       fun = strtofunction(GSTR(fun));
    1960             :     case t_CLOSURE: /* fall through */
    1961          21 :       return closure_callgenvec(fun, args);
    1962             :     default:
    1963           0 :       pari_err_TYPE("call", fun);
    1964             :       return NULL; /* LCOV_EXCL_LINE */
    1965             :   }
    1966             : }
    1967             : 
    1968             : static void
    1969        7893 : closurefunc(entree *ep, long n, long mode)
    1970             : {
    1971        7893 :   pari_sp ltop=avma;
    1972             :   GEN C;
    1973        7893 :   if (!ep->value) compile_err("unknown function",tree[n].str);
    1974        7893 :   C = genclosure(ep,tree[n].str,0,1);
    1975        7893 :   if (!C) compile_err("sorry, closure not implemented",tree[n].str);
    1976        7893 :   if (C==gen_0)
    1977             :   {
    1978        6380 :     compilefunc(ep,n,mode,0);
    1979        6380 :     return;
    1980             :   }
    1981        1513 :   op_push(OCpushgen, data_push(C), n);
    1982        1513 :   compilecast(n,Gclosure,mode);
    1983        1513 :   set_avma(ltop);
    1984             : }
    1985             : 
    1986             : static void
    1987       10835 : compileseq(long n, int mode, long flag)
    1988             : {
    1989       10835 :   pari_sp av = avma;
    1990       10835 :   GEN L = listtogen(n, Fseq);
    1991       10835 :   long i, l = lg(L)-1;
    1992       35712 :   for(i = 1; i < l; i++)
    1993       24877 :     compilenode(L[i],Gvoid,0);
    1994       10835 :   compilenode(L[l],mode,flag&(FLreturn|FLsurvive));
    1995       10835 :   set_avma(av);
    1996       10835 : }
    1997             : 
    1998             : static void
    1999    13769686 : compilenode(long n, int mode, long flag)
    2000             : {
    2001             :   long x,y;
    2002             : #ifdef STACK_CHECK
    2003    13769686 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2004           0 :     pari_err(e_MISC, "expression nested too deeply");
    2005             : #endif
    2006    13769686 :   if (n<0) pari_err_BUG("compilenode");
    2007    13769686 :   x=tree[n].x;
    2008    13769686 :   y=tree[n].y;
    2009             : 
    2010    13769686 :   switch(tree[n].f)
    2011             :   {
    2012             :   case Fseq:
    2013       10835 :     compileseq(n, mode, flag);
    2014       10835 :     return;
    2015             :   case Fmatcoeff:
    2016        9756 :     compilematcoeff(n,mode);
    2017        9749 :     if (mode==Ggen && !(flag&FLnocopy))
    2018        2499 :       op_push(OCcopy,0,n);
    2019        9749 :     return;
    2020             :   case Fassign:
    2021       30540 :     x = detag(x);
    2022       30540 :     if (tree[x].f==Fvec && tree[x].x>=0)
    2023         511 :     {
    2024         511 :       GEN vars = listtogen(tree[x].x,Fmatrixelts);
    2025         511 :       long i, l = lg(vars)-1, d = mode==Gvoid? l-1: l;
    2026         511 :       compilenode(y,Ggen,mode==Gvoid?0:flag&FLsurvive);
    2027         511 :       if (d) op_push(OCdup, d, x);
    2028        1610 :       for(i=1; i<=l; i++)
    2029             :       {
    2030        1099 :         long a = detag(vars[i]);
    2031        1099 :         entree *ep=getlvalue(a);
    2032        1099 :         long vn=getmvar(ep);
    2033        1099 :         op_push(OCpushlong,i,a);
    2034        1099 :         op_push(OCcompo1,Ggen,a);
    2035        1099 :         if (tree[a].f==Fentry)
    2036        1092 :           compilestore(vn,ep,n);
    2037             :         else
    2038             :         {
    2039           7 :           compilenewptr(vn,ep,n);
    2040           7 :           compilelvalue(a);
    2041           7 :           op_push(OCstoreptr,0,a);
    2042             :         }
    2043             :       }
    2044         511 :       if (mode!=Gvoid)
    2045         287 :         compilecast(n,Ggen,mode);
    2046             :     }
    2047             :     else
    2048             :     {
    2049       30029 :       entree *ep=getlvalue(x);
    2050       30029 :       long vn=getmvar(ep);
    2051       30029 :       if (tree[x].f!=Fentry)
    2052             :       {
    2053         434 :         compilenewptr(vn,ep,n);
    2054         434 :         compilelvalue(x);
    2055             :       }
    2056       30029 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    2057       30029 :       if (mode!=Gvoid)
    2058       18671 :         op_push(OCdup,1,n);
    2059       30029 :       if (tree[x].f==Fentry)
    2060       29595 :         compilestore(vn,ep,n);
    2061             :       else
    2062         434 :         op_push(OCstoreptr,0,x);
    2063       30029 :       if (mode!=Gvoid)
    2064       18671 :         compilecast(n,Ggen,mode);
    2065             :     }
    2066       30540 :     return;
    2067             :   case Fconst:
    2068             :     {
    2069     1926769 :       pari_sp ltop=avma;
    2070     1926769 :       if (tree[n].x!=CSTquote)
    2071             :       {
    2072     1923953 :         if (mode==Gvoid) return;
    2073     1923953 :         if (mode==Gvar) compile_varerr(tree[n].str);
    2074             :       }
    2075     1926769 :       if (mode==Gsmall)
    2076           0 :         compile_err("this should be a small integer", tree[n].str);
    2077     1926769 :       switch(tree[n].x)
    2078             :       {
    2079             :       case CSTreal:
    2080        3268 :         op_push(OCpushreal, data_push(strntoGENstr(tree[n].str,tree[n].len)),n);
    2081        3268 :         break;
    2082             :       case CSTint:
    2083      812322 :         op_push(OCpushgen,  data_push(strtoi((char*)tree[n].str)),n);
    2084      812322 :         compilecast(n,Ggen, mode);
    2085      812322 :         break;
    2086             :       case CSTstr:
    2087     1108363 :         op_push(OCpushgen,  data_push(strntoGENexp(tree[n].str,tree[n].len)),n);
    2088     1108363 :         break;
    2089             :       case CSTquote:
    2090             :         { /* skip ' */
    2091        2816 :           entree *ep = fetch_entry_raw(tree[n].str+1,tree[n].len-1);
    2092        2816 :           if (EpSTATIC(ep)) compile_varerr(tree[n].str+1);
    2093        2816 :           op_push(OCpushvar, (long)ep,n);
    2094        2816 :           compilecast(n,Ggen, mode);
    2095        2816 :           break;
    2096             :         }
    2097             :       default:
    2098           0 :         pari_err_BUG("compilenode, unsupported constant");
    2099             :       }
    2100     1926769 :       set_avma(ltop);
    2101     1926769 :       return;
    2102             :     }
    2103             :   case Fsmall:
    2104     4923821 :     compilesmall(n, x, mode);
    2105     4923814 :     return;
    2106             :   case Fvec:
    2107     3834629 :     compilevec(n, mode, OCvec);
    2108     3834629 :     return;
    2109             :   case Fmat:
    2110        8617 :     compilemat(n, mode);
    2111        8617 :     return;
    2112             :   case Frefarg:
    2113           0 :     compile_err("unexpected character '&':",tree[n].str);
    2114           0 :     return;
    2115             :   case Findarg:
    2116           0 :     compile_err("unexpected character '~':",tree[n].str);
    2117           0 :     return;
    2118             :   case Fentry:
    2119             :     {
    2120      197615 :       entree *ep=getentry(n);
    2121      197615 :       long vn=getmvar(ep);
    2122      197615 :       if (vn)
    2123             :       {
    2124       57965 :         op_push(OCpushlex,(long)vn,n);
    2125       57965 :         addcopy(n,mode,flag,FLnocopy|FLnocopylex);
    2126       57965 :         compilecast(n,Ggen,mode);
    2127             :       }
    2128      139650 :       else if (ep->valence==EpVAR || ep->valence==EpNEW)
    2129             :       {
    2130      131757 :         if (DEBUGLEVEL && mode==Gvoid)
    2131           0 :           pari_warn(warner,"statement with no effect: `%s'",ep->name);
    2132      131757 :         op_push(OCpushdyn,(long)ep,n);
    2133      131757 :         addcopy(n,mode,flag,FLnocopy);
    2134      131757 :         compilecast(n,Ggen,mode);
    2135             :       }
    2136             :       else
    2137        7893 :         closurefunc(ep,n,mode);
    2138      197615 :       return;
    2139             :     }
    2140             :   case Ffunction:
    2141             :     {
    2142     2818698 :       entree *ep=getfunc(n);
    2143     2818698 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2144             :       {
    2145       19405 :         if (tree[n].x<OPnboperator) /* should not happen */
    2146           0 :           compile_err("operator unknown",tree[n].str);
    2147       19405 :         compilecall(n,mode,ep);
    2148             :       }
    2149             :       else
    2150     2799293 :         compilefunc(ep,n,mode,flag);
    2151     2818663 :       return;
    2152             :     }
    2153             :   case Fcall:
    2154         315 :     compilecall(n,mode,NULL);
    2155         315 :     return;
    2156             :   case Flambda:
    2157             :     {
    2158        7860 :       pari_sp ltop=avma;
    2159             :       struct codepos pos;
    2160        7860 :       GEN arg=listtogen(x,Flistarg);
    2161        7860 :       long nb, lgarg, nbmvar, dovararg=0, gap;
    2162        7860 :       long strict = GP_DATA->strictargs;
    2163        7860 :       GEN vep = cgetg_copy(arg, &lgarg);
    2164        7860 :       GEN text=cgetg(3,t_VEC);
    2165        7860 :       gel(text,1)=strntoGENstr(tree[x].str,tree[x].len);
    2166        7860 :       gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
    2167        7860 :       getcodepos(&pos);
    2168        7860 :       dbgstart=tree[x].str+tree[x].len;
    2169        7860 :       gap = tree[y].str-dbgstart;
    2170        7860 :       nbmvar=ctxmvar();
    2171        7860 :       nb = lgarg-1;
    2172        7860 :       if (nb)
    2173             :       {
    2174             :         long i;
    2175       10150 :         for(i=1;i<=nb;i++)
    2176             :         {
    2177        6233 :           long a = arg[i], f = tree[a].f;
    2178        6233 :           if (i==nb && f==Fvararg)
    2179             :           {
    2180          21 :             dovararg=1;
    2181          21 :             vep[i]=(long)getvar(tree[a].x);
    2182             :           }
    2183             :           else
    2184        6212 :             vep[i]=(long)getvar(f==Fassign||f==Findarg?tree[a].x:a);
    2185        6233 :           var_push(NULL,Lmy);
    2186             :         }
    2187        3917 :         checkdups(arg,vep);
    2188        3917 :         op_push(OCgetargs,nb,x);
    2189        3917 :         frame_push(vep);
    2190       10150 :         for (i=1;i<=nb;i++)
    2191             :         {
    2192        6233 :           long a = arg[i], f = tree[a].f;
    2193        6233 :           long y = tree[a].y;
    2194        6233 :           if (f==Fassign && (strict || !is_node_zero(y)))
    2195             :           {
    2196         280 :             if (tree[y].f==Fsmall)
    2197         203 :               compilenode(y, Ggen, 0);
    2198             :             else
    2199             :             {
    2200             :               struct codepos lpos;
    2201          77 :               getcodepos(&lpos);
    2202          77 :               compilenode(y, Ggen, 0);
    2203          77 :               op_push(OCpushgen, data_push(getclosure(&lpos)),a);
    2204             :             }
    2205         280 :             op_push(OCdefaultarg,-nb+i-1,a);
    2206        5953 :           } else if (f==Findarg)
    2207          49 :             op_push(OCsetref, -nb+i-1, a);
    2208        6233 :           localvars[s_lvar.n-nb+i-1].ep=(entree*)vep[i];
    2209             :         }
    2210             :       }
    2211        7860 :       if (strict)
    2212          21 :         op_push(OCcheckuserargs,nb,x);
    2213        7860 :       dbgstart=tree[y].str;
    2214        7860 :       if (y>=0 && tree[y].f!=Fnoarg)
    2215        7860 :         compilenode(y,Ggen,FLsurvive|FLreturn);
    2216             :       else
    2217           0 :         compilecast(n,Gvoid,Ggen);
    2218        7860 :       if (dovararg) nb|=VARARGBITS;
    2219        7860 :       op_push(OCpushgen, data_push(getfunction(&pos,nb,nbmvar,text,gap)),n);
    2220        7860 :       if (nbmvar) op_push(OCsaveframe,!!(flag&FLsurvive),n);
    2221        7860 :       compilecast(n, Gclosure, mode);
    2222        7860 :       set_avma(ltop);
    2223        7860 :       return;
    2224             :     }
    2225             :   case Ftag:
    2226           0 :     compilenode(x, mode,flag);
    2227           0 :     return;
    2228             :   case Fnoarg:
    2229           7 :     compilecast(n,Gvoid,mode);
    2230           7 :     return;
    2231             :   case Fnorange:
    2232         224 :     op_push(OCpushlong,LONG_MAX,n);
    2233         224 :     compilecast(n,Gsmall,mode);
    2234         224 :     return;
    2235             :   default:
    2236           0 :     pari_err_BUG("compilenode");
    2237             :   }
    2238             : }
    2239             : 
    2240             : GEN
    2241       98967 : gp_closure(long n)
    2242             : {
    2243             :   struct codepos pos;
    2244       98967 :   getcodepos(&pos);
    2245       98967 :   dbgstart=tree[n].str;
    2246       98967 :   compilenode(n,Ggen,FLsurvive|FLreturn);
    2247       98932 :   return getfunction(&pos,0,0,strntoGENstr(tree[n].str,tree[n].len),0);
    2248             : }
    2249             : 
    2250             : GEN
    2251         105 : closure_derivn(GEN G, long n)
    2252             : {
    2253         105 :   pari_sp ltop = avma;
    2254             :   struct codepos pos;
    2255         105 :   long arity = closure_arity(G);
    2256             :   const char *code;
    2257             :   GEN t, text;
    2258             : 
    2259         105 :   if (arity == 0 || closure_is_variadic(G)) pari_err_TYPE("derivfun",G);
    2260         105 :   t = closure_get_text(G);
    2261         105 :   code = GSTR((typ(t) == t_STR)? t: GENtoGENstr(G));
    2262         105 :   if (n > 1)
    2263             :   {
    2264          49 :     text = cgetg(1+nchar2nlong(9+strlen(code)+n),t_STR);
    2265          49 :     sprintf(GSTR(text), "derivn(%s,%ld)", code, n);
    2266             :   }
    2267             :   else
    2268             :   {
    2269          56 :     text = cgetg(1+nchar2nlong(4+strlen(code)),t_STR);
    2270          56 :     sprintf(GSTR(text), (typ(t) == t_STR)? "%s'": "(%s)'",code);
    2271             :   }
    2272         105 :   getcodepos(&pos);
    2273         105 :   dbgstart = code;
    2274         105 :   op_push_loc(OCpackargs, arity, code);
    2275         105 :   op_push_loc(OCpushgen, data_push(G), code);
    2276         105 :   op_push_loc(OCpushlong, n, code);
    2277         105 :   op_push_loc(OCprecreal, 0, code);
    2278         105 :   op_push_loc(OCcallgen, (long)is_entry("_derivfun"), code);
    2279         105 :   return gerepilecopy(ltop, getfunction(&pos, arity, 0, text, 0));
    2280             : }
    2281             : 
    2282             : GEN
    2283           0 : closure_deriv(GEN G)
    2284           0 : { return closure_derivn(G, 1); }
    2285             : 
    2286             : static long
    2287     3920499 : vec_optimize(GEN arg)
    2288             : {
    2289     3920499 :   long fl = COsafelex|COsafedyn;
    2290             :   long i;
    2291    16352196 :   for (i=1; i<lg(arg); i++)
    2292             :   {
    2293    12431704 :     optimizenode(arg[i]);
    2294    12431697 :     fl &= tree[arg[i]].flags;
    2295             :   }
    2296     3920492 :   return fl;
    2297             : }
    2298             : 
    2299             : static void
    2300     3838591 : optimizevec(long n)
    2301             : {
    2302     3838591 :   pari_sp ltop=avma;
    2303     3838591 :   long x = tree[n].x;
    2304     3838591 :   GEN  arg = listtogen(x, Fmatrixelts);
    2305     3838591 :   tree[n].flags = vec_optimize(arg);
    2306     3838591 :   set_avma(ltop);
    2307     3838591 : }
    2308             : 
    2309             : static void
    2310        8617 : optimizemat(long n)
    2311             : {
    2312        8617 :   pari_sp ltop = avma;
    2313        8617 :   long x = tree[n].x;
    2314             :   long i;
    2315        8617 :   GEN line = listtogen(x,Fmatrixlines);
    2316        8617 :   long fl = COsafelex|COsafedyn;
    2317       44366 :   for(i=1;i<lg(line);i++)
    2318             :   {
    2319       35749 :     GEN col=listtogen(line[i],Fmatrixelts);
    2320       35749 :     fl &= vec_optimize(col);
    2321             :   }
    2322        8617 :   set_avma(ltop); tree[n].flags=fl;
    2323        8617 : }
    2324             : 
    2325             : static void
    2326       10477 : optimizematcoeff(long n)
    2327             : {
    2328       10477 :   long x=tree[n].x;
    2329       10477 :   long y=tree[n].y;
    2330       10477 :   long yx=tree[y].x;
    2331       10477 :   long yy=tree[y].y;
    2332             :   long fl;
    2333       10477 :   optimizenode(x);
    2334       10477 :   optimizenode(yx);
    2335       10477 :   fl=tree[x].flags&tree[yx].flags;
    2336       10477 :   if (yy>=0)
    2337             :   {
    2338        1204 :     optimizenode(yy);
    2339        1204 :     fl&=tree[yy].flags;
    2340             :   }
    2341       10477 :   tree[n].flags=fl;
    2342       10477 : }
    2343             : 
    2344             : 
    2345             : static void
    2346     2802107 : optimizefunc(entree *ep, long n)
    2347             : {
    2348     2802107 :   pari_sp av=avma;
    2349             :   long j;
    2350     2802107 :   long x=tree[n].x;
    2351     2802107 :   long y=tree[n].y;
    2352             :   Gtype t;
    2353             :   PPproto mod;
    2354     2802107 :   long fl=COsafelex|COsafedyn;
    2355             :   const char *p;
    2356             :   char c;
    2357     2802107 :   GEN arg = listtogen(y,Flistarg);
    2358     2802107 :   long nb=lg(arg)-1, ret_flag;
    2359     2802107 :   if (is_func_named(ep,"if") && nb>=4)
    2360         119 :     ep=is_entry("_multi_if");
    2361     2802107 :   p = ep->code;
    2362     2802107 :   if (!p)
    2363        2370 :     fl=0;
    2364             :   else
    2365     2799737 :     (void) get_ret_type(&p, 2, &t, &ret_flag);
    2366     2802107 :   if (p && *p)
    2367             :   {
    2368     2794295 :     j=1;
    2369     8874350 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    2370             :     {
    2371     3285788 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    2372     3170495 :           && (mod==PPdefault || mod==PPdefaultmulti))
    2373       35508 :         mod=PPstd;
    2374     3285788 :       switch(mod)
    2375             :       {
    2376             :       case PPstd:
    2377     3159610 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    2378     3159582 :         if (tree[arg[j]].f==Fnoarg && c!='I' && c!='E')
    2379           0 :           compile_err("missing mandatory argument", tree[arg[j]].str);
    2380     3159582 :         switch(c)
    2381             :         {
    2382             :         case 'G':
    2383             :         case 'n':
    2384             :         case 'M':
    2385             :         case 'L':
    2386             :         case 'U':
    2387             :         case 'P':
    2388     3129718 :           optimizenode(arg[j]);
    2389     3129718 :           fl&=tree[arg[j++]].flags;
    2390     3129718 :           break;
    2391             :         case 'I':
    2392             :         case 'E':
    2393             :         case 'J':
    2394       15046 :           optimizenode(arg[j]);
    2395       15046 :           fl&=tree[arg[j]].flags;
    2396       15046 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2397       15046 :           break;
    2398             :         case '&': case '*':
    2399             :           {
    2400        1561 :             long a=arg[j];
    2401        1561 :             if (c=='&')
    2402             :             {
    2403         987 :               if (tree[a].f!=Frefarg)
    2404           0 :                 compile_err("expected character: '&'", tree[a].str);
    2405         987 :               a=tree[a].x;
    2406             :             }
    2407        1561 :             optimizenode(a);
    2408        1561 :             tree[arg[j++]].flags=COsafelex|COsafedyn;
    2409        1561 :             fl=0;
    2410        1561 :             break;
    2411             :           }
    2412             :         case 'W':
    2413             :         {
    2414         287 :           long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
    2415         287 :           optimizenode(a);
    2416         287 :           fl=0; j++;
    2417         287 :           break;
    2418             :         }
    2419             :         case 'V':
    2420             :         case 'r':
    2421        4927 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2422        4927 :           break;
    2423             :         case '=':
    2424             :           {
    2425        5361 :             long a=arg[j++], y=tree[a].y;
    2426        5361 :             if (tree[a].f!=Fassign)
    2427           0 :               compile_err("expected character: '=' instead of",
    2428           0 :                   tree[a].str+tree[a].len);
    2429        5361 :             optimizenode(y);
    2430        5361 :             fl&=tree[y].flags;
    2431             :           }
    2432        5361 :           break;
    2433             :         case 's':
    2434        2682 :           fl &= vec_optimize(cattovec(arg[j++], OPcat));
    2435        2682 :           break;
    2436             :         default:
    2437           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    2438           0 :               tree[x].len, tree[x].str);
    2439             :         }
    2440     3159582 :         break;
    2441             :       case PPauto:
    2442       68837 :         break;
    2443             :       case PPdefault:
    2444             :       case PPdefaultmulti:
    2445       46141 :         if (j<=nb) optimizenode(arg[j++]);
    2446       46141 :         break;
    2447             :       case PPstar:
    2448       11200 :         switch(c)
    2449             :         {
    2450             :         case 'E':
    2451             :           {
    2452         119 :             long n=nb+1-j;
    2453             :             long k;
    2454         602 :             for(k=1;k<=n;k++)
    2455             :             {
    2456         483 :               optimizenode(arg[j+k-1]);
    2457         483 :               fl &= tree[arg[j+k-1]].flags;
    2458             :             }
    2459         119 :             j=nb+1;
    2460         119 :             break;
    2461             :           }
    2462             :         case 's':
    2463             :           {
    2464       11081 :             long n=nb+1-j;
    2465             :             long k;
    2466       27019 :             for(k=1;k<=n;k++)
    2467       15938 :               fl &= vec_optimize(cattovec(arg[j+k-1],OPcat));
    2468       11081 :             j=nb+1;
    2469       11081 :             break;
    2470             :           }
    2471             :         default:
    2472           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    2473           0 :               tree[x].len, tree[x].str);
    2474             :         }
    2475       11200 :         break;
    2476             :       default:
    2477           0 :         pari_err_BUG("optimizefun [unknown PPproto]");
    2478             :       }
    2479             :     }
    2480     5588534 :     if (j<=nb)
    2481           0 :       compile_err("too many arguments",tree[arg[j]].str);
    2482             :   }
    2483        7812 :   else (void)vec_optimize(arg);
    2484     2802079 :   set_avma(av); tree[n].flags=fl;
    2485     2802079 : }
    2486             : 
    2487             : static void
    2488       19727 : optimizecall(long n)
    2489             : {
    2490       19727 :   pari_sp av=avma;
    2491       19727 :   long x=tree[n].x;
    2492       19727 :   long y=tree[n].y;
    2493       19727 :   GEN arg=listtogen(y,Flistarg);
    2494       19727 :   optimizenode(x);
    2495       19727 :   tree[n].flags = COsafelex&tree[x].flags&vec_optimize(arg);
    2496       19720 :   set_avma(av);
    2497       19720 : }
    2498             : 
    2499             : static void
    2500       10835 : optimizeseq(long n)
    2501             : {
    2502       10835 :   pari_sp av = avma;
    2503       10835 :   GEN L = listtogen(n, Fseq);
    2504       10835 :   long i, l = lg(L)-1, flags=-1L;
    2505       46547 :   for(i = 1; i <= l; i++)
    2506             :   {
    2507       35712 :     optimizenode(L[i]);
    2508       35712 :     flags &= tree[L[i]].flags;
    2509             :   }
    2510       10835 :   set_avma(av);
    2511       10835 :   tree[n].flags = flags;
    2512       10835 : }
    2513             : 
    2514             : void
    2515    15859698 : optimizenode(long n)
    2516             : {
    2517             :   long x,y;
    2518             : #ifdef STACK_CHECK
    2519    15859698 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2520           0 :     pari_err(e_MISC, "expression nested too deeply");
    2521             : #endif
    2522    15859698 :   if (n<0)
    2523           0 :     pari_err_BUG("optimizenode");
    2524    15859698 :   x=tree[n].x;
    2525    15859698 :   y=tree[n].y;
    2526             : 
    2527    15859698 :   switch(tree[n].f)
    2528             :   {
    2529             :   case Fseq:
    2530       10835 :     optimizeseq(n);
    2531       10835 :     return;
    2532             :   case Frange:
    2533       11681 :     optimizenode(x);
    2534       11681 :     optimizenode(y);
    2535       11681 :     tree[n].flags=tree[x].flags&tree[y].flags;
    2536       11681 :     break;
    2537             :   case Fmatcoeff:
    2538       10477 :     optimizematcoeff(n);
    2539       10477 :     break;
    2540             :   case Fassign:
    2541       33349 :     optimizenode(x);
    2542       33349 :     optimizenode(y);
    2543       33349 :     tree[n].flags=0;
    2544       33349 :     break;
    2545             :   case Fnoarg:
    2546             :   case Fnorange:
    2547             :   case Fsmall:
    2548             :   case Fconst:
    2549             :   case Fentry:
    2550     9116384 :     tree[n].flags=COsafelex|COsafedyn;
    2551     9116384 :     return;
    2552             :   case Fvec:
    2553     3838591 :     optimizevec(n);
    2554     3838591 :     return;
    2555             :   case Fmat:
    2556        8617 :     optimizemat(n);
    2557        8617 :     return;
    2558             :   case Frefarg:
    2559           7 :     compile_err("unexpected character '&'",tree[n].str);
    2560           0 :     return;
    2561             :   case Findarg:
    2562          63 :     return;
    2563             :   case Fvararg:
    2564           0 :     compile_err("unexpected characters '..'",tree[n].str);
    2565           0 :     return;
    2566             :   case Ffunction:
    2567             :     {
    2568     2821519 :       entree *ep=getfunc(n);
    2569     2821519 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2570       19412 :         optimizecall(n);
    2571             :       else
    2572     2802107 :         optimizefunc(ep,n);
    2573     2821484 :       return;
    2574             :     }
    2575             :   case Fcall:
    2576         315 :     optimizecall(n);
    2577         315 :     return;
    2578             :   case Flambda:
    2579        7860 :     optimizenode(y);
    2580        7860 :     tree[n].flags=COsafelex|COsafedyn;
    2581        7860 :     return;
    2582             :   case Ftag:
    2583           0 :     optimizenode(x);
    2584           0 :     tree[n].flags=tree[x].flags;
    2585           0 :     return;
    2586             :   default:
    2587           0 :     pari_err_BUG("optimizenode");
    2588             :   }
    2589             : }

Generated by: LCOV version 1.13