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.0 lcov report (development 23346-507fdfd83) Lines: 1378 1529 90.1 %
Date: 2018-12-13 05:42:04 Functions: 81 82 98.8 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2006  The PARI group.
       2             : 
       3             : This file is part of the PARI package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : #include "anal.h"
      17             : #include "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     1108170 : translate(const char **src, char *s)
      32             : {
      33     1108170 :   const char *t = *src;
      34     9006184 :   while (*t)
      35             :   {
      36    15796581 :     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     7898014 :     if (*t == '"')
      48             :     {
      49     1108170 :       if (t[1] != '"') break;
      50           0 :       t += 2; continue;
      51             :     }
      52     6789844 :     *s++ = *t++;
      53             :   }
      54     1108170 :   *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     1108166 : strntoGENexp(const char *str, long len)
      76             : {
      77     1108166 :   GEN z = cgetg(1+nchar2nlong(len-1), t_STR);
      78     1108166 :   const char *t = str+1;
      79     1108166 :   if (!translate(&t, GSTR(z))) compile_err("run-away string",str);
      80     1108166 :   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      119047 : pari_init_compiler(void)
     116             : {
     117      119047 :   pari_stack_init(&s_opcode,sizeof(*opcode),(void **)&opcode);
     118      119024 :   pari_stack_init(&s_operand,sizeof(*operand),(void **)&operand);
     119      119028 :   pari_stack_init(&s_data,sizeof(*data),(void **)&data);
     120      119057 :   pari_stack_init(&s_lvar,sizeof(*localvars),(void **)&localvars);
     121      119030 :   pari_stack_init(&s_dbginfo,sizeof(*dbginfo),(void **)&dbginfo);
     122      119028 :   pari_stack_init(&s_frame,sizeof(*frames),(void **)&frames);
     123      119026 :   offset=-1;
     124      119026 : }
     125             : void
     126      116981 : pari_close_compiler(void)
     127             : {
     128      116981 :   pari_stack_delete(&s_opcode);
     129      116943 :   pari_stack_delete(&s_operand);
     130      116846 :   pari_stack_delete(&s_data);
     131      116928 :   pari_stack_delete(&s_lvar);
     132      116559 :   pari_stack_delete(&s_dbginfo);
     133      116567 :   pari_stack_delete(&s_frame);
     134      116684 : }
     135             : 
     136             : struct codepos
     137             : {
     138             :   long opcode, data, localvars, frames;
     139             :   long offset;
     140             :   const char *dbgstart;
     141             : };
     142             : 
     143             : static void
     144      371464 : getcodepos(struct codepos *pos)
     145             : {
     146      371464 :   pos->opcode=s_opcode.n;
     147      371464 :   pos->data=s_data.n;
     148      371464 :   pos->offset=offset;
     149      371464 :   pos->localvars=s_lvar.n;
     150      371464 :   pos->dbgstart=dbgstart;
     151      371464 :   pos->frames=s_frame.n;
     152      371464 :   offset=s_data.n-1;
     153      371464 : }
     154             : 
     155             : void
     156         291 : compilestate_reset(void)
     157             : {
     158         291 :   s_opcode.n=0;
     159         291 :   s_operand.n=0;
     160         291 :   s_dbginfo.n=0;
     161         291 :   s_data.n=0;
     162         291 :   s_lvar.n=0;
     163         291 :   s_frame.n=0;
     164         291 :   offset=-1;
     165         291 :   dbgstart=NULL;
     166         291 : }
     167             : 
     168             : void
     169     1369919 : compilestate_save(struct pari_compilestate *comp)
     170             : {
     171     1369919 :   comp->opcode=s_opcode.n;
     172     1369919 :   comp->operand=s_operand.n;
     173     1369919 :   comp->data=s_data.n;
     174     1369919 :   comp->offset=offset;
     175     1369919 :   comp->localvars=s_lvar.n;
     176     1369919 :   comp->dbgstart=dbgstart;
     177     1369919 :   comp->dbginfo=s_dbginfo.n;
     178     1369919 :   comp->frames=s_frame.n;
     179     1369919 : }
     180             : 
     181             : void
     182       43643 : compilestate_restore(struct pari_compilestate *comp)
     183             : {
     184       43643 :   s_opcode.n=comp->opcode;
     185       43643 :   s_operand.n=comp->operand;
     186       43643 :   s_data.n=comp->data;
     187       43643 :   offset=comp->offset;
     188       43643 :   s_lvar.n=comp->localvars;
     189       43643 :   dbgstart=comp->dbgstart;
     190       43643 :   s_dbginfo.n=comp->dbginfo;
     191       43643 :   s_frame.n=comp->frames;
     192       43643 : }
     193             : 
     194             : static GEN
     195      371437 : getfunction(const struct codepos *pos, long arity, long nbmvar, GEN text, long gap)
     196             : {
     197      371437 :   long lop =s_opcode.n+1-pos->opcode;
     198      371437 :   long ldat=s_data.n+1-pos->data;
     199      371437 :   long lfram=s_frame.n+1-pos->frames;
     200      371437 :   GEN cl=cgetg(nbmvar?8:(text?7:6),t_CLOSURE);
     201             :   GEN frpc, fram, dbg;
     202             :   char *s;
     203             :   long i;
     204      371437 :   cl[1] = arity;
     205      371437 :   gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
     206      371438 :   gel(cl,3) = cgetg(lop,  t_VECSMALL);
     207      371437 :   gel(cl,4) = cgetg(ldat, t_VEC);
     208      371436 :   dbg = cgetg(lop,  t_VECSMALL);
     209      371438 :   frpc = cgetg(lfram,  t_VECSMALL);
     210      371439 :   fram = cgetg(lfram,  t_VEC);
     211      371437 :   gel(cl,5) = mkvec3(dbg, frpc, fram);
     212      371440 :   if (text) gel(cl,6) = text;
     213      371440 :   if (nbmvar) gel(cl,7) = zerovec(nbmvar);
     214      371440 :   s=GSTR(gel(cl,2))-1;
     215    31547605 :   for(i=1;i<lop;i++)
     216             :   {
     217    31176165 :     s[i] = opcode[i+pos->opcode-1];
     218    31176165 :     mael(cl, 3, i) = operand[i+pos->opcode-1];
     219    31176165 :     dbg[i] = dbginfo[i+pos->opcode-1]-dbgstart;
     220    31176165 :     if (dbg[i]<0) dbg[i]+=gap;
     221             :   }
     222      371440 :   s[i]=0;
     223      371440 :   s_opcode.n=pos->opcode;
     224      371440 :   s_operand.n=pos->opcode;
     225      371440 :   s_dbginfo.n=pos->opcode;
     226     2320572 :   for(i=1;i<ldat;i++)
     227     1949132 :     if(data[i+pos->data-1])
     228             :     {
     229     1949132 :       gmael(cl, 4, i) = gcopy(data[i+pos->data-1]);
     230     1949132 :       gunclone(data[i+pos->data-1]);
     231             :     }
     232      371440 :   s_data.n=pos->data;
     233      762992 :   while (s_lvar.n>pos->localvars && !localvars[s_lvar.n-1].inl)
     234       20112 :     s_lvar.n--;
     235      640480 :   for(i=1;i<lfram;i++)
     236             :   {
     237      269040 :     long j=i+pos->frames-1;
     238      269040 :     frpc[i] = frames[j].pc-pos->opcode+1;
     239      269040 :     gel(fram, i) = gcopy(frames[j].frame);
     240      269040 :     gunclone(frames[j].frame);
     241             :   }
     242      371440 :   s_frame.n=pos->frames;
     243      371440 :   offset=pos->offset;
     244      371440 :   dbgstart=pos->dbgstart;
     245      371440 :   return cl;
     246             : }
     247             : 
     248             : static GEN
     249       15258 : getclosure(struct codepos *pos)
     250             : {
     251       15258 :   return getfunction(pos,0,0,NULL,0);
     252             : }
     253             : 
     254             : static void
     255    31174452 : op_push_loc(op_code o, long x, const char *loc)
     256             : {
     257    31174452 :   long n=pari_stack_new(&s_opcode);
     258    31174445 :   long m=pari_stack_new(&s_operand);
     259    31174451 :   long d=pari_stack_new(&s_dbginfo);
     260    31174448 :   opcode[n]=o;
     261    31174448 :   operand[m]=x;
     262    31174448 :   dbginfo[d]=loc;
     263    31174448 : }
     264             : 
     265             : static void
     266    29257138 : op_push(op_code o, long x, long n)
     267             : {
     268    29257138 :   op_push_loc(o,x,tree[n].str);
     269    29257138 : }
     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     1949132 : data_push(GEN x)
     291             : {
     292     1949132 :   long n=pari_stack_new(&s_data);
     293     1949132 :   data[n] = x?gclone(x):x;
     294     1949132 :   return n-offset;
     295             : }
     296             : 
     297             : static void
     298       55711 : var_push(entree *ep, Ltype type)
     299             : {
     300       55711 :   long n=pari_stack_new(&s_lvar);
     301       55711 :   localvars[n].ep   = ep;
     302       55711 :   localvars[n].inl  = 0;
     303       55711 :   localvars[n].type = type;
     304       55711 : }
     305             : 
     306             : static void
     307      269037 : frame_push(GEN x)
     308             : {
     309      269037 :   long n=pari_stack_new(&s_frame);
     310      269037 :   frames[n].pc = s_opcode.n-1;
     311      269037 :   frames[n].frame = gclone(x);
     312      269039 : }
     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             :   GEN code;
     380       10738 :   long l=0;
     381       10738 :   if (pack)
     382             :   {
     383       10738 :     GEN t=gel(pack,1);
     384       10738 :     GEN e=gel(pack,2);
     385             :     long i;
     386       10738 :     l=lg(t)-1;
     387       46088 :     for(i=1;i<=l;i++)
     388       35350 :       var_push((entree*)e[i],(Ltype)t[i]);
     389             :   }
     390       10738 :   code = compile_str(x);
     391       10731 :   s_lvar.n -= l;
     392       10731 :   return closure_evalres(code);
     393             : }
     394             : 
     395             : long
     396           7 : localvars_find(GEN pack, entree *ep)
     397             : {
     398           7 :   GEN t=gel(pack,1);
     399           7 :   GEN e=gel(pack,2);
     400             :   long i;
     401           7 :   long vn=0;
     402           7 :   for(i=lg(e)-1;i>=1;i--)
     403             :   {
     404           0 :     if(t[i]==Lmy)
     405           0 :       vn--;
     406           0 :     if(e[i]==(long)ep)
     407           0 :       return t[i]==Lmy?vn:0;
     408             :   }
     409           7 :   return 0;
     410             : }
     411             : 
     412             : /*
     413             :  Flags for copy optimisation:
     414             :  -- Freturn: The result will be returned.
     415             :  -- FLsurvive: The result must survive the closure.
     416             :  -- FLnocopy: The result will never be updated nor part of a user variable.
     417             :  -- FLnocopylex: The result will never be updated nor part of dynamic variable.
     418             : */
     419             : enum FLflag {FLreturn=1, FLsurvive=2, FLnocopy=4, FLnocopylex=8};
     420             : 
     421             : static void
     422      185077 : addcopy(long n, long mode, long flag, long mask)
     423             : {
     424      185077 :   if (mode==Ggen && !(flag&mask))
     425             :   {
     426       19038 :     op_push(OCcopy,0,n);
     427       19038 :     if (!(flag&FLsurvive) && DEBUGLEVEL)
     428           0 :       pari_warn(warner,"compiler generates copy for `%.*s'",
     429           0 :                        tree[n].len,tree[n].str);
     430             :   }
     431      185077 : }
     432             : 
     433             : static void compilenode(long n, int mode, long flag);
     434             : 
     435             : typedef enum {PPend,PPstd,PPdefault,PPdefaultmulti,PPstar,PPauto} PPproto;
     436             : 
     437             : static PPproto
     438    11196188 : parseproto(char const **q, char *c, const char *str)
     439             : {
     440    11196188 :   char  const *p=*q;
     441             :   long i;
     442    11196188 :   switch(*p)
     443             :   {
     444             :   case 0:
     445             :   case '\n':
     446     4334887 :     return PPend;
     447             :   case 'D':
     448      164133 :     switch(p[1])
     449             :     {
     450             :     case 0:
     451           0 :       compile_err("function has incomplete prototype",str);
     452             :     case 'G':
     453             :     case '&':
     454             :     case 'W':
     455             :     case 'V':
     456             :     case 'I':
     457             :     case 'E':
     458             :     case 'J':
     459             :     case 'n':
     460             :     case 'P':
     461             :     case 'r':
     462             :     case 's':
     463      106607 :       *c=p[1];
     464      106607 :       *q=p+2;
     465      106607 :       return PPdefault;
     466             :     default:
     467       57526 :       for(i=0;*p && i<2;p++) i+=*p==',';
     468       57526 :       if (i<2)
     469           0 :         compile_err("function has incomplete prototype",str);
     470       57526 :       *c=p[-2];
     471       57526 :       *q=p;
     472       57526 :       return PPdefaultmulti;
     473             :     }
     474             :     break;
     475             :   case 'C':
     476             :   case 'p':
     477             :   case 'b':
     478             :   case 'P':
     479             :   case 'f':
     480       92180 :     *c=*p;
     481       92180 :     *q=p+1;
     482       92180 :     return PPauto;
     483             :   case '&':
     484        1078 :     *c='*';
     485        1078 :     *q=p+1;
     486        1078 :     return PPstd;
     487             :   case 'V':
     488       14152 :     if (p[1]=='=')
     489             :     {
     490       10524 :       if (p[2]!='G')
     491           0 :         compile_err("function prototype is not supported",str);
     492       10524 :       *c='=';
     493       10524 :       p+=2;
     494             :     }
     495             :     else
     496        3628 :       *c=*p;
     497       14152 :     *q=p+1;
     498       14152 :     return PPstd;
     499             :   case 'E':
     500             :   case 's':
     501       33732 :     if (p[1]=='*')
     502             :     {
     503       21945 :       *c=*p++;
     504       21945 :       *q=p+1;
     505       21945 :       return PPstar;
     506             :     }
     507             :     /*fall through*/
     508             :   }
     509     6567813 :   *c=*p;
     510     6567813 :   *q=p+1;
     511     6567813 :   return PPstd;
     512             : }
     513             : 
     514             : static long
     515      293598 : detag(long n)
     516             : {
     517      587196 :   while (tree[n].f==Ftag)
     518           0 :     n=tree[n].x;
     519      293598 :   return n;
     520             : }
     521             : 
     522             : /* return type for GP functions */
     523             : static op_code
     524     3843258 : get_ret_type(const char **p, long arity, Gtype *t, long *flag)
     525             : {
     526     3843258 :   *flag = 0;
     527     3843258 :   if (**p == 'v') { (*p)++; *t=Gvoid; return OCcallvoid; }
     528     3809201 :   else if (**p == 'i') { (*p)++; *t=Gsmall;  return OCcallint; }
     529     3804518 :   else if (**p == 'l') { (*p)++; *t=Gsmall;  return OCcalllong; }
     530     3784853 :   else if (**p == 'u') { (*p)++; *t=Gusmall; return OCcalllong; }
     531     3784853 :   else if (**p == 'm') { (*p)++; *flag = FLnocopy; }
     532     3784853 :   *t=Ggen; return arity==2?OCcallgen2:OCcallgen;
     533             : }
     534             : 
     535             : /*supported types:
     536             :  * type: Gusmall, Gsmall, Ggen, Gvoid, Gvec, Gclosure
     537             :  * mode: Gusmall, Gsmall, Ggen, Gvar, Gvoid
     538             :  */
     539             : static void
     540     6008919 : compilecast_loc(int type, int mode, const char *loc)
     541             : {
     542     6008919 :   if (type==mode) return;
     543     3890057 :   switch (mode)
     544             :   {
     545             :   case Gusmall:
     546          98 :     if (type==Ggen)        op_push_loc(OCitou,-1,loc);
     547          77 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     548          77 :     else if (type!=Gsmall)
     549           0 :       compile_err("this should be a small integer >=0",loc);
     550          98 :     break;
     551             :   case Gsmall:
     552        4055 :     if (type==Ggen)        op_push_loc(OCitos,-1,loc);
     553           7 :     else if (type==Gvoid)  op_push_loc(OCpushlong,0,loc);
     554           7 :     else if (type!=Gusmall)
     555           7 :       compile_err("this should be a small integer",loc);
     556        4048 :     break;
     557             :   case Ggen:
     558     3875432 :     if (type==Gsmall)      op_push_loc(OCstoi,0,loc);
     559     3864771 :     else if (type==Gusmall)op_push_loc(OCutoi,0,loc);
     560     3864771 :     else if (type==Gvoid)  op_push_loc(OCpushgnil,0,loc);
     561     3875432 :     break;
     562             :   case Gvoid:
     563        7574 :     op_push_loc(OCpop, 1,loc);
     564        7574 :     break;
     565             :   case Gvar:
     566        2898 :     if (type==Ggen)        op_push_loc(OCvarn,-1,loc);
     567           7 :     else compile_varerr(loc);
     568        2891 :      break;
     569             :   default:
     570           0 :     pari_err_BUG("compilecast [unknown type]");
     571             :   }
     572             : }
     573             : 
     574             : static void
     575     5757004 : compilecast(long n, int type, int mode) { compilecast_loc(type, mode, tree[n].str); }
     576             : 
     577             : static entree *
     578       22316 : fetch_member_raw(const char *s, long len)
     579             : {
     580       22316 :   pari_sp av = avma;
     581       22316 :   char *t = stack_malloc(len+2);
     582             :   entree *ep;
     583       22316 :   t[0] = '_'; strncpy(t+1, s, len); t[++len] = 0; /* prepend '_' */
     584       22316 :   ep = fetch_entry_raw(t, len);
     585       22316 :   set_avma(av); return ep;
     586             : }
     587             : static entree *
     588     5870170 : getfunc(long n)
     589             : {
     590     5870170 :   long x=tree[n].x;
     591     5870170 :   if (tree[x].x==CSTmember) /* str-1 points to '.' */
     592       22316 :     return do_alias(fetch_member_raw(tree[x].str - 1, tree[x].len + 1));
     593             :   else
     594     5847854 :     return do_alias(fetch_entry_raw(tree[x].str, tree[x].len));
     595             : }
     596             : 
     597             : static entree *
     598      248460 : getentry(long n)
     599             : {
     600      248460 :   n = detag(n);
     601      248460 :   if (tree[n].f!=Fentry)
     602             :   {
     603          14 :     if (tree[n].f==Fseq)
     604           0 :       compile_err("unexpected character: ';'", tree[tree[n].y].str-1);
     605          14 :     compile_varerr(tree[n].str);
     606             :   }
     607      248446 :   return getfunc(n);
     608             : }
     609             : 
     610             : /* match Fentry that are not actually EpSTATIC functions called without parens*/
     611             : static entree *
     612       55693 : getvar(long n)
     613             : {
     614       55693 :   entree *ep = getentry(n);
     615       55679 :   if (EpSTATIC(do_alias(ep)))
     616           0 :     compile_varerr(tree[n].str);
     617       55679 :   return ep;
     618             : }
     619             : 
     620             : static long
     621      243751 : getmvar(entree *ep)
     622             : {
     623             :   long i;
     624      243751 :   long vn=0;
     625      608379 :   for(i=s_lvar.n-1;i>=0;i--)
     626             :   {
     627      425859 :     if(localvars[i].type==Lmy)
     628      425649 :       vn--;
     629      425859 :     if(localvars[i].ep==ep)
     630       61231 :       return localvars[i].type==Lmy?vn:0;
     631             :   }
     632      182520 :   return 0;
     633             : }
     634             : 
     635             : static long
     636        7734 : ctxmvar(void)
     637             : {
     638        7734 :   pari_sp av=avma;
     639        7734 :   long i, n=0;
     640             :   GEN ctx;
     641       70084 :   for(i=s_lvar.n-1;i>=0;i--)
     642       62350 :     if(localvars[i].type==Lmy)
     643       62350 :       n++;
     644        7734 :   if (n==0) return 0;
     645        3804 :   ctx = cgetg(n+1,t_VECSMALL);
     646       66154 :   for(n=0, i=0; i<s_lvar.n; i++)
     647       62350 :     if(localvars[i].type==Lmy)
     648       62350 :       ctx[++n]=(long)localvars[i].ep;
     649        3804 :   frame_push(ctx);
     650        3804 :   set_avma(av); return n;
     651             : }
     652             : 
     653             : INLINE int
     654    30732066 : is_func_named(entree *ep, const char *s)
     655             : {
     656    30732066 :   return !strcmp(ep->name, s);
     657             : }
     658             : 
     659             : INLINE int
     660        2807 : is_node_zero(long n)
     661             : {
     662        2807 :   n = detag(n);
     663        2807 :   return (tree[n].f==Fsmall && tree[n].x==0);
     664             : }
     665             : 
     666             : static void
     667           7 : str_defproto(const char *p, const char *q, const char *loc)
     668             : {
     669           7 :   long len = p-4-q;
     670           7 :   if (q[1]!='"' || q[len]!='"')
     671           0 :     compile_err("default argument must be a string",loc);
     672           7 :   op_push_loc(OCpushgen,data_push(strntoGENexp(q+1,len)),loc);
     673           7 : }
     674             : 
     675             : static long
     676    13423251 : countlisttogen(long n, Ffunc f)
     677             : {
     678             :   long x,i;
     679    13423251 :   if (n==-1 || tree[n].f==Fnoarg) return 0;
     680    12327189 :   for(x=n, i=0; tree[x].f==f ;x=tree[x].x, i++);
     681    12327189 :   return i+1;
     682             : }
     683             : 
     684             : static GEN
     685    13422985 : listtogen(long n, Ffunc f)
     686             : {
     687    13422985 :   long x,i,nb = countlisttogen(n, f);
     688    13422985 :   GEN z=cgetg(nb+1, t_VECSMALL);
     689    13422985 :   if (nb)
     690             :   {
     691    12326923 :     for (x=n, i = nb-1; i>0; z[i+1]=tree[x].y, x=tree[x].x, i--);
     692    12326923 :     z[1]=x;
     693             :   }
     694    13422985 :   return z;
     695             : }
     696             : 
     697             : static long
     698     5637536 : first_safe_arg(GEN arg, long mask)
     699             : {
     700     5637536 :   long lnc, l=lg(arg);
     701     5637536 :   for (lnc=l-1; lnc>0 && (tree[arg[lnc]].flags&mask)==mask; lnc--);
     702     5637536 :   return lnc;
     703             : }
     704             : 
     705             : static void
     706       14791 : checkdups(GEN arg, GEN vep)
     707             : {
     708       14791 :   long l=vecsmall_duplicate(vep);
     709       14791 :   if (l!=0) compile_err("variable declared twice",tree[arg[l]].str);
     710       14791 : }
     711             : 
     712             : enum {MAT_range,MAT_std,MAT_line,MAT_column,VEC_std};
     713             : 
     714             : static int
     715       10896 : matindex_type(long n)
     716             : {
     717       10896 :   long x = tree[n].x, y = tree[n].y;
     718       10896 :   long fxx = tree[tree[x].x].f, fxy = tree[tree[x].y].f;
     719       10896 :   if (y==-1)
     720             :   {
     721        9447 :     if (fxy!=Fnorange) return MAT_range;
     722        9139 :     if (fxx==Fnorange) compile_err("missing index",tree[n].str);
     723        9139 :     return VEC_std;
     724             :   }
     725             :   else
     726             :   {
     727        1449 :     long fyx = tree[tree[y].x].f, fyy = tree[tree[y].y].f;
     728        1449 :     if (fxy!=Fnorange || fyy!=Fnorange) return MAT_range;
     729        1302 :     if (fxx==Fnorange && fyx==Fnorange)
     730           0 :       compile_err("missing index",tree[n].str);
     731        1302 :     if (fxx==Fnorange) return MAT_column;
     732         658 :     if (fyx==Fnorange) return MAT_line;
     733         441 :     return MAT_std;
     734             :   }
     735             : }
     736             : 
     737             : static entree *
     738       32079 : getlvalue(long n)
     739             : {
     740       64830 :   while ((tree[n].f==Fmatcoeff && matindex_type(tree[n].y)!=MAT_range) || tree[n].f==Ftag)
     741         672 :     n=tree[n].x;
     742       32079 :   return getvar(n);
     743             : }
     744             : 
     745             : INLINE void
     746       29965 : compilestore(long vn, entree *ep, long n)
     747             : {
     748       29965 :   if (vn)
     749        3378 :     op_push(OCstorelex,vn,n);
     750             :   else
     751       26587 :     op_push(OCstoredyn,(long)ep,n);
     752       29965 : }
     753             : 
     754             : INLINE void
     755         574 : compilenewptr(long vn, entree *ep, long n)
     756             : {
     757         574 :   if (vn)
     758         203 :     op_push(OCnewptrlex,vn,n);
     759             :   else
     760         371 :     op_push(OCnewptrdyn,(long)ep,n);
     761         574 : }
     762             : 
     763             : static void
     764        1246 : compilelvalue(long n)
     765             : {
     766        1246 :   n = detag(n);
     767        1246 :   if (tree[n].f==Fentry)
     768         574 :     return;
     769             :   else
     770             :   {
     771         672 :     long x = tree[n].x, y = tree[n].y;
     772         672 :     long yx = tree[y].x, yy = tree[y].y;
     773         672 :     long m = matindex_type(y);
     774         672 :     if (m == MAT_range)
     775           0 :       compile_err("not an lvalue",tree[n].str);
     776         672 :     if (m == VEC_std && tree[x].f==Fmatcoeff)
     777             :     {
     778          70 :       int mx = matindex_type(tree[x].y);
     779          70 :       if (mx==MAT_line)
     780             :       {
     781           0 :         int xy = tree[x].y, xyx = tree[xy].x;
     782           0 :         compilelvalue(tree[x].x);
     783           0 :         compilenode(tree[xyx].x,Gsmall,0);
     784           0 :         compilenode(tree[yx].x,Gsmall,0);
     785           0 :         op_push(OCcompo2ptr,0,y);
     786           0 :         return;
     787             :       }
     788             :     }
     789         672 :     compilelvalue(x);
     790         672 :     switch(m)
     791             :     {
     792             :     case VEC_std:
     793         392 :       compilenode(tree[yx].x,Gsmall,0);
     794         392 :       op_push(OCcompo1ptr,0,y);
     795         392 :       break;
     796             :     case MAT_std:
     797         112 :       compilenode(tree[yx].x,Gsmall,0);
     798         112 :       compilenode(tree[yy].x,Gsmall,0);
     799         112 :       op_push(OCcompo2ptr,0,y);
     800         112 :       break;
     801             :     case MAT_line:
     802          84 :       compilenode(tree[yx].x,Gsmall,0);
     803          84 :       op_push(OCcompoLptr,0,y);
     804          84 :       break;
     805             :     case MAT_column:
     806          84 :       compilenode(tree[yy].x,Gsmall,0);
     807          84 :       op_push(OCcompoCptr,0,y);
     808          84 :       break;
     809             :     }
     810             :   }
     811             : }
     812             : 
     813             : static void
     814        9482 : compilematcoeff(long n, int mode)
     815             : {
     816        9482 :   long x=tree[n].x, y=tree[n].y;
     817        9482 :   long yx=tree[y].x, yy=tree[y].y;
     818        9482 :   long m=matindex_type(y);
     819        9482 :   compilenode(x,Ggen,FLnocopy);
     820        9482 :   switch(m)
     821             :   {
     822             :   case VEC_std:
     823        8285 :     compilenode(tree[yx].x,Gsmall,0);
     824        8285 :     op_push(OCcompo1,mode,y);
     825        8285 :     return;
     826             :   case MAT_std:
     827         217 :     compilenode(tree[yx].x,Gsmall,0);
     828         217 :     compilenode(tree[yy].x,Gsmall,0);
     829         217 :     op_push(OCcompo2,mode,y);
     830         217 :     return;
     831             :   case MAT_line:
     832          49 :     compilenode(tree[yx].x,Gsmall,0);
     833          49 :     op_push(OCcompoL,0,y);
     834          49 :     compilecast(n,Gvec,mode);
     835          49 :     return;
     836             :   case MAT_column:
     837         476 :     compilenode(tree[yy].x,Gsmall,0);
     838         476 :     op_push(OCcompoC,0,y);
     839         476 :     compilecast(n,Gvec,mode);
     840         476 :     return;
     841             :   case MAT_range:
     842         455 :     compilenode(tree[yx].x,Gsmall,0);
     843         455 :     compilenode(tree[yx].y,Gsmall,0);
     844         455 :     if (yy==-1)
     845         308 :       op_push(OCcallgen,(long)is_entry("_[_.._]"),n);
     846             :     else
     847             :     {
     848         147 :       compilenode(tree[yy].x,Gsmall,0);
     849         147 :       compilenode(tree[yy].y,Gsmall,0);
     850         147 :       op_push(OCcallgen,(long)is_entry("_[_.._,_.._]"),n);
     851             :     }
     852         455 :     compilecast(n,Gvec,mode);
     853         448 :     return;
     854             :   default:
     855           0 :     pari_err_BUG("compilematcoeff");
     856             :   }
     857             : }
     858             : 
     859             : static void
     860     6871807 : compilesmall(long n, long x, long mode)
     861             : {
     862     6871807 :   if (mode==Ggen)
     863     6805025 :     op_push(OCpushstoi, x, n);
     864             :   else
     865             :   {
     866       66782 :     if (mode==Gusmall && x < 0)
     867           0 :       compile_err("this should be a small integer >=0",tree[n].str);
     868       66782 :     op_push(OCpushlong, x, n);
     869       66782 :     compilecast(n,Gsmall,mode);
     870             :   }
     871     6871800 : }
     872             : 
     873             : static void
     874     3837209 : compilevec(long n, long mode, op_code op)
     875             : {
     876     3837209 :   pari_sp ltop=avma;
     877     3837209 :   long x=tree[n].x;
     878             :   long i;
     879     3837209 :   GEN arg=listtogen(x,Fmatrixelts);
     880     3837209 :   long l=lg(arg);
     881     3837209 :   op_push(op,l,n);
     882    15966943 :   for (i=1;i<l;i++)
     883             :   {
     884    12129734 :     compilenode(arg[i],Ggen,FLsurvive);
     885    12129734 :     op_push(OCstackgen,i,n);
     886             :   }
     887     3837209 :   set_avma(ltop);
     888     3837209 :   op_push(OCpop,1,n);
     889     3837209 :   compilecast(n,Gvec,mode);
     890     3837209 : }
     891             : 
     892             : static void
     893        8491 : compilemat(long n, long mode)
     894             : {
     895        8491 :   pari_sp ltop=avma;
     896        8491 :   long x=tree[n].x;
     897             :   long i,j;
     898        8491 :   GEN line=listtogen(x,Fmatrixlines);
     899        8491 :   long lglin = lg(line), lgcol=0;
     900        8491 :   op_push(OCpushlong, lglin,n);
     901        8491 :   if (lglin==1)
     902         805 :     op_push(OCmat,1,n);
     903       43372 :   for(i=1;i<lglin;i++)
     904             :   {
     905       34881 :     GEN col=listtogen(line[i],Fmatrixelts);
     906       34881 :     long l=lg(col), k;
     907       34881 :     if (i==1)
     908             :     {
     909        7686 :       lgcol=l;
     910        7686 :       op_push(OCmat,lgcol,n);
     911             :     }
     912       27195 :     else if (l!=lgcol)
     913           0 :       compile_err("matrix must be rectangular",tree[line[i]].str);
     914       34881 :     k=i;
     915      229817 :     for(j=1;j<lgcol;j++)
     916             :     {
     917      194936 :       k-=lglin;
     918      194936 :       compilenode(col[j], Ggen, FLsurvive);
     919      194936 :       op_push(OCstackgen,k,n);
     920             :     }
     921             :   }
     922        8491 :   set_avma(ltop);
     923        8491 :   op_push(OCpop,1,n);
     924        8491 :   compilecast(n,Gvec,mode);
     925        8491 : }
     926             : 
     927             : 
     928             : static GEN
     929       36552 : cattovec(long n, long fnum)
     930             : {
     931       36552 :   long x=n, y, i=0, nb;
     932             :   GEN stack;
     933       36552 :   if (tree[n].f==Fnoarg) return cgetg(1,t_VECSMALL);
     934             :   while(1)
     935         210 :   {
     936       36762 :     long xx=tree[x].x;
     937       36762 :     long xy=tree[x].y;
     938       36762 :     if (tree[x].f!=Ffunction || xx!=fnum) break;
     939         210 :     x=tree[xy].x;
     940         210 :     y=tree[xy].y;
     941         210 :     if (tree[y].f==Fnoarg)
     942           0 :       compile_err("unexpected character: ", tree[y].str);
     943         210 :     i++;
     944             :   }
     945       36552 :   if (tree[x].f==Fnoarg)
     946           0 :     compile_err("unexpected character: ", tree[x].str);
     947       36552 :   nb=i+1;
     948       36552 :   stack=cgetg(nb+1,t_VECSMALL);
     949       36762 :   for(x=n;i>0;i--)
     950             :   {
     951         210 :     long y=tree[x].y;
     952         210 :     x=tree[y].x;
     953         210 :     stack[i+1]=tree[y].y;
     954             :   }
     955       36552 :   stack[1]=x;
     956       36552 :   return stack;
     957             : }
     958             : 
     959             : static GEN
     960          24 : compilelambda(long n, long y, GEN vep, struct codepos *pos)
     961             : {
     962          24 :   long nbmvar, lev = vep ? lg(vep)-1 : 0;
     963          24 :   GEN text=cgetg(3,t_VEC);
     964          24 :   gel(text,1)=strtoGENstr(lev? ((entree*) vep[1])->name: "");
     965          24 :   gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
     966          24 :   dbgstart = tree[y].str;
     967          24 :   nbmvar=ctxmvar()-lev;
     968          24 :   if (lev) op_push(OCgetargs,lev,n);
     969          24 :   compilenode(y,Ggen,FLsurvive|FLreturn);
     970          24 :   return getfunction(pos,lev,nbmvar,text,2);
     971             : }
     972             : 
     973             : static void
     974       19178 : compilecall(long n, int mode, entree *ep)
     975             : {
     976       19178 :   pari_sp ltop=avma;
     977             :   long j;
     978       19178 :   long x=tree[n].x;
     979       19178 :   long y=tree[n].y;
     980       19178 :   GEN arg=listtogen(y,Flistarg);
     981       19178 :   long nb=lg(arg)-1;
     982       19178 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
     983       19178 :   long lnl=first_safe_arg(arg, COsafelex);
     984       19178 :   long fl = lnl==0? (lnc==0? FLnocopy: FLnocopylex): 0;
     985       19178 :   if (ep==NULL)
     986         266 :     compilenode(x, Ggen, fl);
     987             :   else
     988             :   {
     989       18912 :     long vn=getmvar(ep);
     990       18912 :     if (vn)
     991         393 :       op_push(OCpushlex,vn,n);
     992             :     else
     993       18519 :       op_push(OCpushdyn,(long)ep,n);
     994             :   }
     995       51178 :   for (j=1;j<=nb;j++)
     996             :   {
     997       32000 :     long x = tree[arg[j]].x, f = tree[arg[j]].f;
     998       32000 :     if (f==Fseq)
     999           0 :       compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1000       32000 :     else if (f!=Fnoarg)
    1001       31853 :       compilenode(arg[j], Ggen,j>=lnl?FLnocopylex:0);
    1002             :     else
    1003         147 :       op_push(OCpushlong,0,n);
    1004             :   }
    1005       19178 :   op_push(OCcalluser,nb,x);
    1006       19178 :   compilecast(n,Ggen,mode);
    1007       19178 :   set_avma(ltop);
    1008       19178 : }
    1009             : 
    1010             : static GEN
    1011       15205 : compilefuncinline(long n, long c, long a, long flag, long isif, long lev, long *ev)
    1012             : {
    1013             :   struct codepos pos;
    1014       15205 :   int type=c=='I'?Gvoid:Ggen;
    1015       15205 :   long rflag=c=='I'?0:FLsurvive;
    1016       15205 :   GEN vep = NULL;
    1017       15205 :   if (isif && (flag&FLreturn)) rflag|=FLreturn;
    1018       15205 :   getcodepos(&pos);
    1019       15205 :   if (lev)
    1020             :   {
    1021             :     long i;
    1022        8732 :     GEN varg=cgetg(lev+1,t_VECSMALL);
    1023        8732 :     vep=cgetg(lev+1,t_VECSMALL);
    1024       17800 :     for(i=0;i<lev;i++)
    1025             :     {
    1026             :       entree *ve;
    1027        9068 :       if (ev[i]<0)
    1028           0 :         compile_err("missing variable name", tree[a].str-1);
    1029        9068 :       ve = getvar(ev[i]);
    1030        9068 :       vep[i+1]=(long)ve;
    1031        9068 :       varg[i+1]=ev[i];
    1032        9068 :       var_push(ve,Lmy);
    1033             :     }
    1034        8732 :     checkdups(varg,vep);
    1035        8732 :     frame_push(vep);
    1036             :   }
    1037       15205 :   if (c=='J')
    1038          24 :     return compilelambda(n,a,vep,&pos);
    1039       15181 :   else if (tree[a].f==Fnoarg)
    1040         112 :     compilecast(a,Gvoid,type);
    1041             :   else
    1042       15069 :     compilenode(a,type,rflag);
    1043       15181 :   return getclosure(&pos);
    1044             : }
    1045             : 
    1046             : static long
    1047        2285 : countvar(GEN arg)
    1048             : {
    1049        2285 :   long i, l = lg(arg);
    1050        2285 :   long n = l-1;
    1051        7028 :   for(i=1; i<l; i++)
    1052             :   {
    1053        4743 :     long a=arg[i];
    1054        4743 :     if (tree[a].f==Fassign)
    1055             :     {
    1056        2716 :       long x = detag(tree[a].x);
    1057        2716 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1058         266 :         n += countlisttogen(tree[x].x,Fmatrixelts)-1;
    1059             :     }
    1060             :   }
    1061        2285 :   return n;
    1062             : }
    1063             : 
    1064             : static void
    1065           2 : compileuninline(GEN arg)
    1066             : {
    1067             :   long j;
    1068           2 :   if (lg(arg) > 1)
    1069           0 :     compile_err("too many arguments",tree[arg[1]].str);
    1070           6 :   for(j=0; j<s_lvar.n; j++)
    1071           4 :     if(!localvars[j].inl)
    1072           0 :       pari_err(e_MISC,"uninline is only valid at top level");
    1073           2 :   s_lvar.n = 0;
    1074           2 : }
    1075             : 
    1076             : static void
    1077        2278 : compilemy(GEN arg, const char *str, int inl)
    1078             : {
    1079        2278 :   long i, j, k, l = lg(arg);
    1080        2278 :   long n = countvar(arg);
    1081        2278 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1082        2278 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1083        2278 :   if (inl)
    1084             :   {
    1085           2 :     for(j=0; j<s_lvar.n; j++)
    1086           0 :       if(!localvars[j].inl)
    1087           0 :         pari_err(e_MISC,"inline is only valid at top level");
    1088             :   }
    1089        6986 :   for(k=0, i=1; i<l; i++)
    1090             :   {
    1091        4708 :     long a=arg[i];
    1092        4708 :     if (tree[a].f==Fassign)
    1093             :     {
    1094        2688 :       long x = detag(tree[a].x);
    1095        2688 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1096             :       {
    1097         259 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1098         259 :         long nv = lg(vars)-1;
    1099         861 :         for (j=1; j<=nv; j++)
    1100             :         {
    1101         602 :           ver[++k] = vars[j];
    1102         602 :           vep[k] = (long)getvar(ver[k]);
    1103             :         }
    1104         259 :         continue;
    1105        2429 :       } else ver[++k] = x;
    1106        2020 :     } else ver[++k] = a;
    1107        4449 :     vep[k] = (long)getvar(ver[k]);
    1108             :   }
    1109        2278 :   checkdups(ver,vep);
    1110        2278 :   for(i=1; i<=n; i++) var_push(NULL,Lmy);
    1111        2278 :   op_push_loc(OCnewframe,inl?-n:n,str);
    1112        2278 :   frame_push(vep);
    1113        6986 :   for (k=0, i=1; i<l; i++)
    1114             :   {
    1115        4708 :     long a=arg[i];
    1116        4708 :     if (tree[a].f==Fassign)
    1117             :     {
    1118        2688 :       long x = detag(tree[a].x);
    1119        2688 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1120             :       {
    1121         259 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1122         259 :         long nv = lg(vars)-1;
    1123         259 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1124         259 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1125         861 :         for (j=1; j<=nv; j++)
    1126             :         {
    1127         602 :           long v = detag(vars[j]);
    1128         602 :           op_push(OCpushlong,j,v);
    1129         602 :           op_push(OCcompo1,Ggen,v);
    1130         602 :           k++;
    1131         602 :           op_push(OCstorelex,-n+k-1,a);
    1132         602 :           localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1133         602 :           localvars[s_lvar.n-n+k-1].inl=inl;
    1134             :         }
    1135         259 :         continue;
    1136             :       }
    1137        2429 :       else if (!is_node_zero(tree[a].y))
    1138             :       {
    1139        2366 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1140        2366 :         op_push(OCstorelex,-n+k,a);
    1141             :       }
    1142             :     }
    1143        4449 :     k++;
    1144        4449 :     localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
    1145        4449 :     localvars[s_lvar.n-n+k-1].inl=inl;
    1146             :   }
    1147        2278 : }
    1148             : 
    1149             : static long
    1150          42 : localpush(op_code op, long a)
    1151             : {
    1152          42 :   entree *ep = getvar(a);
    1153          42 :   long vep  = (long) ep;
    1154          42 :   op_push(op,vep,a);
    1155          42 :   var_push(ep,Llocal);
    1156          42 :   return vep;
    1157             : }
    1158             : 
    1159             : static void
    1160           7 : compilelocal(GEN arg)
    1161             : {
    1162           7 :   long i, j, k, l = lg(arg);
    1163           7 :   long n = countvar(arg);
    1164           7 :   GEN vep = cgetg(n+1,t_VECSMALL);
    1165           7 :   GEN ver = cgetg(n+1,t_VECSMALL);
    1166          42 :   for(k=0, i=1; i<l; i++)
    1167             :   {
    1168          35 :     long a=arg[i];
    1169          35 :     if (tree[a].f==Fassign)
    1170             :     {
    1171          28 :       long x = detag(tree[a].x);
    1172          28 :       if (tree[x].f==Fvec && tree[x].x>=0)
    1173             :       {
    1174           7 :         GEN vars = listtogen(tree[x].x,Fmatrixelts);
    1175           7 :         long nv = lg(vars)-1;
    1176           7 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1177           7 :         if (nv > 1) op_push(OCdup,nv-1,x);
    1178          21 :         for (j=1; j<=nv; j++)
    1179             :         {
    1180          14 :           long v = detag(vars[j]);
    1181          14 :           op_push(OCpushlong,j,v);
    1182          14 :           op_push(OCcompo1,Ggen,v);
    1183          14 :           vep[++k] = localpush(OClocalvar, v);
    1184          14 :           ver[k] = v;
    1185             :         }
    1186           7 :         continue;
    1187          21 :       } else if (!is_node_zero(tree[a].y))
    1188             :       {
    1189          14 :         compilenode(tree[a].y,Ggen,FLnocopy);
    1190          14 :         ver[++k] = x;
    1191          14 :         vep[k] = localpush(OClocalvar, ver[k]);
    1192          14 :         continue;
    1193             :       }
    1194             :       else
    1195           7 :         ver[++k] = x;
    1196             :     } else
    1197           7 :       ver[++k] = a;
    1198          14 :     vep[k] = localpush(OClocalvar0, ver[k]);
    1199             :   }
    1200           7 :   checkdups(ver,vep);
    1201           7 : }
    1202             : 
    1203             : static void
    1204           2 : compileexport(GEN arg)
    1205             : {
    1206           2 :   long i, l = lg(arg);
    1207           4 :   for (i=1; i<l; i++)
    1208             :   {
    1209           2 :     long a=arg[i];
    1210           2 :     if (tree[a].f==Fassign)
    1211             :     {
    1212           0 :       long x = detag(tree[a].x);
    1213           0 :       long v = (long) getvar(x);
    1214           0 :       compilenode(tree[a].y,Ggen,FLnocopy);
    1215           0 :       op_push(OCexportvar,v,x);
    1216             :     } else
    1217             :     {
    1218           2 :       long x = detag(a);
    1219           2 :       long v = (long) getvar(x);
    1220           2 :       op_push(OCpushdyn,v,x);
    1221           2 :       op_push(OCexportvar,v,x);
    1222             :     }
    1223             :   }
    1224           2 : }
    1225             : 
    1226             : static void
    1227           2 : compileunexport(GEN arg)
    1228             : {
    1229           2 :   long i, l = lg(arg);
    1230           4 :   for (i=1; i<l; i++)
    1231             :   {
    1232           2 :     long a = arg[i];
    1233           2 :     long x = detag(a);
    1234           2 :     long v = (long) getvar(x);
    1235           2 :     op_push(OCunexportvar,v,x);
    1236             :   }
    1237           2 : }
    1238             : 
    1239             : static void
    1240     2796783 : compilefunc(entree *ep, long n, int mode, long flag)
    1241             : {
    1242     2796783 :   pari_sp ltop=avma;
    1243             :   long j;
    1244     2796783 :   long x=tree[n].x, y=tree[n].y;
    1245             :   op_code ret_op;
    1246             :   long ret_flag;
    1247             :   Gtype ret_typ;
    1248             :   char const *p,*q;
    1249             :   char c;
    1250     2796783 :   const char *flags = NULL;
    1251             :   const char *str;
    1252             :   PPproto mod;
    1253     2796783 :   GEN arg=listtogen(y,Flistarg);
    1254     2796783 :   long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
    1255     2796783 :   long lnl=first_safe_arg(arg, COsafelex);
    1256     2796783 :   long nbpointers=0, nbopcodes;
    1257     2796783 :   long nb=lg(arg)-1, lev=0;
    1258             :   long ev[20];
    1259     2796783 :   if (x>=OPnboperator)
    1260      141788 :     str=tree[x].str;
    1261             :   else
    1262             :   {
    1263     2654995 :     if (nb==2)
    1264      268381 :       str=tree[arg[1]].str+tree[arg[1]].len;
    1265     2386614 :     else if (nb==1)
    1266     2385900 :       str=tree[arg[1]].str;
    1267             :     else
    1268         714 :       str=tree[n].str;
    1269     2654995 :     while(*str==')') str++;
    1270             :   }
    1271     2796783 :   if (tree[n].f==Fassign)
    1272             :   {
    1273           0 :     nb=2; lnc=2; lnl=2; arg=mkvecsmall2(x,y);
    1274             :   }
    1275     2796783 :   else if (is_func_named(ep,"if"))
    1276             :   {
    1277        3533 :     if (nb>=4)
    1278         112 :       ep=is_entry("_multi_if");
    1279        3421 :     else if (mode==Gvoid)
    1280        2125 :       ep=is_entry("_void_if");
    1281             :   }
    1282     2793250 :   else if (is_func_named(ep,"return") && (flag&FLreturn) && nb<=1)
    1283             :   {
    1284          91 :     if (nb==0) op_push(OCpushgnil,0,n);
    1285          91 :     else compilenode(arg[1],Ggen,FLsurvive|FLreturn);
    1286          91 :     set_avma(ltop);
    1287          91 :     return;
    1288             :   }
    1289     2793159 :   else if (is_func_named(ep,"inline"))
    1290             :   {
    1291           2 :     compilemy(arg, str, 1);
    1292           2 :     compilecast(n,Gvoid,mode);
    1293           2 :     set_avma(ltop);
    1294           2 :     return;
    1295             :   }
    1296     2793157 :   else if (is_func_named(ep,"uninline"))
    1297             :   {
    1298           2 :     compileuninline(arg);
    1299           2 :     compilecast(n,Gvoid,mode);
    1300           2 :     set_avma(ltop);
    1301           2 :     return;
    1302             :   }
    1303     2793155 :   else if (is_func_named(ep,"my"))
    1304             :   {
    1305        2276 :     compilemy(arg, str, 0);
    1306        2276 :     compilecast(n,Gvoid,mode);
    1307        2276 :     set_avma(ltop);
    1308        2276 :     return;
    1309             :   }
    1310     2790879 :   else if (is_func_named(ep,"local"))
    1311             :   {
    1312           7 :     compilelocal(arg);
    1313           7 :     compilecast(n,Gvoid,mode);
    1314           7 :     set_avma(ltop);
    1315           7 :     return;
    1316             :   }
    1317     2790872 :   else if (is_func_named(ep,"export"))
    1318             :   {
    1319           2 :     compileexport(arg);
    1320           2 :     compilecast(n,Gvoid,mode);
    1321           2 :     set_avma(ltop);
    1322           2 :     return;
    1323             :   }
    1324     2790870 :   else if (is_func_named(ep,"unexport"))
    1325             :   {
    1326           2 :     compileunexport(arg);
    1327           2 :     compilecast(n,Gvoid,mode);
    1328           2 :     set_avma(ltop);
    1329           2 :     return;
    1330             :   }
    1331             :   /*We generate dummy code for global() for compatibility with gp2c*/
    1332     2790868 :   else if (is_func_named(ep,"global"))
    1333             :   {
    1334             :     long i;
    1335           0 :     for (i=1;i<=nb;i++)
    1336             :     {
    1337           0 :       long a=arg[i];
    1338             :       long en;
    1339           0 :       if (tree[a].f==Fassign)
    1340             :       {
    1341           0 :         compilenode(tree[a].y,Ggen,0);
    1342           0 :         a=tree[a].x;
    1343           0 :         en=(long)getvar(a);
    1344           0 :         op_push(OCstoredyn,en,a);
    1345             :       }
    1346             :       else
    1347             :       {
    1348           0 :         en=(long)getvar(a);
    1349           0 :         op_push(OCpushdyn,en,a);
    1350           0 :         op_push(OCpop,1,a);
    1351             :       }
    1352             :     }
    1353           0 :     compilecast(n,Gvoid,mode);
    1354           0 :     set_avma(ltop);
    1355           0 :     return;
    1356             :   }
    1357     2790868 :   else if (is_func_named(ep,"O"))
    1358             :   {
    1359        3612 :     if (nb!=1)
    1360           0 :       compile_err("wrong number of arguments", tree[n].str+tree[n].len-1);
    1361        3612 :     ep=is_entry("O(_^_)");
    1362        3612 :     if (tree[arg[1]].f==Ffunction && tree[arg[1]].x==OPpow)
    1363             :     {
    1364        2807 :       arg = listtogen(tree[arg[1]].y,Flistarg);
    1365        2807 :       nb  = lg(arg)-1;
    1366        2807 :       lnc = first_safe_arg(arg,COsafelex|COsafedyn);
    1367        2807 :       lnl = first_safe_arg(arg,COsafelex);
    1368             :     }
    1369             :   }
    1370     2787256 :   else if (x==OPn && tree[y].f==Fsmall)
    1371             :   {
    1372     1997192 :     set_avma(ltop);
    1373     1997192 :     compilesmall(y, -tree[y].x, mode);
    1374     1997192 :     return;
    1375             :   }
    1376      790064 :   else if (x==OPtrans && tree[y].f==Fvec)
    1377             :   {
    1378        3150 :     set_avma(ltop);
    1379        3150 :     compilevec(y, mode, OCcol);
    1380        3150 :     return;
    1381             :   }
    1382      786914 :   else if (x==OPpow && nb==2 && tree[arg[2]].f==Fsmall)
    1383       41941 :     ep=is_entry("_^s");
    1384      744973 :   else if (x==OPcat)
    1385           0 :     compile_err("expected character: ',' or ')' instead of",
    1386           0 :         tree[arg[1]].str+tree[arg[1]].len);
    1387      794059 :   p=ep->code;
    1388      794059 :   if (!ep->value)
    1389           0 :     compile_err("unknown function",tree[n].str);
    1390      794059 :   nbopcodes = s_opcode.n;
    1391      794059 :   ret_op = get_ret_type(&p, ep->arity, &ret_typ, &ret_flag);
    1392      794059 :   j=1;
    1393      794059 :   if (*p)
    1394             :   {
    1395      787311 :     q=p;
    1396     2798942 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    1397             :     {
    1398     1224348 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    1399     1155296 :           && (mod==PPdefault || mod==PPdefaultmulti))
    1400       36932 :         mod=PPstd;
    1401     1224348 :       switch(mod)
    1402             :       {
    1403             :       case PPstd:
    1404     1144635 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    1405     1144635 :         if (c!='I' && c!='E' && c!='J')
    1406             :         {
    1407     1129885 :           long x = tree[arg[j]].x, f = tree[arg[j]].f;
    1408     1129885 :           if (f==Fnoarg)
    1409           0 :             compile_err("missing mandatory argument", tree[arg[j]].str);
    1410     1129885 :           if (f==Fseq)
    1411           0 :             compile_err("unexpected ';'", tree[x].str+tree[x].len);
    1412             :         }
    1413     1144635 :         switch(c)
    1414             :         {
    1415             :         case 'G':
    1416     1052650 :           compilenode(arg[j],Ggen,j>=lnl?(j>=lnc?FLnocopy:FLnocopylex):0);
    1417     1052650 :           j++;
    1418     1052650 :           break;
    1419             :         case 'W':
    1420             :           {
    1421         203 :             long a = arg[j];
    1422         203 :             entree *ep = getlvalue(a);
    1423         196 :             long vn = getmvar(ep);
    1424         196 :             if (vn) op_push(OCcowvarlex, vn, a);
    1425         168 :             else op_push(OCcowvardyn, (long)ep, a);
    1426         196 :             compilenode(arg[j++],Ggen,FLnocopy);
    1427         196 :             break;
    1428             :           }
    1429             :         case 'M':
    1430          42 :           if (tree[arg[j]].f!=Fsmall)
    1431             :           {
    1432          28 :             if (!flags) flags = ep->code;
    1433          28 :             flags = strchr(flags, '\n'); /* Skip to the following '\n' */
    1434          28 :             if (!flags)
    1435           0 :               compile_err("missing flag in string function signature",
    1436           0 :                            tree[n].str);
    1437          28 :             flags++;
    1438          28 :             if (tree[arg[j]].f==Fconst && tree[arg[j]].x==CSTstr)
    1439          28 :             {
    1440          28 :               GEN str=strntoGENexp(tree[arg[j]].str,tree[arg[j]].len);
    1441          28 :               op_push(OCpushlong, eval_mnemonic(str, flags),n);
    1442          28 :               j++;
    1443             :             } else
    1444             :             {
    1445           0 :               compilenode(arg[j++],Ggen,0);
    1446           0 :               op_push(OCpushlong,(long)flags,n);
    1447           0 :               op_push(OCcallgen2,(long)is_entry("_eval_mnemonic"),n);
    1448             :             }
    1449          28 :             break;
    1450             :           }
    1451             :         case 'P': case 'L':
    1452       59768 :           compilenode(arg[j++],Gsmall,0);
    1453       59761 :           break;
    1454             :         case 'U':
    1455          98 :           compilenode(arg[j++],Gusmall,0);
    1456          98 :           break;
    1457             :         case 'n':
    1458        2898 :           compilenode(arg[j++],Gvar,0);
    1459        2891 :           break;
    1460             :         case '&': case '*':
    1461             :           {
    1462        1491 :             long vn, a=arg[j++];
    1463             :             entree *ep;
    1464        1491 :             if (c=='&')
    1465             :             {
    1466         952 :               if (tree[a].f!=Frefarg)
    1467           0 :                 compile_err("expected character: '&'", tree[a].str);
    1468         952 :               a=tree[a].x;
    1469             :             }
    1470        1491 :             a=detag(a);
    1471        1491 :             ep=getlvalue(a);
    1472        1491 :             vn=getmvar(ep);
    1473        1491 :             if (tree[a].f==Fentry)
    1474             :             {
    1475        1337 :               if (vn)
    1476         336 :                 op_push(OCsimpleptrlex, vn,n);
    1477             :               else
    1478        1001 :                 op_push(OCsimpleptrdyn, (long)ep,n);
    1479             :             }
    1480             :             else
    1481             :             {
    1482         154 :               compilenewptr(vn, ep, a);
    1483         154 :               compilelvalue(a);
    1484         154 :               op_push(OCpushptr, 0, a);
    1485             :             }
    1486        1491 :             nbpointers++;
    1487        1491 :             break;
    1488             :           }
    1489             :         case 'I':
    1490             :         case 'E':
    1491             :         case 'J':
    1492             :           {
    1493       14750 :             long a = arg[j++];
    1494       14750 :             GEN  d = compilefuncinline(n, c, a, flag, is_func_named(ep,"if"), lev, ev);
    1495       14750 :             op_push(OCpushgen, data_push(d), a);
    1496       14750 :             if (lg(d)==8) op_push(OCsaveframe,FLsurvive,n);
    1497       14750 :             break;
    1498             :           }
    1499             :         case 'V':
    1500             :           {
    1501        3494 :             long a = arg[j++];
    1502        3494 :             (void)getvar(a);
    1503        3487 :             ev[lev++] = a;
    1504        3487 :             break;
    1505             :           }
    1506             :         case '=':
    1507             :           {
    1508        5262 :             long a = arg[j++];
    1509        5262 :             ev[lev++] = tree[a].x;
    1510        5262 :             compilenode(tree[a].y, Ggen, FLnocopy);
    1511             :           }
    1512        5262 :           break;
    1513             :         case 'r':
    1514             :           {
    1515        1361 :             long a=arg[j++];
    1516        1361 :             if (tree[a].f==Fentry)
    1517             :             {
    1518        1291 :               op_push(OCpushgen, data_push(strntoGENstr(tree[tree[a].x].str,
    1519        1291 :                                                         tree[tree[a].x].len)),n);
    1520        1291 :               op_push(OCtostr, -1,n);
    1521             :             }
    1522             :             else
    1523             :             {
    1524          70 :               compilenode(a,Ggen,FLnocopy);
    1525          70 :               op_push(OCtostr, -1,n);
    1526             :             }
    1527        1361 :             break;
    1528             :           }
    1529             :         case 's':
    1530             :           {
    1531        2632 :             long a = arg[j++];
    1532        2632 :             GEN g = cattovec(a, OPcat);
    1533        2632 :             long l, nb = lg(g)-1;
    1534        2632 :             if (nb==1)
    1535             :             {
    1536        2590 :               compilenode(g[1], Ggen, FLnocopy);
    1537        2590 :               op_push(OCtostr, -1, a);
    1538             :             } else
    1539             :             {
    1540          42 :               op_push(OCvec, nb+1, a);
    1541         126 :               for(l=1; l<=nb; l++)
    1542             :               {
    1543          84 :                 compilenode(g[l], Ggen, FLsurvive);
    1544          84 :                 op_push(OCstackgen,l, a);
    1545             :               }
    1546          42 :               op_push(OCpop, 1, a);
    1547          42 :               op_push(OCcallgen,(long)is_entry("Str"), a);
    1548          42 :               op_push(OCtostr, -1, a);
    1549             :             }
    1550        2632 :             break;
    1551             :           }
    1552             :         default:
    1553           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1554           0 :               tree[x].len, tree[x].str);
    1555             :         }
    1556     1144607 :         break;
    1557             :       case PPauto:
    1558       22876 :         switch(c)
    1559             :         {
    1560             :         case 'p':
    1561       20195 :           op_push(OCprecreal,0,n);
    1562       20195 :           break;
    1563             :         case 'b':
    1564        2639 :           op_push(OCbitprecreal,0,n);
    1565        2639 :           break;
    1566             :         case 'P':
    1567           0 :           op_push(OCprecdl,0,n);
    1568           0 :           break;
    1569             :         case 'C':
    1570          42 :           op_push(OCpushgen,data_push(pack_localvars()),n);
    1571          42 :           break;
    1572             :         case 'f':
    1573             :           {
    1574             :             static long foo;
    1575           0 :             op_push(OCpushlong,(long)&foo,n);
    1576           0 :             break;
    1577             :           }
    1578             :         }
    1579       22876 :         break;
    1580             :       case PPdefault:
    1581       26173 :         j++;
    1582       26173 :         switch(c)
    1583             :         {
    1584             :         case 'G':
    1585             :         case '&':
    1586             :         case 'E':
    1587             :         case 'I':
    1588             :         case 'r':
    1589             :         case 's':
    1590       19100 :           op_push(OCpushlong,0,n);
    1591       19100 :           break;
    1592             :         case 'n':
    1593        6252 :           op_push(OCpushlong,-1,n);
    1594        6252 :           break;
    1595             :         case 'V':
    1596         520 :           ev[lev++] = -1;
    1597         520 :           break;
    1598             :         case 'P':
    1599         301 :           op_push(OCprecdl,0,n);
    1600         301 :           break;
    1601             :         default:
    1602           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1603           0 :               tree[x].len, tree[x].str);
    1604             :         }
    1605       26173 :         break;
    1606             :       case PPdefaultmulti:
    1607       19723 :         j++;
    1608       19723 :         switch(c)
    1609             :         {
    1610             :         case 'G':
    1611         392 :           op_push(OCpushstoi,strtol(q+1,NULL,10),n);
    1612         392 :           break;
    1613             :         case 'L':
    1614             :         case 'M':
    1615       19282 :           op_push(OCpushlong,strtol(q+1,NULL,10),n);
    1616       19282 :           break;
    1617             :         case 'U':
    1618          42 :           op_push(OCpushlong,(long)strtoul(q+1,NULL,10),n);
    1619          42 :           break;
    1620             :         case 'r':
    1621             :         case 's':
    1622           7 :           str_defproto(p, q, tree[n].str);
    1623           7 :           op_push(OCtostr, -1, n);
    1624           7 :           break;
    1625             :         default:
    1626           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    1627           0 :               tree[x].len, tree[x].str);
    1628             :         }
    1629       19723 :         break;
    1630             :       case PPstar:
    1631       10941 :         switch(c)
    1632             :         {
    1633             :         case 'E':
    1634             :           {
    1635         112 :             long k, n=nb+1-j;
    1636         112 :             GEN g=cgetg(n+1,t_VEC);
    1637         112 :             int ismif = is_func_named(ep,"_multi_if");
    1638         567 :             for(k=1; k<=n; k++)
    1639         890 :               gel(g, k) = compilefuncinline(n, c, arg[j+k-1], flag,
    1640         455 :                           ismif && (k==n || odd(k)), lev, ev);
    1641         112 :             op_push(OCpushgen, data_push(g), arg[j]);
    1642         112 :             j=nb+1;
    1643         112 :             break;
    1644             :           }
    1645             :         case 's':
    1646             :           {
    1647       10829 :             long n=nb+1-j;
    1648             :             long k,l,l1,m;
    1649       10829 :             GEN g=cgetg(n+1,t_VEC);
    1650       26473 :             for(l1=0,k=1;k<=n;k++)
    1651             :             {
    1652       15644 :               gel(g,k)=cattovec(arg[j+k-1],OPcat);
    1653       15644 :               l1+=lg(gel(g,k))-1;
    1654             :             }
    1655       10829 :             op_push_loc(OCvec, l1+1, str);
    1656       26473 :             for(m=1,k=1;k<=n;k++)
    1657       31351 :               for(l=1;l<lg(gel(g,k));l++,m++)
    1658             :               {
    1659       15707 :                 compilenode(mael(g,k,l),Ggen,FLsurvive);
    1660       15707 :                 op_push(OCstackgen,m,mael(g,k,l));
    1661             :               }
    1662       10829 :             op_push_loc(OCpop, 1, str);
    1663       10829 :             j=nb+1;
    1664       10829 :             break;
    1665             :           }
    1666             :         default:
    1667           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    1668           0 :               tree[x].len, tree[x].str);
    1669             :         }
    1670       10941 :         break;
    1671             :       default:
    1672           0 :         pari_err_BUG("compilefunc [unknown PPproto]");
    1673             :       }
    1674     1224320 :       q=p;
    1675             :     }
    1676             :   }
    1677      794031 :   if (j<=nb)
    1678           0 :     compile_err("too many arguments",tree[arg[j]].str);
    1679      794031 :   op_push_loc(ret_op, (long) ep, str);
    1680      794031 :   if ((ret_flag&FLnocopy) && !(flag&FLnocopy))
    1681        9891 :     op_push_loc(OCcopy,0,str);
    1682      794031 :   if (ret_typ==Ggen && nbpointers==0 && s_opcode.n>nbopcodes+128)
    1683             :   {
    1684        1764 :     op_insert_loc(nbopcodes,OCavma,0,str);
    1685        1764 :     op_push_loc(OCgerepile,0,str);
    1686             :   }
    1687      794031 :   compilecast(n,ret_typ,mode);
    1688      794031 :   if (nbpointers) op_push_loc(OCendptr,nbpointers, str);
    1689      794031 :   set_avma(ltop);
    1690             : }
    1691             : 
    1692             : static void
    1693      250450 : genclosurectx(const char *loc, long nbdata)
    1694             : {
    1695             :   long i;
    1696      250450 :   GEN vep = cgetg(nbdata+1,t_VECSMALL);
    1697      778522 :   for(i = 1; i <= nbdata; i++)
    1698             :   {
    1699      528073 :     vep[i] = 0;
    1700      528073 :     op_push_loc(OCpushlex,-i,loc);
    1701             :   }
    1702      250449 :   frame_push(vep);
    1703      250451 : }
    1704             : 
    1705             : static GEN
    1706      258147 : genclosure(entree *ep, const char *loc, long nbdata, int check)
    1707             : {
    1708      258147 :   pari_sp av = avma;
    1709             :   struct codepos pos;
    1710      258147 :   long nb=0;
    1711      258147 :   const char *code=ep->code,*p,*q;
    1712             :   char c;
    1713             :   GEN text;
    1714      258147 :   long index=ep->arity;
    1715      258147 :   long arity=0, maskarg=0, maskarg0=0, stop=0, dovararg=0;
    1716             :   PPproto mod;
    1717             :   Gtype ret_typ;
    1718             :   long ret_flag;
    1719      258147 :   op_code ret_op=get_ret_type(&code,ep->arity,&ret_typ,&ret_flag);
    1720      258147 :   p=code;
    1721     1307247 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1722             :   {
    1723      790953 :     if (mod==PPauto)
    1724        1498 :       stop=1;
    1725             :     else
    1726             :     {
    1727      789455 :       if (stop) return NULL;
    1728      789455 :       if (c=='V') continue;
    1729      789455 :       maskarg<<=1; maskarg0<<=1; arity++;
    1730      789455 :       switch(mod)
    1731             :       {
    1732             :       case PPstd:
    1733      788430 :         maskarg|=1L;
    1734      788430 :         break;
    1735             :       case PPdefault:
    1736         422 :         switch(c)
    1737             :         {
    1738             :         case '&':
    1739             :         case 'E':
    1740             :         case 'I':
    1741          28 :           maskarg0|=1L;
    1742          28 :           break;
    1743             :         }
    1744         422 :         break;
    1745             :       default:
    1746         603 :         break;
    1747             :       }
    1748             :     }
    1749             :   }
    1750      258148 :   if (check && EpSTATIC(ep) && maskarg==0)
    1751        6233 :     return gen_0;
    1752      251915 :   getcodepos(&pos);
    1753      251915 :   dbgstart = loc;
    1754      251915 :   if (nbdata > arity)
    1755           0 :     pari_err(e_MISC,"too many parameters for closure `%s'", ep->name);
    1756      251916 :   if (nbdata) genclosurectx(loc, nbdata);
    1757      251917 :   text = strtoGENstr(ep->name);
    1758      251915 :   arity -= nbdata;
    1759      251915 :   if (maskarg)  op_push_loc(OCcheckargs,maskarg,loc);
    1760      251914 :   if (maskarg0) op_push_loc(OCcheckargs0,maskarg0,loc);
    1761      251914 :   p=code;
    1762     1293505 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1763             :   {
    1764      789675 :     switch(mod)
    1765             :     {
    1766             :     case PPauto:
    1767         560 :       switch(c)
    1768             :       {
    1769             :       case 'p':
    1770         560 :         op_push_loc(OCprecreal,0,loc);
    1771         560 :         break;
    1772             :       case 'b':
    1773           0 :         op_push_loc(OCbitprecreal,0,loc);
    1774           0 :         break;
    1775             :       case 'P':
    1776           0 :         op_push_loc(OCprecdl,0,loc);
    1777           0 :         break;
    1778             :       case 'C':
    1779           0 :         op_push_loc(OCpushgen,data_push(pack_localvars()),loc);
    1780           0 :         break;
    1781             :       case 'f':
    1782             :         {
    1783             :           static long foo;
    1784           0 :           op_push_loc(OCpushlong,(long)&foo,loc);
    1785           0 :           break;
    1786             :         }
    1787             :       }
    1788             :     default:
    1789      789677 :       break;
    1790             :     }
    1791             :   }
    1792      251916 :   q = p = code;
    1793     1293511 :   while ((mod=parseproto(&p,&c,NULL))!=PPend)
    1794             :   {
    1795      789678 :     switch(mod)
    1796             :     {
    1797             :     case PPstd:
    1798      788431 :       switch(c)
    1799             :       {
    1800             :       case 'G':
    1801      770249 :         break;
    1802             :       case 'M':
    1803             :       case 'L':
    1804        4812 :         op_push_loc(OCitos,-index,loc);
    1805        4813 :         break;
    1806             :       case 'U':
    1807       13348 :         op_push_loc(OCitou,-index,loc);
    1808       13348 :         break;
    1809             :       case 'n':
    1810           0 :         op_push_loc(OCvarn,-index,loc);
    1811           0 :         break;
    1812             :       case '&': case '*':
    1813             :       case 'I':
    1814             :       case 'E':
    1815             :       case 'V':
    1816             :       case '=':
    1817           0 :         return NULL;
    1818             :       case 'r':
    1819             :       case 's':
    1820          21 :         op_push_loc(OCtostr,-index,loc);
    1821          21 :         break;
    1822             :       }
    1823      788432 :       break;
    1824             :     case PPauto:
    1825         560 :       break;
    1826             :     case PPdefault:
    1827         373 :       switch(c)
    1828             :       {
    1829             :       case 'G':
    1830             :       case '&':
    1831             :       case 'E':
    1832             :       case 'I':
    1833             :       case 'V':
    1834             :       case 'r':
    1835             :       case 's':
    1836         198 :         break;
    1837             :       case 'n':
    1838         105 :         op_push_loc(OCvarn,-index,loc);
    1839         105 :         break;
    1840             :       case 'P':
    1841          70 :         op_push_loc(OCprecdl,0,loc);
    1842          70 :         op_push_loc(OCdefaultlong,-index,loc);
    1843          70 :         break;
    1844             :       default:
    1845           0 :         pari_err(e_MISC,"Unknown prototype code `D%c' for `%s'",c,ep->name);
    1846             :       }
    1847         373 :       break;
    1848             :     case PPdefaultmulti:
    1849         293 :       switch(c)
    1850             :       {
    1851             :       case 'G':
    1852           0 :         op_push_loc(OCpushstoi,strtol(q+1,NULL,10),loc);
    1853           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1854           0 :         break;
    1855             :       case 'L':
    1856             :       case 'M':
    1857         293 :         op_push_loc(OCpushlong,strtol(q+1,NULL,10),loc);
    1858         293 :         op_push_loc(OCdefaultlong,-index,loc);
    1859         293 :         break;
    1860             :       case 'U':
    1861           0 :         op_push_loc(OCpushlong,(long)strtoul(q+1,NULL,10),loc);
    1862           0 :         op_push_loc(OCdefaultulong,-index,loc);
    1863           0 :         break;
    1864             :       case 'r':
    1865             :       case 's':
    1866           0 :         str_defproto(p, q, loc);
    1867           0 :         op_push_loc(OCdefaultgen,-index,loc);
    1868           0 :         op_push_loc(OCtostr,-index,loc);
    1869           0 :         break;
    1870             :       default:
    1871           0 :         pari_err(e_MISC,
    1872             :             "Unknown prototype code `D...,%c,' for `%s'",c,ep->name);
    1873             :       }
    1874         293 :       break;
    1875             :     case PPstar:
    1876          21 :       switch(c)
    1877             :       {
    1878             :       case 's':
    1879          21 :         dovararg = 1;
    1880          21 :         break;
    1881             :       case 'E':
    1882           0 :         return NULL;
    1883             :       default:
    1884           0 :         pari_err(e_MISC,"Unknown prototype code `%c*' for `%s'",c,ep->name);
    1885             :       }
    1886          21 :       break;
    1887             :     default:
    1888           0 :       return NULL;
    1889             :     }
    1890      789679 :     index--;
    1891      789679 :     q = p;
    1892             :   }
    1893      251916 :   op_push_loc(ret_op, (long) ep, loc);
    1894      251915 :   if (ret_flag==FLnocopy) op_push_loc(OCcopy,0,loc);
    1895      251915 :   compilecast_loc(ret_typ, Ggen, loc);
    1896      251915 :   if (dovararg) nb|=VARARGBITS;
    1897      251915 :   return gerepilecopy(av, getfunction(&pos,nb+arity,nbdata,text,0));
    1898             : }
    1899             : 
    1900             : GEN
    1901       19411 : snm_closure(entree *ep, GEN data)
    1902             : {
    1903             :   long i;
    1904       19411 :   long n = data ? lg(data)-1: 0;
    1905       19411 :   GEN C = genclosure(ep,ep->name,n,0);
    1906       96955 :   for(i=1; i<=n; i++)
    1907       77544 :     gmael(C,7,i) = gel(data,i);
    1908       19411 :   return C;
    1909             : }
    1910             : 
    1911             : GEN
    1912      231048 : strtoclosure(const char *s, long n,  ...)
    1913             : {
    1914      231048 :   pari_sp av = avma;
    1915      231048 :   entree *ep = is_entry(s);
    1916             :   GEN C;
    1917      231048 :   if (!ep) pari_err(e_NOTFUNC, strtoGENstr(s));
    1918      231048 :   ep = do_alias(ep);
    1919      231046 :   if ((!EpSTATIC(ep) && EpVALENCE(ep)!=EpINSTALL) || !ep->value)
    1920           0 :     pari_err(e_MISC,"not a built-in/install'ed function: \"%s\"",s);
    1921      231047 :   C = genclosure(ep,ep->name,n,0);
    1922      231050 :   if (!C) pari_err(e_MISC,"function prototype unsupported: \"%s\"",s);
    1923             :   else
    1924             :   {
    1925             :     va_list ap;
    1926             :     long i;
    1927      231050 :     va_start(ap,n);
    1928      681589 :     for(i=1; i<=n; i++)
    1929      450539 :       gmael(C,7,i) = va_arg(ap, GEN);
    1930      231050 :     va_end(ap);
    1931             :   }
    1932      231050 :   return gerepilecopy(av, C);
    1933             : }
    1934             : 
    1935             : GEN
    1936           7 : strtofunction(const char *s)
    1937             : {
    1938           7 :   return strtoclosure(s, 0);
    1939             : }
    1940             : 
    1941             : GEN
    1942          21 : call0(GEN fun, GEN args)
    1943             : {
    1944          21 :   if (!is_vec_t(typ(args))) pari_err_TYPE("call",args);
    1945          21 :   switch(typ(fun))
    1946             :   {
    1947             :     case t_STR:
    1948           7 :       fun = strtofunction(GSTR(fun));
    1949             :     case t_CLOSURE: /* fall through */
    1950          21 :       return closure_callgenvec(fun, args);
    1951             :     default:
    1952           0 :       pari_err_TYPE("call", fun);
    1953             :       return NULL; /* LCOV_EXCL_LINE */
    1954             :   }
    1955             : }
    1956             : 
    1957             : static void
    1958        7690 : closurefunc(entree *ep, long n, long mode)
    1959             : {
    1960        7690 :   pari_sp ltop=avma;
    1961             :   GEN C;
    1962        7690 :   if (!ep->value) compile_err("unknown function",tree[n].str);
    1963        7690 :   C = genclosure(ep,tree[n].str,0,1);
    1964        7690 :   if (!C) compile_err("sorry, closure not implemented",tree[n].str);
    1965        7690 :   if (C==gen_0)
    1966             :   {
    1967        6233 :     compilefunc(ep,n,mode,0);
    1968        6233 :     return;
    1969             :   }
    1970        1457 :   op_push(OCpushgen, data_push(C), n);
    1971        1457 :   compilecast(n,Gclosure,mode);
    1972        1457 :   set_avma(ltop);
    1973             : }
    1974             : 
    1975             : static void
    1976       10544 : compileseq(long n, int mode, long flag)
    1977             : {
    1978       10544 :   pari_sp av = avma;
    1979       10544 :   GEN L = listtogen(n, Fseq);
    1980       10544 :   long i, l = lg(L)-1;
    1981       34834 :   for(i = 1; i < l; i++)
    1982       24290 :     compilenode(L[i],Gvoid,0);
    1983       10544 :   compilenode(L[l],mode,flag&(FLreturn|FLsurvive));
    1984       10544 :   set_avma(av);
    1985       10544 : }
    1986             : 
    1987             : static void
    1988    13703786 : compilenode(long n, int mode, long flag)
    1989             : {
    1990             :   long x,y;
    1991             : #ifdef STACK_CHECK
    1992    13703786 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    1993           0 :     pari_err(e_MISC, "expression nested too deeply");
    1994             : #endif
    1995    13703786 :   if (n<0) pari_err_BUG("compilenode");
    1996    13703786 :   x=tree[n].x;
    1997    13703786 :   y=tree[n].y;
    1998             : 
    1999    13703786 :   switch(tree[n].f)
    2000             :   {
    2001             :   case Fseq:
    2002       10544 :     compileseq(n, mode, flag);
    2003       10544 :     return;
    2004             :   case Fmatcoeff:
    2005        9482 :     compilematcoeff(n,mode);
    2006        9475 :     if (mode==Ggen && !(flag&FLnocopy))
    2007        2330 :       op_push(OCcopy,0,n);
    2008        9475 :     return;
    2009             :   case Fassign:
    2010       29832 :     x = detag(x);
    2011       29832 :     if (tree[x].f==Fvec && tree[x].x>=0)
    2012         469 :     {
    2013         469 :       GEN vars = listtogen(tree[x].x,Fmatrixelts);
    2014         469 :       long i, l = lg(vars)-1, d = mode==Gvoid? l-1: l;
    2015         469 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    2016         469 :       if (d) op_push(OCdup, d, x);
    2017        1491 :       for(i=1; i<=l; i++)
    2018             :       {
    2019        1022 :         long a = detag(vars[i]);
    2020        1022 :         entree *ep=getlvalue(a);
    2021        1022 :         long vn=getmvar(ep);
    2022        1022 :         op_push(OCpushlong,i,a);
    2023        1022 :         op_push(OCcompo1,Ggen,a);
    2024        1022 :         if (tree[a].f==Fentry)
    2025        1015 :           compilestore(vn,ep,n);
    2026             :         else
    2027             :         {
    2028           7 :           compilenewptr(vn,ep,n);
    2029           7 :           compilelvalue(a);
    2030           7 :           op_push(OCstoreptr,0,a);
    2031             :         }
    2032             :       }
    2033         469 :       if (mode!=Gvoid)
    2034         259 :         compilecast(n,Ggen,mode);
    2035             :     }
    2036             :     else
    2037             :     {
    2038       29363 :       entree *ep=getlvalue(x);
    2039       29363 :       long vn=getmvar(ep);
    2040       29363 :       if (tree[x].f!=Fentry)
    2041             :       {
    2042         413 :         compilenewptr(vn,ep,n);
    2043         413 :         compilelvalue(x);
    2044             :       }
    2045       29363 :       compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
    2046       29363 :       if (mode!=Gvoid)
    2047       18252 :         op_push(OCdup,1,n);
    2048       29363 :       if (tree[x].f==Fentry)
    2049       28950 :         compilestore(vn,ep,n);
    2050             :       else
    2051         413 :         op_push(OCstoreptr,0,x);
    2052       29363 :       if (mode!=Gvoid)
    2053       18252 :         compilecast(n,Ggen,mode);
    2054             :     }
    2055       29832 :     return;
    2056             :   case Fconst:
    2057             :     {
    2058     1926341 :       pari_sp ltop=avma;
    2059     1926341 :       if (tree[n].x!=CSTquote)
    2060             :       {
    2061     1923616 :         if (mode==Gvoid) return;
    2062     1923616 :         if (mode==Gvar) compile_varerr(tree[n].str);
    2063             :       }
    2064     1926341 :       if (mode==Gsmall)
    2065           0 :         compile_err("this should be a small integer", tree[n].str);
    2066     1926341 :       switch(tree[n].x)
    2067             :       {
    2068             :       case CSTreal:
    2069        3252 :         op_push(OCpushreal, data_push(strntoGENstr(tree[n].str,tree[n].len)),n);
    2070        3252 :         break;
    2071             :       case CSTint:
    2072      812233 :         op_push(OCpushgen,  data_push(strtoi((char*)tree[n].str)),n);
    2073      812233 :         compilecast(n,Ggen, mode);
    2074      812233 :         break;
    2075             :       case CSTstr:
    2076     1108131 :         op_push(OCpushgen,  data_push(strntoGENexp(tree[n].str,tree[n].len)),n);
    2077     1108131 :         break;
    2078             :       case CSTquote:
    2079             :         { /* skip ' */
    2080        2725 :           entree *ep = fetch_entry_raw(tree[n].str+1,tree[n].len-1);
    2081        2725 :           if (EpSTATIC(ep)) compile_varerr(tree[n].str+1);
    2082        2725 :           op_push(OCpushvar, (long)ep,n);
    2083        2725 :           compilecast(n,Ggen, mode);
    2084        2725 :           break;
    2085             :         }
    2086             :       default:
    2087           0 :         pari_err_BUG("compilenode, unsupported constant");
    2088             :       }
    2089     1926341 :       set_avma(ltop);
    2090     1926341 :       return;
    2091             :     }
    2092             :   case Fsmall:
    2093     4874615 :     compilesmall(n, x, mode);
    2094     4874608 :     return;
    2095             :   case Fvec:
    2096     3834059 :     compilevec(n, mode, OCvec);
    2097     3834059 :     return;
    2098             :   case Fmat:
    2099        8491 :     compilemat(n, mode);
    2100        8491 :     return;
    2101             :   case Frefarg:
    2102           0 :     compile_err("unexpected character '&':",tree[n].str);
    2103           0 :     return;
    2104             :   case Fentry:
    2105             :     {
    2106      192767 :       entree *ep=getentry(n);
    2107      192767 :       long vn=getmvar(ep);
    2108      192767 :       if (vn)
    2109             :       {
    2110       56851 :         op_push(OCpushlex,(long)vn,n);
    2111       56851 :         addcopy(n,mode,flag,FLnocopy|FLnocopylex);
    2112       56851 :         compilecast(n,Ggen,mode);
    2113             :       }
    2114      135916 :       else if (ep->valence==EpVAR || ep->valence==EpNEW)
    2115             :       {
    2116      128226 :         if (DEBUGLEVEL && mode==Gvoid)
    2117           0 :           pari_warn(warner,"statement with no effect: `%s'",ep->name);
    2118      128226 :         op_push(OCpushdyn,(long)ep,n);
    2119      128226 :         addcopy(n,mode,flag,FLnocopy);
    2120      128226 :         compilecast(n,Ggen,mode);
    2121             :       }
    2122             :       else
    2123        7690 :         closurefunc(ep,n,mode);
    2124      192767 :       return;
    2125             :     }
    2126             :   case Ffunction:
    2127             :     {
    2128     2809462 :       entree *ep=getfunc(n);
    2129     2809462 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2130             :       {
    2131       18912 :         if (tree[n].x<OPnboperator) /* should not happen */
    2132           0 :           compile_err("operator unknown",tree[n].str);
    2133       18912 :         compilecall(n,mode,ep);
    2134             :       }
    2135             :       else
    2136     2790550 :         compilefunc(ep,n,mode,flag);
    2137     2809434 :       return;
    2138             :     }
    2139             :   case Fcall:
    2140         266 :     compilecall(n,mode,NULL);
    2141         266 :     return;
    2142             :   case Flambda:
    2143             :     {
    2144        7710 :       pari_sp ltop=avma;
    2145             :       struct codepos pos;
    2146        7710 :       GEN arg=listtogen(x,Flistarg);
    2147        7710 :       long nb, lgarg, nbmvar, dovararg=0, gap;
    2148        7710 :       long strict = GP_DATA->strictargs;
    2149        7710 :       GEN vep = cgetg_copy(arg, &lgarg);
    2150        7710 :       GEN text=cgetg(3,t_VEC);
    2151        7710 :       gel(text,1)=strntoGENstr(tree[x].str,tree[x].len);
    2152        7710 :       gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
    2153        7710 :       getcodepos(&pos);
    2154        7710 :       dbgstart=tree[x].str+tree[x].len;
    2155        7710 :       gap = tree[y].str-dbgstart;
    2156        7710 :       nbmvar=ctxmvar();
    2157        7710 :       nb = lgarg-1;
    2158        7710 :       if (nb)
    2159             :       {
    2160             :         long i;
    2161        9729 :         for(i=1;i<=nb;i++)
    2162             :         {
    2163        5955 :           long a=arg[i];
    2164        5955 :           if (i==nb && tree[a].f==Fvararg)
    2165             :           {
    2166          21 :             dovararg=1;
    2167          21 :             vep[i]=(long)getvar(tree[a].x);
    2168             :           }
    2169             :           else
    2170        5934 :             vep[i]=(long)getvar(tree[a].f==Fassign?tree[a].x:a);
    2171        5955 :           var_push(NULL,Lmy);
    2172             :         }
    2173        3774 :         checkdups(arg,vep);
    2174        3774 :         op_push(OCgetargs,nb,x);
    2175        3774 :         frame_push(vep);
    2176        9729 :         for (i=1;i<=nb;i++)
    2177             :         {
    2178        5955 :           long a=arg[i];
    2179        5955 :           long y = tree[a].y;
    2180        5955 :           if (tree[a].f==Fassign && (strict || !is_node_zero(y)))
    2181             :           {
    2182         266 :             if (tree[y].f==Fsmall)
    2183         189 :               compilenode(y, Ggen, 0);
    2184             :             else
    2185             :             {
    2186             :               struct codepos lpos;
    2187          77 :               getcodepos(&lpos);
    2188          77 :               compilenode(y, Ggen, 0);
    2189          77 :               op_push(OCpushgen, data_push(getclosure(&lpos)),a);
    2190             :             }
    2191         266 :             op_push(OCdefaultarg,-nb+i-1,a);
    2192             :           }
    2193        5955 :           localvars[s_lvar.n-nb+i-1].ep=(entree*)vep[i];
    2194             :         }
    2195             :       }
    2196        7710 :       if (strict)
    2197          21 :         op_push(OCcheckuserargs,nb,x);
    2198        7710 :       dbgstart=tree[y].str;
    2199        7710 :       if (y>=0 && tree[y].f!=Fnoarg)
    2200        7710 :         compilenode(y,Ggen,FLsurvive|FLreturn);
    2201             :       else
    2202           0 :         compilecast(n,Gvoid,Ggen);
    2203        7710 :       if (dovararg) nb|=VARARGBITS;
    2204        7710 :       op_push(OCpushgen, data_push(getfunction(&pos,nb,nbmvar,text,gap)),n);
    2205        7710 :       if (nbmvar) op_push(OCsaveframe,!!(flag&FLsurvive),n);
    2206        7710 :       compilecast(n, Gclosure, mode);
    2207        7710 :       set_avma(ltop);
    2208        7710 :       return;
    2209             :     }
    2210             :   case Ftag:
    2211           0 :     compilenode(x, mode,flag);
    2212           0 :     return;
    2213             :   case Fnoarg:
    2214           7 :     compilecast(n,Gvoid,mode);
    2215           7 :     return;
    2216             :   case Fnorange:
    2217         210 :     op_push(OCpushlong,LONG_MAX,n);
    2218         210 :     compilecast(n,Gsmall,mode);
    2219         210 :     return;
    2220             :   default:
    2221           0 :     pari_err_BUG("compilenode");
    2222             :   }
    2223             : }
    2224             : 
    2225             : GEN
    2226       96488 : gp_closure(long n)
    2227             : {
    2228             :   struct codepos pos;
    2229       96488 :   getcodepos(&pos);
    2230       96488 :   dbgstart=tree[n].str;
    2231       96488 :   compilenode(n,Ggen,FLsurvive|FLreturn);
    2232       96460 :   return getfunction(&pos,0,0,strntoGENstr(tree[n].str,tree[n].len),0);
    2233             : }
    2234             : 
    2235             : GEN
    2236          70 : closure_deriv(GEN G)
    2237             : {
    2238          70 :   pari_sp ltop=avma;
    2239             :   long i;
    2240             :   struct codepos pos;
    2241             :   const char *code;
    2242             :   GEN text;
    2243          70 :   long arity=closure_arity(G);
    2244          70 :   if (arity==0 || closure_is_variadic(G))
    2245           0 :     pari_err_TYPE("derivfun",G);
    2246          70 :   if (typ(gel(G,6))==t_STR)
    2247             :   {
    2248          70 :     code = GSTR(gel(G,6));
    2249          70 :     text = cgetg(1+nchar2nlong(2+strlen(code)),t_STR);
    2250          70 :     sprintf(GSTR(text),"%s'",code);
    2251             :   }
    2252             :   else
    2253             :   {
    2254           0 :     code = GSTR(GENtoGENstr(G));
    2255           0 :     text = cgetg(1+nchar2nlong(4+strlen(code)),t_STR);
    2256           0 :     sprintf(GSTR(text),"(%s)'",code);
    2257             :   }
    2258          70 :   getcodepos(&pos);
    2259          70 :   dbgstart=code;
    2260          70 :   op_push_loc(OCgetargs, arity,code);
    2261          70 :   op_push_loc(OCpushgen,data_push(G),code);
    2262          70 :   op_push_loc(OCvec,arity+1,code);
    2263         140 :   for (i=1;i<=arity;i++)
    2264             :   {
    2265          70 :     op_push_loc(OCpushlex,i-arity-1,code);
    2266          70 :     op_push_loc(OCstackgen,i,code);
    2267             :   }
    2268          70 :   op_push_loc(OCpop,1,code);
    2269          70 :   op_push_loc(OCprecreal,0,code);
    2270          70 :   op_push_loc(OCcallgen,(long)is_entry("_derivfun"),code);
    2271          70 :   return gerepilecopy(ltop, getfunction(&pos,arity,0,text,0));
    2272             : }
    2273             : 
    2274             : static long
    2275     3917980 : vec_optimize(GEN arg)
    2276             : {
    2277     3917980 :   long fl = COsafelex|COsafedyn;
    2278             :   long i;
    2279    16303035 :   for (i=1; i<lg(arg); i++)
    2280             :   {
    2281    12385062 :     optimizenode(arg[i]);
    2282    12385055 :     fl &= tree[arg[i]].flags;
    2283             :   }
    2284     3917973 :   return fl;
    2285             : }
    2286             : 
    2287             : static void
    2288     3837944 : optimizevec(long n)
    2289             : {
    2290     3837944 :   pari_sp ltop=avma;
    2291     3837944 :   long x = tree[n].x;
    2292     3837944 :   GEN  arg = listtogen(x, Fmatrixelts);
    2293     3837944 :   tree[n].flags = vec_optimize(arg);
    2294     3837944 :   set_avma(ltop);
    2295     3837944 : }
    2296             : 
    2297             : static void
    2298        8491 : optimizemat(long n)
    2299             : {
    2300        8491 :   pari_sp ltop = avma;
    2301        8491 :   long x = tree[n].x;
    2302             :   long i;
    2303        8491 :   GEN line = listtogen(x,Fmatrixlines);
    2304        8491 :   long fl = COsafelex|COsafedyn;
    2305       43372 :   for(i=1;i<lg(line);i++)
    2306             :   {
    2307       34881 :     GEN col=listtogen(line[i],Fmatrixelts);
    2308       34881 :     fl &= vec_optimize(col);
    2309             :   }
    2310        8491 :   set_avma(ltop); tree[n].flags=fl;
    2311        8491 : }
    2312             : 
    2313             : static void
    2314       10154 : optimizematcoeff(long n)
    2315             : {
    2316       10154 :   long x=tree[n].x;
    2317       10154 :   long y=tree[n].y;
    2318       10154 :   long yx=tree[y].x;
    2319       10154 :   long yy=tree[y].y;
    2320             :   long fl;
    2321       10154 :   optimizenode(x);
    2322       10154 :   optimizenode(yx);
    2323       10154 :   fl=tree[x].flags&tree[yx].flags;
    2324       10154 :   if (yy>=0)
    2325             :   {
    2326        1169 :     optimizenode(yy);
    2327        1169 :     fl&=tree[yy].flags;
    2328             :   }
    2329       10154 :   tree[n].flags=fl;
    2330       10154 : }
    2331             : 
    2332             : 
    2333             : static void
    2334     2793343 : optimizefunc(entree *ep, long n)
    2335             : {
    2336     2793343 :   pari_sp av=avma;
    2337             :   long j;
    2338     2793343 :   long x=tree[n].x;
    2339     2793343 :   long y=tree[n].y;
    2340             :   Gtype t;
    2341             :   PPproto mod;
    2342     2793343 :   long fl=COsafelex|COsafedyn;
    2343             :   const char *p;
    2344             :   char c;
    2345     2793343 :   GEN arg = listtogen(y,Flistarg);
    2346     2793343 :   long nb=lg(arg)-1, ret_flag;
    2347     2793343 :   if (is_func_named(ep,"if") && nb>=4)
    2348         112 :     ep=is_entry("_multi_if");
    2349     2793343 :   p = ep->code;
    2350     2793343 :   if (!p)
    2351        2291 :     fl=0;
    2352             :   else
    2353     2791052 :     (void) get_ret_type(&p, 2, &t, &ret_flag);
    2354     2793343 :   if (p && *p)
    2355             :   {
    2356     2785649 :     j=1;
    2357     8837941 :     while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
    2358             :     {
    2359     3266664 :       if (j<=nb && tree[arg[j]].f!=Fnoarg
    2360     3154917 :           && (mod==PPdefault || mod==PPdefaultmulti))
    2361       34216 :         mod=PPstd;
    2362     3266664 :       switch(mod)
    2363             :       {
    2364             :       case PPstd:
    2365     3144284 :         if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
    2366     3144263 :         if (tree[arg[j]].f==Fnoarg && c!='I' && c!='E')
    2367           0 :           compile_err("missing mandatory argument", tree[arg[j]].str);
    2368     3144263 :         switch(c)
    2369             :         {
    2370             :         case 'G':
    2371             :         case 'n':
    2372             :         case 'M':
    2373             :         case 'L':
    2374             :         case 'U':
    2375             :         case 'P':
    2376     3115049 :           optimizenode(arg[j]);
    2377     3115049 :           fl&=tree[arg[j++]].flags;
    2378     3115049 :           break;
    2379             :         case 'I':
    2380             :         case 'E':
    2381             :         case 'J':
    2382       14757 :           optimizenode(arg[j]);
    2383       14757 :           fl&=tree[arg[j]].flags;
    2384       14757 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2385       14757 :           break;
    2386             :         case '&': case '*':
    2387             :           {
    2388        1491 :             long a=arg[j];
    2389        1491 :             if (c=='&')
    2390             :             {
    2391         952 :               if (tree[a].f!=Frefarg)
    2392           0 :                 compile_err("expected character: '&'", tree[a].str);
    2393         952 :               a=tree[a].x;
    2394             :             }
    2395        1491 :             optimizenode(a);
    2396        1491 :             tree[arg[j++]].flags=COsafelex|COsafedyn;
    2397        1491 :             fl=0;
    2398        1491 :             break;
    2399             :           }
    2400             :         case 'W':
    2401         217 :           optimizenode(arg[j++]);
    2402         217 :           fl=0;
    2403         217 :           break;
    2404             :         case 'V':
    2405             :         case 'r':
    2406        4855 :           tree[arg[j++]].flags=COsafelex|COsafedyn;
    2407        4855 :           break;
    2408             :         case '=':
    2409             :           {
    2410        5262 :             long a=arg[j++], y=tree[a].y;
    2411        5262 :             if (tree[a].f!=Fassign)
    2412           0 :               compile_err("expected character: '=' instead of",
    2413           0 :                   tree[a].str+tree[a].len);
    2414        5262 :             optimizenode(y);
    2415        5262 :             fl&=tree[y].flags;
    2416             :           }
    2417        5262 :           break;
    2418             :         case 's':
    2419        2632 :           fl &= vec_optimize(cattovec(arg[j++], OPcat));
    2420        2632 :           break;
    2421             :         default:
    2422           0 :           pari_err(e_MISC,"Unknown prototype code `%c' for `%.*s'",c,
    2423           0 :               tree[x].len, tree[x].str);
    2424             :         }
    2425     3144263 :         break;
    2426             :       case PPauto:
    2427       66686 :         break;
    2428             :       case PPdefault:
    2429             :       case PPdefaultmulti:
    2430       44753 :         if (j<=nb) optimizenode(arg[j++]);
    2431       44753 :         break;
    2432             :       case PPstar:
    2433       10941 :         switch(c)
    2434             :         {
    2435             :         case 'E':
    2436             :           {
    2437         112 :             long n=nb+1-j;
    2438             :             long k;
    2439         567 :             for(k=1;k<=n;k++)
    2440             :             {
    2441         455 :               optimizenode(arg[j+k-1]);
    2442         455 :               fl &= tree[arg[j+k-1]].flags;
    2443             :             }
    2444         112 :             j=nb+1;
    2445         112 :             break;
    2446             :           }
    2447             :         case 's':
    2448             :           {
    2449       10829 :             long n=nb+1-j;
    2450             :             long k;
    2451       26473 :             for(k=1;k<=n;k++)
    2452       15644 :               fl &= vec_optimize(cattovec(arg[j+k-1],OPcat));
    2453       10829 :             j=nb+1;
    2454       10829 :             break;
    2455             :           }
    2456             :         default:
    2457           0 :           pari_err(e_MISC,"Unknown prototype code `%c*' for `%.*s'",c,
    2458           0 :               tree[x].len, tree[x].str);
    2459             :         }
    2460       10941 :         break;
    2461             :       default:
    2462           0 :         pari_err_BUG("optimizefun [unknown PPproto]");
    2463             :       }
    2464             :     }
    2465     5571256 :     if (j<=nb)
    2466           0 :       compile_err("too many arguments",tree[arg[j]].str);
    2467             :   }
    2468        7694 :   else (void)vec_optimize(arg);
    2469     2793322 :   set_avma(av); tree[n].flags=fl;
    2470     2793322 : }
    2471             : 
    2472             : static void
    2473       19185 : optimizecall(long n)
    2474             : {
    2475       19185 :   pari_sp av=avma;
    2476       19185 :   long x=tree[n].x;
    2477       19185 :   long y=tree[n].y;
    2478       19185 :   GEN arg=listtogen(y,Flistarg);
    2479       19185 :   optimizenode(x);
    2480       19185 :   tree[n].flags = COsafelex&tree[x].flags&vec_optimize(arg);
    2481       19178 :   set_avma(av);
    2482       19178 : }
    2483             : 
    2484             : static void
    2485       10544 : optimizeseq(long n)
    2486             : {
    2487       10544 :   pari_sp av = avma;
    2488       10544 :   GEN L = listtogen(n, Fseq);
    2489       10544 :   long i, l = lg(L)-1, flags=-1L;
    2490       45378 :   for(i = 1; i <= l; i++)
    2491             :   {
    2492       34834 :     optimizenode(L[i]);
    2493       34834 :     flags &= tree[L[i]].flags;
    2494             :   }
    2495       10544 :   set_avma(av);
    2496       10544 :   tree[n].flags = flags;
    2497       10544 : }
    2498             : 
    2499             : void
    2500    15790748 : optimizenode(long n)
    2501             : {
    2502             :   long x,y;
    2503             : #ifdef STACK_CHECK
    2504    15790748 :   if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
    2505           0 :     pari_err(e_MISC, "expression nested too deeply");
    2506             : #endif
    2507    15790748 :   if (n<0)
    2508           0 :     pari_err_BUG("optimizenode");
    2509    15790748 :   x=tree[n].x;
    2510    15790748 :   y=tree[n].y;
    2511             : 
    2512    15790748 :   switch(tree[n].f)
    2513             :   {
    2514             :   case Fseq:
    2515       10544 :     optimizeseq(n);
    2516       10544 :     return;
    2517             :   case Frange:
    2518       11323 :     optimizenode(x);
    2519       11323 :     optimizenode(y);
    2520       11323 :     tree[n].flags=tree[x].flags&tree[y].flags;
    2521       11323 :     break;
    2522             :   case Fmatcoeff:
    2523       10154 :     optimizematcoeff(n);
    2524       10154 :     break;
    2525             :   case Fassign:
    2526       32548 :     optimizenode(x);
    2527       32548 :     optimizenode(y);
    2528       32548 :     tree[n].flags=0;
    2529       32548 :     break;
    2530             :   case Fnoarg:
    2531             :   case Fnorange:
    2532             :   case Fsmall:
    2533             :   case Fconst:
    2534             :   case Fentry:
    2535     9059499 :     tree[n].flags=COsafelex|COsafedyn;
    2536     9059499 :     return;
    2537             :   case Fvec:
    2538     3837944 :     optimizevec(n);
    2539     3837944 :     return;
    2540             :   case Fmat:
    2541        8491 :     optimizemat(n);
    2542        8491 :     return;
    2543             :   case Frefarg:
    2544           7 :     compile_err("unexpected character '&'",tree[n].str);
    2545           0 :     return;
    2546             :   case Fvararg:
    2547           0 :     compile_err("unexpected characters '..'",tree[n].str);
    2548           0 :     return;
    2549             :   case Ffunction:
    2550             :     {
    2551     2812262 :       entree *ep=getfunc(n);
    2552     2812262 :       if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
    2553       18919 :         optimizecall(n);
    2554             :       else
    2555     2793343 :         optimizefunc(ep,n);
    2556     2812234 :       return;
    2557             :     }
    2558             :   case Fcall:
    2559         266 :     optimizecall(n);
    2560         266 :     return;
    2561             :   case Flambda:
    2562        7710 :     optimizenode(y);
    2563        7710 :     tree[n].flags=COsafelex|COsafedyn;
    2564        7710 :     return;
    2565             :   case Ftag:
    2566           0 :     optimizenode(x);
    2567           0 :     tree[n].flags=tree[x].flags;
    2568           0 :     return;
    2569             :   default:
    2570           0 :     pari_err_BUG("optimizenode");
    2571             :   }
    2572             : }

Generated by: LCOV version 1.13