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