Code coverage tests

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

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

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

LCOV - code coverage report
Current view: top level - language - compile.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25819-e703fe1174) Lines: 1574 1746 90.1 %
Date: 2020-09-18 06:10:04 Functions: 86 88 97.7 %
Legend: Lines: hit not hit

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

Generated by: LCOV version 1.13