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 843768 : translate(const char **src, char *s)
35 : {
36 843768 : const char *t = *src;
37 6719190 : while (*t)
38 : {
39 6719838 : 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 6719190 : if (*t == '"')
51 : {
52 843768 : if (t[1] != '"') break;
53 0 : t += 2; continue;
54 : }
55 5875422 : *s++ = *t++;
56 : }
57 843768 : *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 843764 : strntoGENexp(const char *str, long len)
79 : {
80 843764 : long n = nchar2nlong(len-1);
81 843764 : GEN z = cgetg(1+n, t_STR);
82 843764 : const char *t = str+1;
83 843764 : z[n] = 0;
84 843764 : if (!translate(&t, GSTR(z))) compile_err("run-away string",str);
85 843764 : 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 318350 : pari_init_compiler(void)
122 : {
123 318350 : pari_stack_init(&s_opcode,sizeof(*opcode),(void **)&opcode);
124 318219 : pari_stack_init(&s_operand,sizeof(*operand),(void **)&operand);
125 318106 : pari_stack_init(&s_accesslex,sizeof(*operand),(void **)&accesslex);
126 318038 : pari_stack_init(&s_data,sizeof(*data),(void **)&data);
127 318018 : pari_stack_init(&s_lvar,sizeof(*localvars),(void **)&localvars);
128 317971 : pari_stack_init(&s_dbginfo,sizeof(*dbginfo),(void **)&dbginfo);
129 317968 : pari_stack_init(&s_frame,sizeof(*frames),(void **)&frames);
130 317970 : offset=-1; nblex=0;
131 317970 : }
132 : void
133 315875 : pari_close_compiler(void)
134 : {
135 315875 : pari_stack_delete(&s_opcode);
136 314474 : pari_stack_delete(&s_operand);
137 313290 : pari_stack_delete(&s_accesslex);
138 312409 : pari_stack_delete(&s_data);
139 311749 : pari_stack_delete(&s_lvar);
140 311217 : pari_stack_delete(&s_dbginfo);
141 311109 : pari_stack_delete(&s_frame);
142 311290 : }
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 9030725 : getcodepos(struct codepos *pos)
153 : {
154 9030725 : pos->opcode=s_opcode.n;
155 9030725 : pos->accesslex=s_accesslex.n;
156 9030725 : pos->data=s_data.n;
157 9030725 : pos->offset=offset;
158 9030725 : pos->nblex=nblex;
159 9030725 : pos->localvars=s_lvar.n;
160 9030725 : pos->dbgstart=dbgstart;
161 9030725 : pos->frames=s_frame.n;
162 9030725 : offset=s_data.n-1;
163 9030725 : }
164 :
165 : void
166 417 : compilestate_reset(void)
167 : {
168 417 : s_opcode.n=0;
169 417 : s_operand.n=0;
170 417 : s_accesslex.n=0;
171 417 : s_dbginfo.n=0;
172 417 : s_data.n=0;
173 417 : s_lvar.n=0;
174 417 : s_frame.n=0;
175 417 : offset=-1;
176 417 : nblex=0;
177 417 : dbgstart=NULL;
178 417 : }
179 :
180 : void
181 1413075 : compilestate_save(struct pari_compilestate *comp)
182 : {
183 1413075 : comp->opcode=s_opcode.n;
184 1413075 : comp->operand=s_operand.n;
185 1413075 : comp->accesslex=s_accesslex.n;
186 1413075 : comp->data=s_data.n;
187 1413075 : comp->offset=offset;
188 1413075 : comp->nblex=nblex;
189 1413075 : comp->localvars=s_lvar.n;
190 1413075 : comp->dbgstart=dbgstart;
191 1413075 : comp->dbginfo=s_dbginfo.n;
192 1413075 : comp->frames=s_frame.n;
193 1413075 : }
194 :
195 : void
196 48451 : compilestate_restore(struct pari_compilestate *comp)
197 : {
198 48451 : s_opcode.n=comp->opcode;
199 48451 : s_operand.n=comp->operand;
200 48451 : s_accesslex.n=comp->accesslex;
201 48451 : s_data.n=comp->data;
202 48451 : offset=comp->offset;
203 48451 : nblex=comp->nblex;
204 48451 : s_lvar.n=comp->localvars;
205 48451 : dbgstart=comp->dbgstart;
206 48451 : s_dbginfo.n=comp->dbginfo;
207 48451 : s_frame.n=comp->frames;
208 48451 : }
209 :
210 : static GEN
211 9816930 : gcopyunclone(GEN x) { GEN y = gcopy(x); gunclone(x); return y; }
212 :
213 : static void
214 107221 : access_push(long x)
215 : {
216 107221 : long a = pari_stack_new(&s_accesslex);
217 107221 : accesslex[a] = x;
218 107221 : }
219 :
220 : static GEN
221 8087751 : genctx(long nbmvar, long paccesslex)
222 : {
223 8087751 : GEN acc = const_vec(nbmvar,gen_1);
224 8087746 : long i, lvl = 1 + nbmvar;
225 8126372 : for (i = paccesslex; i<s_accesslex.n; i++)
226 : {
227 38626 : long a = accesslex[i];
228 38626 : if (a > 0) { lvl+=a; continue; }
229 33858 : a += lvl;
230 33858 : if (a <= 0) pari_err_BUG("genctx");
231 33858 : if (a <= nbmvar)
232 26191 : gel(acc, a) = gen_0;
233 : }
234 8087746 : s_accesslex.n = paccesslex;
235 28707323 : for (i = 1; i<=nbmvar; i++)
236 20619578 : if (signe(gel(acc,i))==0)
237 19457 : access_push(i-nbmvar-1);
238 8087745 : return acc;
239 : }
240 :
241 : static GEN
242 9030682 : getfunction(const struct codepos *pos, long arity, long nbmvar, GEN text,
243 : long gap)
244 : {
245 9030682 : long lop = s_opcode.n+1 - pos->opcode;
246 9030682 : long ldat = s_data.n+1 - pos->data;
247 9030682 : long lfram = s_frame.n+1 - pos->frames;
248 9030682 : 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 9030681 : cl[1] = arity;
254 9030681 : gel(cl,2) = cgetg(nchar2nlong(lop)+1, t_STR);
255 9030658 : gel(cl,3) = op = cgetg(lop, t_VECSMALL);
256 9030664 : gel(cl,4) = dat = cgetg(ldat, t_VEC);
257 9030673 : dbg = cgetg(lop, t_VECSMALL);
258 9030678 : frpc = cgetg(lfram, t_VECSMALL);
259 9030680 : fram = cgetg(lfram, t_VEC);
260 9030682 : gel(cl,5) = mkvec3(dbg, frpc, fram);
261 9030689 : if (text) gel(cl,6) = text;
262 9030689 : s = GSTR(gel(cl,2)) - 1;
263 84280135 : for (i = 1; i < lop; i++)
264 : {
265 75249446 : long j = i+pos->opcode-1;
266 75249446 : s[i] = opcode[j];
267 75249446 : op[i] = operand[j];
268 75249446 : dbg[i] = dbginfo[j] - dbgstart;
269 75249446 : if (dbg[i] < 0) dbg[i] += gap;
270 : }
271 9030689 : s[i] = 0;
272 9030689 : s_opcode.n = pos->opcode;
273 9030689 : s_operand.n = pos->opcode;
274 9030689 : s_dbginfo.n = pos->opcode;
275 9030689 : if (lg(cl)==8)
276 8077364 : gel(cl,7) = genctx(nbmvar, pos->accesslex);
277 953325 : else if (nbmvar==0)
278 942970 : s_accesslex.n = pos->accesslex;
279 : else
280 : {
281 10355 : pari_sp av = avma;
282 10355 : (void) genctx(nbmvar, pos->accesslex);
283 10370 : set_avma(av);
284 : }
285 10750810 : for (i = 1; i < ldat; i++)
286 1720102 : if (data[i+pos->data-1]) gel(dat,i) = gcopyunclone(data[i+pos->data-1]);
287 9030708 : s_data.n = pos->data;
288 9057416 : while (s_lvar.n > pos->localvars && !localvars[s_lvar.n-1].inl)
289 : {
290 26708 : if (localvars[s_lvar.n-1].type==Lmy) nblex--;
291 26708 : s_lvar.n--;
292 : }
293 17127594 : for (i = 1; i < lfram; i++)
294 : {
295 8096833 : long j = i+pos->frames-1;
296 8096833 : frpc[i] = frames[j].pc - pos->opcode+1;
297 8096833 : gel(fram, i) = gcopyunclone(frames[j].frame);
298 : }
299 9030761 : s_frame.n = pos->frames;
300 9030761 : offset = pos->offset;
301 9030761 : dbgstart = pos->dbgstart;
302 9030761 : return cl;
303 : }
304 :
305 : static GEN
306 19286 : getclosure(struct codepos *pos, long nbmvar)
307 : {
308 19286 : return getfunction(pos, 0, nbmvar, NULL, 0);
309 : }
310 :
311 : static void
312 75246140 : op_push_loc(op_code o, long x, const char *loc)
313 : {
314 75246140 : long n=pari_stack_new(&s_opcode);
315 75246137 : long m=pari_stack_new(&s_operand);
316 75246043 : long d=pari_stack_new(&s_dbginfo);
317 75246003 : opcode[n]=o;
318 75246003 : operand[m]=x;
319 75246003 : dbginfo[d]=loc;
320 75246003 : }
321 :
322 : static void
323 37552133 : op_push(op_code o, long x, long n)
324 : {
325 37552133 : op_push_loc(o,x,tree[n].str);
326 37552133 : }
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 1720102 : data_push(GEN x)
348 : {
349 1720102 : long n=pari_stack_new(&s_data);
350 1720102 : data[n] = x?gclone(x):x;
351 1720102 : return n-offset;
352 : }
353 :
354 : static void
355 63221 : var_push(entree *ep, Ltype type)
356 : {
357 63221 : long n=pari_stack_new(&s_lvar);
358 63221 : localvars[n].ep = ep;
359 63221 : localvars[n].inl = 0;
360 63221 : localvars[n].type = type;
361 63221 : if (type == Lmy) nblex++;
362 63221 : }
363 :
364 : static void
365 8096822 : frame_push(GEN x)
366 : {
367 8096822 : long n=pari_stack_new(&s_frame);
368 8096814 : frames[n].pc = s_opcode.n-1;
369 8096814 : frames[n].frame = gclone(x);
370 8096820 : }
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 249800 : addcopy(long n, long mode, long flag, long mask)
485 : {
486 249800 : if (mode==Ggen && !(flag&mask))
487 : {
488 24690 : op_push(OCcopy,0,n);
489 24690 : if (!(flag&FLsurvive) && DEBUGLEVEL)
490 0 : pari_warn(warner,"compiler generates copy for `%.*s'",
491 0 : tree[n].len,tree[n].str);
492 : }
493 249800 : }
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 122172880 : parseproto(char const **q, char *c, const char *str)
501 : {
502 122172880 : char const *p=*q;
503 : long i;
504 122172880 : switch(*p)
505 : {
506 29713211 : case 0:
507 : case '\n':
508 29713211 : return PPend;
509 262973 : case 'D':
510 262973 : switch(p[1])
511 : {
512 178261 : 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 178261 : *c=p[1]; *q=p+2; return PPdefault;
524 84712 : default:
525 511450 : for(i=0;*p && i<2;p++) i+=*p==',';
526 : /* assert(i>=2) because check_proto validated the protototype */
527 84712 : *c=p[-2]; *q=p; return PPdefaultmulti;
528 : }
529 : break;
530 133868 : case 'C':
531 : case 'p':
532 : case 'b':
533 : case 'P':
534 : case 'f':
535 133868 : *c=*p; *q=p+1; return PPauto;
536 1508 : case '&':
537 1508 : *c='*'; *q=p+1; return PPstd;
538 18030 : case 'V':
539 18030 : if (p[1]=='=')
540 : {
541 13246 : if (p[2]!='G')
542 0 : compile_err("function prototype is not supported",str);
543 13246 : *c='='; p+=2;
544 : }
545 : else
546 4784 : *c=*p;
547 18030 : *q=p+1; return PPstd;
548 42464 : case 'E':
549 : case 's':
550 42464 : if (p[1]=='*') { *c=*p++; *q=p+1; return PPstar; }
551 : /*fall through*/
552 : }
553 92015165 : *c=*p; *q=p+1; return PPstd;
554 : }
555 :
556 : static long
557 398400 : detag(long n)
558 : {
559 398400 : while (tree[n].f==Ftag)
560 0 : n=tree[n].x;
561 398400 : return n;
562 : }
563 :
564 : /* return type for GP functions */
565 : static op_code
566 13578786 : get_ret_type(const char **p, long arity, Gtype *t, long *flag)
567 : {
568 13578786 : *flag = 0;
569 13578786 : if (**p == 'v') { (*p)++; *t=Gvoid; return OCcallvoid; }
570 13533901 : else if (**p == 'i') { (*p)++; *t=Gsmall; return OCcallint; }
571 13527888 : else if (**p == 'l') { (*p)++; *t=Gsmall; return OCcalllong; }
572 13503190 : else if (**p == 'u') { (*p)++; *t=Gusmall; return OCcalllong; }
573 13503190 : else if (**p == 'm') { (*p)++; *flag = FLnocopy; }
574 13503190 : *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 14575244 : compilecast_loc(int type, int mode, const char *loc)
590 : {
591 14575244 : if (type==mode) return;
592 4397848 : 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 4977 : case Gsmall:
600 4977 : 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 4970 : break;
604 4380453 : case Ggen:
605 4380453 : if (type==Gsmall) op_push_loc(OCstoi,0,loc);
606 4366946 : else if (type==Gusmall)op_push_loc(OCutoi,0,loc);
607 4366946 : else if (type==Gvoid) op_push_loc(OCpushgnil,0,loc);
608 4380453 : break;
609 8530 : case Gvoid:
610 8530 : op_push_loc(OCpop, 1,loc);
611 8530 : 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 6500197 : compilecast(long n, int type, int mode) { compilecast_loc(type, mode, tree[n].str); }
623 :
624 : static entree *
625 24773 : fetch_member_raw(const char *s, long len)
626 : {
627 24773 : pari_sp av = avma;
628 24773 : char *t = stack_malloc(len+2);
629 : entree *ep;
630 24773 : t[0] = '_'; strncpy(t+1, s, len); t[++len] = 0; /* prepend '_' */
631 24773 : ep = fetch_entry_raw(t, len);
632 24773 : set_avma(av); return ep;
633 : }
634 : static entree *
635 9539783 : getfunc(long n)
636 : {
637 9539783 : long x=tree[n].x;
638 9539783 : if (tree[x].x==CSTmember) /* str-1 points to '.' */
639 24773 : return do_alias(fetch_member_raw(tree[x].str - 1, tree[x].len + 1));
640 : else
641 9515010 : return do_alias(fetch_entry_raw(tree[x].str, tree[x].len));
642 : }
643 :
644 : static entree *
645 335827 : getentry(long n)
646 : {
647 335827 : n = detag(n);
648 335827 : 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 335806 : return getfunc(n);
655 : }
656 :
657 : static entree *
658 75841 : getvar(long n)
659 75841 : { 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 4926161 : getmvar(entree *ep)
673 : {
674 : long i;
675 4926161 : long vn=0;
676 5942054 : for(i=s_lvar.n-1;i>=0;i--)
677 : {
678 1088790 : if(localvars[i].type==Lmy)
679 1088517 : vn--;
680 1088790 : if(localvars[i].ep==ep)
681 72897 : return localvars[i].type==Lmy?vn:0;
682 : }
683 4853264 : return 0;
684 : }
685 :
686 : static void
687 9256 : ctxmvar(long n)
688 : {
689 9256 : pari_sp av=avma;
690 : GEN ctx;
691 : long i;
692 9256 : if (n==0) return;
693 4103 : ctx = cgetg(n+1,t_VECSMALL);
694 67083 : for(n=0, i=0; i<s_lvar.n; i++)
695 62980 : if(localvars[i].type==Lmy)
696 62980 : ctx[++n]=(long)localvars[i].ep;
697 4103 : frame_push(ctx);
698 4103 : set_avma(av);
699 : }
700 :
701 : INLINE int
702 50405690 : is_func_named(entree *ep, const char *s)
703 : {
704 50405690 : return !strcmp(ep->name, s);
705 : }
706 :
707 : INLINE int
708 3910 : is_node_zero(long n)
709 : {
710 3910 : n = detag(n);
711 3910 : 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 18017863 : countlisttogen(long n, Ffunc f)
736 : {
737 : long x,i;
738 18017863 : if (n==-1 || tree[n].f==Fnoarg) return 0;
739 41824526 : for(x=n, i=0; tree[x].f==f ;x=tree[x].x, i++);
740 17304406 : return i+1;
741 : }
742 :
743 : static GEN
744 18017863 : listtogen(long n, Ffunc f)
745 : {
746 18017863 : long x,i,nb = countlisttogen(n, f);
747 18017863 : GEN z=cgetg(nb+1, t_VECSMALL);
748 18017863 : if (nb)
749 : {
750 41824526 : for (x=n, i = nb-1; i>0; z[i+1]=tree[x].y, x=tree[x].x, i--);
751 17304406 : z[1]=x;
752 : }
753 18017863 : return z;
754 : }
755 :
756 : static long
757 9224474 : first_safe_arg(GEN arg, long mask)
758 : {
759 9224474 : long lnc, l=lg(arg);
760 19409939 : for (lnc=l-1; lnc>0 && (tree[arg[lnc]].flags&mask)==mask; lnc--);
761 9224474 : return lnc;
762 : }
763 :
764 : static void
765 19493 : checkdups(GEN arg, GEN vep)
766 : {
767 19493 : long l=vecsmall_duplicate(vep);
768 19493 : if (l!=0) compile_err("variable declared twice",tree[arg[l]].str);
769 19493 : }
770 :
771 : enum {MAT_range,MAT_std,MAT_line,MAT_column,VEC_std};
772 :
773 : static int
774 14569 : matindex_type(long n)
775 : {
776 14569 : long x = tree[n].x, y = tree[n].y;
777 14569 : long fxx = tree[tree[x].x].f, fxy = tree[tree[x].y].f;
778 14569 : if (y==-1)
779 : {
780 12588 : if (fxy!=Fnorange) return MAT_range;
781 12035 : if (fxx==Fnorange) compile_err("missing index",tree[n].str);
782 12035 : 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 44166 : getlvalue(long n)
798 : {
799 45146 : while ((tree[n].f==Fmatcoeff && matindex_type(tree[n].y)!=MAT_range) || tree[n].f==Ftag)
800 980 : n=tree[n].x;
801 44166 : return getvar(n);
802 : }
803 :
804 : INLINE void
805 40906 : compilestore(long vn, entree *ep, long n)
806 : {
807 40906 : if (vn)
808 3925 : op_push(OCstorelex,vn,n);
809 : else
810 : {
811 36981 : if (EpSTATIC(do_alias(ep)))
812 0 : compile_varerr(tree[n].str);
813 36981 : op_push(OCstoredyn,(long)ep,n);
814 : }
815 40906 : }
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 12497 : compilematcoeff(long n, int mode)
881 : {
882 12497 : long x=tree[n].x, y=tree[n].y;
883 12497 : long yx=tree[y].x, yy=tree[y].y;
884 12497 : long m=matindex_type(y);
885 12497 : compilenode(x,Ggen,FLnocopy);
886 12497 : switch(m)
887 : {
888 10593 : case VEC_std:
889 10593 : compilenode(tree[yx].x,Gsmall,0);
890 10593 : op_push(OCcompo1,mode,y);
891 10593 : 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 10863501 : compilesmall(long n, long x, long mode)
927 : {
928 10863501 : if (mode==Ggen)
929 10781381 : op_push(OCpushstoi, x, n);
930 : else
931 : {
932 82120 : if (mode==Gusmall && x < 0) U_compile_err(tree[n].str);
933 82120 : op_push(OCpushlong, x, n);
934 82120 : compilecast(n,Gsmall,mode);
935 : }
936 10863494 : }
937 :
938 : static void
939 4333790 : compilevec(long n, long mode, op_code op)
940 : {
941 4333790 : pari_sp ltop=avma;
942 4333790 : long x=tree[n].x;
943 : long i;
944 4333790 : GEN arg=listtogen(x,Fmatrixelts);
945 4333790 : long l=lg(arg);
946 4333790 : op_push(op,l,n);
947 19799745 : for (i=1;i<l;i++)
948 : {
949 15465955 : if (tree[arg[i]].f==Fnoarg)
950 0 : compile_err("missing vector element",tree[arg[i]].str);
951 15465955 : compilenode(arg[i],Ggen,FLsurvive);
952 15465955 : op_push(OCstackgen,i,n);
953 : }
954 4333790 : set_avma(ltop);
955 4333790 : op_push(OCpop,1,n);
956 4333790 : compilecast(n,Gvec,mode);
957 4333790 : }
958 :
959 : static void
960 9408 : compilemat(long n, long mode)
961 : {
962 9408 : pari_sp ltop=avma;
963 9408 : long x=tree[n].x;
964 : long i,j;
965 9408 : GEN line=listtogen(x,Fmatrixlines);
966 9408 : long lglin = lg(line), lgcol=0;
967 9408 : op_push(OCpushlong, lglin,n);
968 9408 : if (lglin==1)
969 959 : op_push(OCmat,1,n);
970 47054 : for(i=1;i<lglin;i++)
971 : {
972 37646 : GEN col=listtogen(line[i],Fmatrixelts);
973 37646 : long l=lg(col), k;
974 37646 : if (i==1)
975 : {
976 8449 : lgcol=l;
977 8449 : op_push(OCmat,lgcol,n);
978 : }
979 29197 : else if (l!=lgcol)
980 0 : compile_err("matrix must be rectangular",tree[line[i]].str);
981 37646 : k=i;
982 288323 : for(j=1;j<lgcol;j++)
983 : {
984 250677 : k-=lglin;
985 250677 : if (tree[col[j]].f==Fnoarg)
986 0 : compile_err("missing matrix element",tree[col[j]].str);
987 250677 : compilenode(col[j], Ggen, FLsurvive);
988 250677 : op_push(OCstackgen,k,n);
989 : }
990 : }
991 9408 : set_avma(ltop);
992 9408 : op_push(OCpop,1,n);
993 9408 : compilecast(n,Gvec,mode);
994 9408 : }
995 :
996 : static GEN
997 45216 : cattovec(long n, long fnum)
998 : {
999 45216 : long x=n, y, i=0, nb;
1000 : GEN stack;
1001 45216 : if (tree[n].f==Fnoarg) return cgetg(1,t_VECSMALL);
1002 : while(1)
1003 210 : {
1004 45426 : long xx=tree[x].x;
1005 45426 : long xy=tree[x].y;
1006 45426 : if (tree[x].f!=Ffunction || xx!=fnum) break;
1007 210 : x=tree[xy].x;
1008 210 : y=tree[xy].y;
1009 210 : if (tree[y].f==Fnoarg)
1010 0 : compile_err("unexpected character: ", tree[y].str);
1011 210 : i++;
1012 : }
1013 45216 : if (tree[x].f==Fnoarg)
1014 0 : compile_err("unexpected character: ", tree[x].str);
1015 45216 : nb=i+1;
1016 45216 : stack=cgetg(nb+1,t_VECSMALL);
1017 45426 : for(x=n;i>0;i--)
1018 : {
1019 210 : long y=tree[x].y;
1020 210 : x=tree[y].x;
1021 210 : stack[i+1]=tree[y].y;
1022 : }
1023 45216 : stack[1]=x;
1024 45216 : 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 22409 : compilecall(long n, int mode, entree *ep)
1041 : {
1042 22409 : pari_sp ltop=avma;
1043 : long j;
1044 22409 : long x=tree[n].x, tx = tree[x].x;
1045 22409 : long y=tree[n].y;
1046 22409 : GEN arg=listtogen(y,Flistarg);
1047 22409 : long nb=lg(arg)-1;
1048 22409 : long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
1049 22409 : long lnl=first_safe_arg(arg, COsafelex);
1050 22409 : long fl = lnl==0? (lnc==0? FLnocopy: FLnocopylex): 0;
1051 22409 : if (ep==NULL)
1052 322 : compilenode(x, Ggen, fl);
1053 : else
1054 : {
1055 22087 : long vn=getmvar(ep);
1056 22087 : if (vn)
1057 : {
1058 567 : access_push(vn);
1059 567 : op_push(OCpushlex,vn,n);
1060 : }
1061 : else
1062 21520 : op_push(OCpushdyn,(long)ep,n);
1063 : }
1064 60209 : for (j=1;j<=nb;j++)
1065 : {
1066 37800 : long x = tree[arg[j]].x, f = tree[arg[j]].f;
1067 37800 : if (f==Fseq)
1068 0 : compile_err("unexpected ';'", tree[x].str+tree[x].len);
1069 37800 : else if (f==Findarg)
1070 : {
1071 91 : long a = tree[arg[j]].x;
1072 91 : entree *ep = getlvalue(a);
1073 91 : long vn = getmvar(ep);
1074 91 : if (vn)
1075 49 : op_push(OCcowvarlex, vn, a);
1076 91 : compilenode(a, Ggen,FLnocopy);
1077 91 : op_push(OClock,0,n);
1078 37709 : } else if (tx==CSTmember)
1079 : {
1080 28 : compilenode(arg[j], Ggen,FLnocopy);
1081 28 : op_push(OClock,0,n);
1082 : }
1083 37681 : else if (f!=Fnoarg)
1084 37429 : compilenode(arg[j], Ggen,j>=lnl?FLnocopylex:0);
1085 : else
1086 252 : op_push(OCpushlong,0,n);
1087 : }
1088 22409 : op_push(OCcalluser,nb,x);
1089 22409 : compilecast(n,Ggen,mode);
1090 22409 : set_avma(ltop);
1091 22409 : }
1092 :
1093 : static GEN
1094 19541 : compilefuncinline(long n, long c, long a, long flag, long isif, long lev, long *ev)
1095 : {
1096 : struct codepos pos;
1097 19541 : int type=c=='I'?Gvoid:Ggen;
1098 19541 : long rflag=c=='I'?0:FLsurvive;
1099 19541 : long nbmvar = nblex;
1100 19541 : GEN vep = NULL;
1101 19541 : if (isif && (flag&FLreturn)) rflag|=FLreturn;
1102 19541 : getcodepos(&pos);
1103 19541 : if (c=='J') ctxmvar(nbmvar);
1104 19541 : if (lev)
1105 : {
1106 : long i;
1107 11422 : GEN varg=cgetg(lev+1,t_VECSMALL);
1108 11422 : vep=cgetg(lev+1,t_VECSMALL);
1109 23583 : for(i=0;i<lev;i++)
1110 : {
1111 : entree *ve;
1112 12161 : if (ev[i]<0)
1113 0 : compile_err("missing variable name", tree[a].str-1);
1114 12161 : ve = getvar(ev[i]);
1115 12161 : vep[i+1]=(long)ve;
1116 12161 : varg[i+1]=ev[i];
1117 12161 : var_push(ve,Lmy);
1118 : }
1119 11422 : checkdups(varg,vep);
1120 11422 : if (c=='J')
1121 339 : op_push(OCgetargs,lev,n);
1122 11422 : access_push(lg(vep)-1);
1123 11422 : frame_push(vep);
1124 : }
1125 19541 : if (c=='J')
1126 339 : return compilelambda(a,vep,nbmvar,&pos);
1127 19202 : if (tree[a].f==Fnoarg)
1128 134 : compilecast(a,Gvoid,type);
1129 : else
1130 19068 : compilenode(a,type,rflag);
1131 19202 : return getclosure(&pos, nbmvar);
1132 : }
1133 :
1134 : static long
1135 3203 : countvar(GEN arg)
1136 : {
1137 3203 : long i, l = lg(arg);
1138 3203 : long n = l-1;
1139 9509 : for(i=1; i<l; i++)
1140 : {
1141 6306 : long a=arg[i];
1142 6306 : if (tree[a].f==Fassign)
1143 : {
1144 3812 : long x = detag(tree[a].x);
1145 3812 : if (tree[x].f==Fvec && tree[x].x>=0)
1146 399 : n += countmatrixelts(tree[x].x)-1;
1147 : }
1148 : }
1149 3203 : 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 3175 : compilemy(GEN arg, const char *str, int inl)
1166 : {
1167 3175 : long i, j, k, l = lg(arg);
1168 3175 : long n = countvar(arg);
1169 3175 : GEN vep = cgetg(n+1,t_VECSMALL);
1170 3175 : GEN ver = cgetg(n+1,t_VECSMALL);
1171 3175 : 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 9425 : for(k=0, i=1; i<l; i++)
1178 : {
1179 6250 : long a=arg[i];
1180 6250 : if (tree[a].f==Fassign)
1181 : {
1182 3770 : long x = detag(tree[a].x);
1183 3770 : 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 3385 : } else ver[++k] = x;
1195 2480 : } else ver[++k] = a;
1196 5865 : vep[k] = (long)getvar(ver[k]);
1197 : }
1198 3175 : checkdups(ver,vep);
1199 9929 : for(i=1; i<=n; i++) var_push(NULL,Lmy);
1200 3175 : op_push_loc(OCnewframe,inl?-n:n,str);
1201 3175 : access_push(lg(vep)-1);
1202 3175 : frame_push(vep);
1203 9425 : for (k=0, i=1; i<l; i++)
1204 : {
1205 6250 : long a=arg[i];
1206 6250 : if (tree[a].f==Fassign)
1207 : {
1208 3770 : long x = detag(tree[a].x);
1209 3770 : 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 3385 : else if (!is_node_zero(tree[a].y))
1231 : {
1232 3251 : compilenode(tree[a].y,Ggen,FLnocopy);
1233 3251 : op_push(OCstorelex,-n+k,a);
1234 : }
1235 : }
1236 5865 : k++;
1237 5865 : localvars[s_lvar.n-n+k-1].ep=(entree*)vep[k];
1238 5865 : localvars[s_lvar.n-n+k-1].inl=inl;
1239 : }
1240 3175 : }
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 4586356 : compilefunc(entree *ep, long n, int mode, long flag)
1337 : {
1338 4586356 : pari_sp ltop=avma;
1339 : long j;
1340 4586356 : 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 4586356 : GEN arg=listtogen(y,Flistarg);
1349 4586356 : long lnc=first_safe_arg(arg, COsafelex|COsafedyn);
1350 4586356 : long lnl=first_safe_arg(arg, COsafelex);
1351 4586356 : long nbpointers=0, nbopcodes;
1352 4586356 : long nb=lg(arg)-1, lev=0;
1353 : long ev[20];
1354 4586356 : if (x>=OPnboperator)
1355 191115 : str=tree[x].str;
1356 : else
1357 : {
1358 4395241 : if (nb==2)
1359 338846 : str=tree[arg[1]].str+tree[arg[1]].len;
1360 4056395 : else if (nb==1)
1361 4055509 : str=tree[arg[1]].str;
1362 : else
1363 886 : str=tree[n].str;
1364 4401326 : while(*str==')') str++;
1365 : }
1366 4586356 : if (tree[n].f==Fassign)
1367 : {
1368 0 : nb=2; lnc=2; lnl=2; arg=mkvecsmall2(x,y);
1369 : }
1370 4586356 : else if (is_func_named(ep,"if"))
1371 : {
1372 4648 : if (nb>=4)
1373 119 : ep=is_entry("_multi_if");
1374 4529 : else if (mode==Gvoid)
1375 2889 : ep=is_entry("_void_if");
1376 : }
1377 4581708 : 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 3669606 : return;
1383 : }
1384 4581603 : 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 4581590 : 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 4581584 : else if (is_func_named(ep,"my"))
1399 : {
1400 3162 : compilemy(arg, str, 0);
1401 3162 : compilecast(n,Gvoid,mode);
1402 3162 : set_avma(ltop);
1403 3162 : return;
1404 : }
1405 4578422 : 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 4578394 : 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 4578353 : 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 4578347 : 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 4578340 : else if (is_func_named(ep,"O"))
1453 : {
1454 4599 : if (nb!=1)
1455 0 : compile_err("wrong number of arguments", tree[n].str+tree[n].len-1);
1456 4599 : ep=is_entry("O(_^_)");
1457 4599 : if (tree[arg[1]].f==Ffunction && tree[arg[1]].x==OPpow)
1458 : {
1459 3472 : arg = listtogen(tree[arg[1]].y,Flistarg);
1460 3472 : nb = lg(arg)-1;
1461 3472 : lnc = first_safe_arg(arg,COsafelex|COsafedyn);
1462 3472 : lnl = first_safe_arg(arg,COsafelex);
1463 : }
1464 : }
1465 4573741 : else if (x==OPn && tree[y].f==Fsmall)
1466 : {
1467 3662262 : set_avma(ltop);
1468 3662262 : compilesmall(y, -tree[y].x, mode);
1469 3662262 : return;
1470 : }
1471 911479 : else if (x==OPtrans && tree[y].f==Fvec)
1472 : {
1473 3976 : set_avma(ltop);
1474 3976 : compilevec(y, mode, OCcol);
1475 3976 : return;
1476 907503 : } 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 907503 : else if (x==OPpow && nb==2)
1484 67881 : {
1485 67881 : long a = arg[2];
1486 67881 : if (tree[a].f==Fsmall)
1487 : {
1488 63391 : if(tree[a].x==2) { nb--; ep=is_entry("sqr"); }
1489 45922 : else ep=is_entry("_^s");
1490 : }
1491 4490 : else if (tree[a].f == Ffunction && tree[a].x == OPn)
1492 : {
1493 1274 : long ay = tree[a].y;
1494 1274 : if (tree[ay].f==Fsmall)
1495 : {
1496 1127 : if (tree[ay].x==1) {nb--; ep=is_entry("_inv"); }
1497 756 : else ep=is_entry("_^s");
1498 : }
1499 : }
1500 : }
1501 839622 : else if (x==OPcat)
1502 0 : compile_err("expected character: ',' or ')' instead of",
1503 0 : tree[arg[1]].str+tree[arg[1]].len);
1504 916750 : p=ep->code;
1505 916750 : if (!ep->value)
1506 0 : compile_err("unknown function",tree[n].str);
1507 916750 : nbopcodes = s_opcode.n;
1508 916750 : ret_op = get_ret_type(&p, ep->arity, &ret_typ, &ret_flag);
1509 916750 : j=1;
1510 916750 : if (*p)
1511 : {
1512 908010 : q=p;
1513 2373863 : while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
1514 : {
1515 1465895 : if (j<=nb && tree[arg[j]].f!=Fnoarg
1516 1363977 : && (mod==PPdefault || mod==PPdefaultmulti))
1517 63096 : mod=PPstd;
1518 1465895 : switch(mod)
1519 : {
1520 1350385 : case PPstd:
1521 1350385 : if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
1522 1350385 : if (c!='I' && c!='E' && c!='J')
1523 : {
1524 1331327 : long x = tree[arg[j]].x, f = tree[arg[j]].f;
1525 1331327 : if (f==Fnoarg)
1526 0 : compile_err("missing mandatory argument", tree[arg[j]].str);
1527 1331327 : if (f==Fseq)
1528 0 : compile_err("unexpected ';'", tree[x].str+tree[x].len);
1529 : }
1530 1350385 : switch(c)
1531 : {
1532 1237244 : case 'G':
1533 1237244 : compilenode(arg[j],Ggen,j>=lnl?(j>=lnc?FLnocopy:FLnocopylex):0);
1534 1237244 : j++;
1535 1237244 : break;
1536 308 : case 'W':
1537 : {
1538 308 : long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
1539 308 : entree *ep = getlvalue(a);
1540 294 : long vn = getmvar(ep);
1541 294 : if (vn)
1542 77 : op_push(OCcowvarlex, vn, a);
1543 217 : else op_push(OCcowvardyn, (long)ep, a);
1544 294 : compilenode(a, Ggen,FLnocopy);
1545 294 : j++;
1546 294 : 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 72194 : compilenode(arg[j++],Gsmall,0);
1571 72187 : 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 2231 : case '&': case '*':
1579 : {
1580 2231 : long vn, a=arg[j++];
1581 : entree *ep;
1582 2231 : if (c=='&')
1583 : {
1584 1477 : if (tree[a].f!=Frefarg)
1585 0 : compile_err("expected character: '&'", tree[a].str);
1586 1477 : a=tree[a].x;
1587 : }
1588 2231 : a=detag(a);
1589 2231 : ep=getlvalue(a);
1590 2231 : vn=getmvar(ep);
1591 2231 : if (tree[a].f==Fentry)
1592 : {
1593 2042 : if (vn)
1594 : {
1595 502 : access_push(vn);
1596 502 : op_push(OCsimpleptrlex, vn,n);
1597 : }
1598 : else
1599 1540 : 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 2231 : nbpointers++;
1608 2231 : break;
1609 : }
1610 19058 : case 'I':
1611 : case 'E':
1612 : case 'J':
1613 : {
1614 19058 : long a = arg[j++];
1615 19058 : GEN d = compilefuncinline(n, c, a, flag, is_func_named(ep,"if"), lev, ev);
1616 19058 : op_push(OCpushgen, data_push(d), a);
1617 19058 : if (lg(d)==8) op_push(OCsaveframe,FLsurvive,n);
1618 19058 : break;
1619 : }
1620 5004 : case 'V':
1621 : {
1622 5004 : long a = arg[j++];
1623 5004 : (void)getvar(a);
1624 4997 : ev[lev++] = a;
1625 4997 : break;
1626 : }
1627 6623 : case '=':
1628 : {
1629 6623 : long a = arg[j++];
1630 6623 : ev[lev++] = tree[a].x;
1631 6623 : compilenode(tree[a].y, Ggen, FLnocopy);
1632 : }
1633 6623 : break;
1634 1097 : case 'r':
1635 : {
1636 1097 : long a=arg[j++];
1637 1097 : if (tree[a].f==Fentry)
1638 : {
1639 1018 : op_push(OCpushgen, data_push(strntoGENstr(tree[tree[a].x].str,
1640 1018 : tree[tree[a].x].len)),n);
1641 1018 : op_push(OCtostr, -1,n);
1642 : }
1643 : else
1644 : {
1645 79 : compilenode(a,Ggen,FLnocopy);
1646 79 : op_push(OCtostr, -1,n);
1647 : }
1648 1097 : break;
1649 : }
1650 2703 : case 's':
1651 : {
1652 2703 : long a = arg[j++];
1653 2703 : GEN g = cattovec(a, OPcat);
1654 2703 : long l, nb = lg(g)-1;
1655 2703 : if (nb==1)
1656 : {
1657 2633 : compilenode(g[1], Ggen, FLnocopy);
1658 2633 : op_push(OCtostr, -1, a);
1659 : } else
1660 : {
1661 70 : op_push(OCvec, nb+1, a);
1662 210 : for(l=1; l<=nb; l++)
1663 : {
1664 140 : compilenode(g[l], Ggen, FLsurvive);
1665 140 : op_push(OCstackgen,l, a);
1666 : }
1667 70 : op_push(OCpop, 1, a);
1668 70 : op_push(OCcallgen,(long)is_entry("Str"), a);
1669 70 : op_push(OCtostr, -1, a);
1670 : }
1671 2703 : 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 1350343 : break;
1678 31961 : case PPauto:
1679 31961 : switch(c)
1680 : {
1681 27785 : case 'p':
1682 27785 : op_push(OCprecreal,0,n);
1683 27785 : break;
1684 4123 : case 'b':
1685 4123 : op_push(OCbitprecreal,0,n);
1686 4123 : 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 31961 : break;
1701 40434 : case PPdefault:
1702 40434 : j++;
1703 40434 : switch(c)
1704 : {
1705 31473 : case 'G':
1706 : case '&':
1707 : case 'E':
1708 : case 'I':
1709 : case 'r':
1710 : case 's':
1711 31473 : op_push(OCpushlong,0,n);
1712 31473 : break;
1713 7751 : case 'n':
1714 7751 : op_push(OCpushlong,-1,n);
1715 7751 : 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 40434 : break;
1727 29084 : case PPdefaultmulti:
1728 29084 : j++;
1729 29084 : switch(c)
1730 : {
1731 441 : case 'G':
1732 441 : op_push(OCpushstoi,strtol(q+1,NULL,10),n);
1733 441 : break;
1734 28526 : case 'L':
1735 : case 'M':
1736 28526 : op_push(OCpushlong,strtol(q+1,NULL,10),n);
1737 28526 : 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 29084 : break;
1751 14031 : case PPstar:
1752 14031 : 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 13912 : case 's':
1767 : {
1768 13912 : long n=nb+1-j;
1769 : long k,l,l1,m;
1770 13912 : GEN g=cgetg(n+1,t_VEC);
1771 33817 : for(l1=0,k=1;k<=n;k++)
1772 : {
1773 19905 : gel(g,k)=cattovec(arg[j+k-1],OPcat);
1774 19905 : l1+=lg(gel(g,k))-1;
1775 : }
1776 13912 : op_push_loc(OCvec, l1+1, str);
1777 33817 : for(m=1,k=1;k<=n;k++)
1778 39845 : for(l=1;l<lg(gel(g,k));l++,m++)
1779 : {
1780 19940 : compilenode(mael(g,k,l),Ggen,FLsurvive);
1781 19940 : op_push(OCstackgen,m,mael(g,k,l));
1782 : }
1783 13912 : op_push_loc(OCpop, 1, str);
1784 13912 : j=nb+1;
1785 13912 : 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 14031 : break;
1792 0 : default:
1793 0 : pari_err_BUG("compilefunc [unknown PPproto]");
1794 : }
1795 1465853 : q=p;
1796 : }
1797 : }
1798 916708 : if (j<=nb)
1799 0 : compile_err("too many arguments",tree[arg[j]].str);
1800 916708 : op_push_loc(ret_op, (long) ep, str);
1801 916708 : if (mode==Ggen && (ret_flag&FLnocopy) && !(flag&FLnocopy))
1802 10576 : op_push_loc(OCcopy,0,str);
1803 916708 : 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 916708 : compilecast(n,ret_typ,mode);
1809 916708 : if (nbpointers) op_push_loc(OCendptr,nbpointers, str);
1810 916708 : set_avma(ltop);
1811 : }
1812 :
1813 : static void
1814 8073243 : genclosurectx(const char *loc, long nbdata)
1815 : {
1816 : long i;
1817 8073243 : GEN vep = cgetg(nbdata+1,t_VECSMALL);
1818 28583284 : for(i = 1; i <= nbdata; i++)
1819 : {
1820 20510072 : vep[i] = 0;
1821 20510072 : op_push_loc(OCpushlex,-i,loc);
1822 : }
1823 8073212 : frame_push(vep);
1824 8073249 : }
1825 :
1826 : static GEN
1827 8083488 : genclosure(entree *ep, const char *loc, long nbdata, int check)
1828 : {
1829 : struct codepos pos;
1830 8083488 : long nb=0;
1831 8083488 : const char *code=ep->code,*p,*q;
1832 : char c;
1833 : GEN text;
1834 8083488 : long index=ep->arity;
1835 8083488 : long arity=0, maskarg=0, maskarg0=0, stop=0, dovararg=0;
1836 : PPproto mod;
1837 : Gtype ret_typ;
1838 : long ret_flag;
1839 8083488 : op_code ret_op=get_ret_type(&code,ep->arity,&ret_typ,&ret_flag);
1840 8083475 : p=code;
1841 36678017 : while ((mod=parseproto(&p,&c,NULL))!=PPend)
1842 : {
1843 28594542 : if (mod==PPauto)
1844 1982 : stop=1;
1845 : else
1846 : {
1847 28592560 : if (stop) return NULL;
1848 28592560 : if (c=='V') continue;
1849 28592560 : maskarg<<=1; maskarg0<<=1; arity++;
1850 28592560 : switch(mod)
1851 : {
1852 28591399 : case PPstd:
1853 28591399 : maskarg|=1L;
1854 28591399 : 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 679 : default:
1866 679 : break;
1867 : }
1868 : }
1869 : }
1870 8083403 : if (check && EpSTATIC(ep) && maskarg==0)
1871 8376 : return gen_0;
1872 8075027 : getcodepos(&pos);
1873 8075049 : dbgstart = loc;
1874 8075049 : if (nbdata > arity)
1875 0 : pari_err(e_MISC,"too many parameters for closure `%s'", ep->name);
1876 8075049 : if (nbdata) genclosurectx(loc, nbdata);
1877 8075056 : text = strtoGENstr(ep->name);
1878 8075056 : arity -= nbdata;
1879 8075056 : if (maskarg) op_push_loc(OCcheckargs,maskarg,loc);
1880 8075043 : if (maskarg0) op_push_loc(OCcheckargs0,maskarg0,loc);
1881 8075043 : p=code;
1882 36667804 : while ((mod=parseproto(&p,&c,NULL))!=PPend)
1883 : {
1884 28592744 : 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 17 : 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 28592761 : default:
1909 28592761 : break;
1910 : }
1911 : }
1912 8075055 : q = p = code;
1913 36667799 : while ((mod=parseproto(&p,&c,NULL))!=PPend)
1914 : {
1915 28592744 : switch(mod)
1916 : {
1917 28591327 : case PPstd:
1918 28591327 : switch(c)
1919 : {
1920 28565303 : case 'G':
1921 28565303 : break;
1922 13984 : case 'M':
1923 : case 'L':
1924 13984 : op_push_loc(OCitos,-index,loc);
1925 13984 : 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 28591327 : 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 28592744 : index--;
2013 28592744 : q = p;
2014 : }
2015 8075014 : op_push_loc(ret_op, (long) ep, loc);
2016 8075047 : if (ret_flag==FLnocopy) op_push_loc(OCcopy,0,loc);
2017 8075047 : compilecast_loc(ret_typ, Ggen, loc);
2018 8075043 : if (dovararg) nb|=VARARGBITS;
2019 8075043 : return getfunction(&pos,nb+arity,nbdata,text,0);
2020 : }
2021 :
2022 : GEN
2023 8070126 : snm_closure(entree *ep, GEN data)
2024 : {
2025 8070126 : long i, n = data ? lg(data)-1: 0;
2026 8070126 : GEN C = genclosure(ep,ep->name,n,0);
2027 28567913 : for(i = 1; i <= n; i++) gmael(C,7,i) = gel(data,i);
2028 8070133 : return C;
2029 : }
2030 :
2031 : GEN
2032 3304 : strtoclosure(const char *s, long n, ...)
2033 : {
2034 3304 : pari_sp av = avma;
2035 3304 : entree *ep = is_entry(s);
2036 : GEN C;
2037 3304 : if (!ep) pari_err(e_NOTFUNC, strtoGENstr(s));
2038 3304 : ep = do_alias(ep);
2039 3304 : if ((!EpSTATIC(ep) && EpVALENCE(ep)!=EpINSTALL) || !ep->value)
2040 0 : pari_err(e_MISC,"not a built-in/install'ed function: \"%s\"",s);
2041 3304 : C = genclosure(ep,ep->name,n,0);
2042 3304 : if (!C) pari_err(e_MISC,"function prototype unsupported: \"%s\"",s);
2043 : else
2044 : {
2045 : va_list ap;
2046 : long i;
2047 3304 : va_start(ap,n);
2048 15827 : for(i = 1; i <= n; i++) gmael(C,7,i) = va_arg(ap, GEN);
2049 3304 : va_end(ap);
2050 : }
2051 3304 : 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 10055 : closurefunc(entree *ep, long n, long mode)
2075 : {
2076 10055 : pari_sp ltop=avma;
2077 : GEN C;
2078 10055 : if (!ep->value) compile_err("unknown function",tree[n].str);
2079 10055 : C = genclosure(ep,tree[n].str,0,1);
2080 10055 : if (!C) compile_err("sorry, closure not implemented",tree[n].str);
2081 10055 : if (C==gen_0)
2082 : {
2083 8376 : compilefunc(ep,n,mode,0);
2084 8376 : 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 14057 : compileseq(long n, int mode, long flag)
2093 : {
2094 14057 : pari_sp av = avma;
2095 14057 : GEN L = listtogen(n, Fseq);
2096 14057 : long i, l = lg(L)-1;
2097 44094 : for(i = 1; i < l; i++)
2098 30037 : compilenode(L[i],Gvoid,0);
2099 14057 : compilenode(L[l],mode,flag&(FLreturn|FLsurvive));
2100 14057 : set_avma(av);
2101 14057 : }
2102 :
2103 : static void
2104 18169573 : compilenode(long n, int mode, long flag)
2105 : {
2106 : long x,y;
2107 : #ifdef STACK_CHECK
2108 18169573 : if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
2109 0 : pari_err(e_MISC, "expression nested too deeply");
2110 : #endif
2111 18169573 : if (n<0) pari_err_BUG("compilenode");
2112 18169573 : x=tree[n].x;
2113 18169573 : y=tree[n].y;
2114 :
2115 18169573 : switch(tree[n].f)
2116 : {
2117 14057 : case Fseq:
2118 14057 : compileseq(n, mode, flag);
2119 18169510 : return;
2120 12497 : case Fmatcoeff:
2121 12497 : compilematcoeff(n,mode);
2122 12490 : if (mode==Ggen && !(flag&FLnocopy))
2123 3842 : op_push(OCcopy,0,n);
2124 12490 : return;
2125 40748 : case Fassign:
2126 40748 : x = detag(x);
2127 40748 : 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 40002 : entree *ep=getlvalue(x);
2158 40002 : long vn=getmvar(ep);
2159 40002 : if (tree[x].f!=Fentry)
2160 : {
2161 623 : compilenewptr(vn,ep,n);
2162 623 : compilelvalue(x);
2163 : }
2164 40002 : compilenode(y,Ggen,mode==Gvoid?FLnocopy:flag&FLsurvive);
2165 40002 : if (mode!=Gvoid)
2166 26290 : op_push(OCdup,1,n);
2167 40002 : if (tree[x].f==Fentry)
2168 39379 : compilestore(vn,ep,n);
2169 : else
2170 623 : op_push(OCstoreptr,0,x);
2171 40002 : if (mode!=Gvoid)
2172 26290 : compilecast(n,Ggen,mode);
2173 : }
2174 40748 : return;
2175 1692362 : case Fconst:
2176 : {
2177 1692362 : pari_sp ltop=avma;
2178 1692362 : if (tree[n].x!=CSTquote)
2179 : {
2180 1688985 : if (mode==Gvoid) return;
2181 1688985 : if (mode==Gvar) compile_varerr(tree[n].str);
2182 : }
2183 1692362 : if (mode==Gsmall) L_compile_err(tree[n].str);
2184 1692362 : if (mode==Gusmall && tree[n].x != CSTint) U_compile_err(tree[n].str);
2185 1692355 : switch(tree[n].x)
2186 : {
2187 5135 : case CSTreal:
2188 5135 : op_push(OCpushreal, data_push(strntoGENstr(tree[n].str,tree[n].len)),n);
2189 5135 : break;
2190 840198 : case CSTint:
2191 840198 : op_push(OCpushgen, data_push(strtoi((char*)tree[n].str)),n);
2192 840198 : compilecast(n,Ggen, mode);
2193 840198 : break;
2194 843645 : case CSTstr:
2195 843645 : op_push(OCpushgen, data_push(strntoGENexp(tree[n].str,tree[n].len)),n);
2196 843645 : break;
2197 3377 : case CSTquote:
2198 : { /* skip ' */
2199 3377 : entree *ep = fetch_entry_raw(tree[n].str+1,tree[n].len-1);
2200 3377 : if (EpSTATIC(ep)) compile_varerr(tree[n].str+1);
2201 3377 : op_push(OCpushvar, (long)ep,n);
2202 3377 : compilecast(n,Ggen, mode);
2203 3377 : break;
2204 : }
2205 0 : default:
2206 0 : pari_err_BUG("compilenode, unsupported constant");
2207 : }
2208 1692355 : set_avma(ltop);
2209 1692355 : return;
2210 : }
2211 7201239 : case Fsmall:
2212 7201239 : compilesmall(n, x, mode);
2213 7201232 : return;
2214 4329814 : case Fvec:
2215 4329814 : compilevec(n, mode, OCvec);
2216 4329814 : return;
2217 9408 : case Fmat:
2218 9408 : compilemat(n, mode);
2219 9408 : 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 259855 : case Fentry:
2227 : {
2228 259855 : entree *ep=getentry(n);
2229 259855 : long vn=getmvar(ep);
2230 259855 : if (vn)
2231 : {
2232 66909 : access_push(vn);
2233 66909 : op_push(OCpushlex,(long)vn,n);
2234 66909 : addcopy(n,mode,flag,FLnocopy|FLnocopylex);
2235 66909 : compilecast(n,Ggen,mode);
2236 : }
2237 192946 : else if (ep->valence==EpVAR || ep->valence==EpNEW)
2238 : {
2239 182891 : if (DEBUGLEVEL && mode==Gvoid)
2240 0 : pari_warn(warner,"statement with no effect: `%s'",ep->name);
2241 182891 : op_push(OCpushdyn,(long)ep,n);
2242 182891 : addcopy(n,mode,flag,FLnocopy);
2243 182891 : compilecast(n,Ggen,mode);
2244 : }
2245 : else
2246 10055 : closurefunc(ep,n,mode);
2247 259855 : return;
2248 : }
2249 4600067 : case Ffunction:
2250 : {
2251 4600067 : entree *ep=getfunc(n);
2252 4600067 : if (getmvar(ep) || EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
2253 : {
2254 22087 : if (tree[n].x<OPnboperator) /* should not happen */
2255 0 : compile_err("operator unknown",tree[n].str);
2256 22087 : compilecall(n,mode,ep);
2257 : }
2258 : else
2259 4577980 : compilefunc(ep,n,mode,flag);
2260 4600025 : return;
2261 : }
2262 322 : case Fcall:
2263 322 : compilecall(n,mode,NULL);
2264 322 : return;
2265 8917 : case Flambda:
2266 : {
2267 8917 : pari_sp ltop=avma;
2268 : struct codepos pos;
2269 8917 : GEN arg=listtogen(x,Flistarg);
2270 8917 : long nb, lgarg, nbmvar, dovararg=0, gap;
2271 8917 : long strict = GP_DATA->strictargs;
2272 8917 : GEN vep = cgetg_copy(arg, &lgarg);
2273 8917 : GEN text=cgetg(3,t_VEC);
2274 8917 : gel(text,1)=strntoGENstr(tree[x].str,tree[x].len);
2275 8917 : 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 8917 : gel(text,2)=strntoGENstr(tree[y].str,tree[y].len);
2279 8917 : getcodepos(&pos);
2280 8917 : dbgstart=tree[x].str+tree[x].len;
2281 8917 : gap = tree[y].str-dbgstart;
2282 8917 : nbmvar = nblex;
2283 8917 : ctxmvar(nbmvar);
2284 8917 : nb = lgarg-1;
2285 8917 : if (nb)
2286 : {
2287 : long i;
2288 12624 : for(i=1;i<=nb;i++)
2289 : {
2290 7756 : long a = arg[i], f = tree[a].f;
2291 7756 : if (i==nb && f==Fvararg)
2292 : {
2293 21 : dovararg=1;
2294 21 : vep[i]=(long)getvar(tree[a].x);
2295 : }
2296 : else
2297 7735 : vep[i]=(long)getvar(f==Fassign||f==Findarg?tree[a].x:a);
2298 7756 : var_push(NULL,Lmy);
2299 : }
2300 4868 : checkdups(arg,vep);
2301 4868 : op_push(OCgetargs,nb,x);
2302 4868 : access_push(lg(vep)-1);
2303 4868 : frame_push(vep);
2304 12624 : for (i=1;i<=nb;i++)
2305 : {
2306 7756 : long a = arg[i], f = tree[a].f;
2307 7756 : long y = tree[a].y;
2308 7756 : 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 7399 : } else if (f==Findarg)
2322 70 : op_push(OCsetref, -nb+i-1, a);
2323 7756 : localvars[s_lvar.n-nb+i-1].ep=(entree*)vep[i];
2324 : }
2325 : }
2326 8917 : if (strict)
2327 21 : op_push(OCcheckuserargs,nb,x);
2328 8917 : dbgstart=tree[y].str;
2329 8917 : if (y>=0 && tree[y].f!=Fnoarg)
2330 8917 : compilenode(y,Ggen,FLsurvive|FLreturn);
2331 : else
2332 0 : compilecast(n,Gvoid,Ggen);
2333 8917 : if (dovararg) nb|=VARARGBITS;
2334 8917 : op_push(OCpushgen, data_push(getfunction(&pos,nb,nbmvar,text,gap)),n);
2335 8917 : if (nbmvar) op_push(OCsaveframe,!!(flag&FLsurvive),n);
2336 8917 : compilecast(n, Gclosure, mode);
2337 8917 : set_avma(ltop);
2338 8917 : 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 927034 : gp_closure(long n)
2357 : {
2358 : struct codepos pos;
2359 927034 : getcodepos(&pos);
2360 927034 : dbgstart=tree[n].str;
2361 927034 : compilenode(n,Ggen,FLsurvive|FLreturn);
2362 926992 : 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 4427559 : vec_optimize(GEN arg)
2403 : {
2404 4427559 : long fl = COsafelex|COsafedyn;
2405 : long i;
2406 20218170 : for (i=1; i<lg(arg); i++)
2407 : {
2408 15790618 : optimizenode(arg[i]);
2409 15790611 : fl &= tree[arg[i]].flags;
2410 : }
2411 4427552 : return fl;
2412 : }
2413 :
2414 : static void
2415 4334935 : optimizevec(long n)
2416 : {
2417 4334935 : pari_sp ltop=avma;
2418 4334935 : long x = tree[n].x;
2419 4334935 : GEN arg = listtogen(x, Fmatrixelts);
2420 4334935 : tree[n].flags = vec_optimize(arg);
2421 4334935 : set_avma(ltop);
2422 4334935 : }
2423 :
2424 : static void
2425 9408 : optimizemat(long n)
2426 : {
2427 9408 : pari_sp ltop = avma;
2428 9408 : long x = tree[n].x;
2429 : long i;
2430 9408 : GEN line = listtogen(x,Fmatrixlines);
2431 9408 : long fl = COsafelex|COsafedyn;
2432 47054 : for(i=1;i<lg(line);i++)
2433 : {
2434 37646 : GEN col=listtogen(line[i],Fmatrixelts);
2435 37646 : fl &= vec_optimize(col);
2436 : }
2437 9408 : set_avma(ltop); tree[n].flags=fl;
2438 9408 : }
2439 :
2440 : static void
2441 13470 : optimizematcoeff(long n)
2442 : {
2443 13470 : long x=tree[n].x;
2444 13470 : long y=tree[n].y;
2445 13470 : long yx=tree[y].x;
2446 13470 : long yy=tree[y].y;
2447 : long fl;
2448 13470 : optimizenode(x);
2449 13470 : optimizenode(yx);
2450 13470 : fl=tree[x].flags&tree[yx].flags;
2451 13470 : if (yy>=0)
2452 : {
2453 1666 : optimizenode(yy);
2454 1666 : fl&=tree[yy].flags;
2455 : }
2456 13470 : tree[n].flags=fl;
2457 13470 : }
2458 :
2459 : static void
2460 4581816 : optimizefunc(entree *ep, long n)
2461 : {
2462 4581816 : pari_sp av=avma;
2463 : long j;
2464 4581816 : long x=tree[n].x;
2465 4581816 : long y=tree[n].y;
2466 : Gtype t;
2467 : PPproto mod;
2468 4581816 : long fl=COsafelex|COsafedyn;
2469 : const char *p;
2470 : char c;
2471 4581816 : GEN arg = listtogen(y,Flistarg);
2472 4581816 : long nb=lg(arg)-1, ret_flag;
2473 4581816 : if (is_func_named(ep,"if") && nb>=4)
2474 119 : ep=is_entry("_multi_if");
2475 4581816 : p = ep->code;
2476 4581816 : if (!p)
2477 3263 : fl=0;
2478 : else
2479 4578553 : (void) get_ret_type(&p, 2, &t, &ret_flag);
2480 4581816 : if (p && *p)
2481 : {
2482 4571862 : j=1;
2483 9786333 : while((mod=parseproto(&p,&c,tree[n].str))!=PPend)
2484 : {
2485 5214499 : if (j<=nb && tree[arg[j]].f!=Fnoarg
2486 5047404 : && (mod==PPdefault || mod==PPdefaultmulti))
2487 59729 : mod=PPstd;
2488 5214499 : switch(mod)
2489 : {
2490 5033847 : case PPstd:
2491 5033847 : if (j>nb) compile_err("too few arguments", tree[n].str+tree[n].len-1);
2492 5033819 : if (tree[arg[j]].f==Fnoarg && c!='I' && c!='E')
2493 0 : compile_err("missing mandatory argument", tree[arg[j]].str);
2494 5033819 : switch(c)
2495 : {
2496 4996774 : case 'G':
2497 : case 'n':
2498 : case 'M':
2499 : case 'L':
2500 : case 'U':
2501 : case 'P':
2502 4996774 : optimizenode(arg[j]);
2503 4996774 : fl&=tree[arg[j++]].flags;
2504 4996774 : break;
2505 19065 : case 'I':
2506 : case 'E':
2507 : case 'J':
2508 19065 : optimizenode(arg[j]);
2509 19065 : fl&=tree[arg[j]].flags;
2510 19065 : tree[arg[j++]].flags=COsafelex|COsafedyn;
2511 19065 : break;
2512 2231 : case '&': case '*':
2513 : {
2514 2231 : long a=arg[j];
2515 2231 : if (c=='&')
2516 : {
2517 1477 : if (tree[a].f!=Frefarg)
2518 0 : compile_err("expected character: '&'", tree[a].str);
2519 1477 : a=tree[a].x;
2520 : }
2521 2231 : optimizenode(a);
2522 2231 : tree[arg[j++]].flags=COsafelex|COsafedyn;
2523 2231 : fl=0;
2524 2231 : break;
2525 : }
2526 322 : case 'W':
2527 : {
2528 322 : long a = tree[arg[j]].f==Findarg ? tree[arg[j]].x: arg[j];
2529 322 : optimizenode(a);
2530 322 : fl=0; j++;
2531 322 : break;
2532 : }
2533 6101 : case 'V':
2534 : case 'r':
2535 6101 : tree[arg[j++]].flags=COsafelex|COsafedyn;
2536 6101 : break;
2537 6623 : case '=':
2538 : {
2539 6623 : long a=arg[j++], y=tree[a].y;
2540 6623 : if (tree[a].f!=Fassign)
2541 0 : compile_err("expected character: '=' instead of",
2542 0 : tree[a].str+tree[a].len);
2543 6623 : optimizenode(y);
2544 6623 : fl&=tree[y].flags;
2545 : }
2546 6623 : break;
2547 2703 : case 's':
2548 2703 : fl &= vec_optimize(cattovec(arg[j++], OPcat));
2549 2703 : 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 5033819 : break;
2555 98621 : case PPauto:
2556 98621 : break;
2557 68000 : case PPdefault:
2558 : case PPdefaultmulti:
2559 68000 : if (j<=nb) optimizenode(arg[j++]);
2560 68000 : break;
2561 14031 : case PPstar:
2562 14031 : 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 13912 : case 's':
2577 : {
2578 13912 : long n=nb+1-j;
2579 : long k;
2580 33817 : for(k=1;k<=n;k++)
2581 19905 : fl &= vec_optimize(cattovec(arg[j+k-1],OPcat));
2582 13912 : j=nb+1;
2583 13912 : 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 14031 : break;
2590 0 : default:
2591 0 : pari_err_BUG("optimizefun [unknown PPproto]");
2592 : }
2593 : }
2594 4571834 : if (j<=nb)
2595 0 : compile_err("too many arguments",tree[arg[j]].str);
2596 : }
2597 9954 : else (void)vec_optimize(arg);
2598 4581788 : set_avma(av); tree[n].flags=fl;
2599 4581788 : }
2600 :
2601 : static void
2602 22416 : optimizecall(long n)
2603 : {
2604 22416 : pari_sp av=avma;
2605 22416 : long x=tree[n].x;
2606 22416 : long y=tree[n].y;
2607 22416 : GEN arg=listtogen(y,Flistarg);
2608 22416 : optimizenode(x);
2609 22416 : tree[n].flags = COsafelex&tree[x].flags&vec_optimize(arg);
2610 22409 : set_avma(av);
2611 22409 : }
2612 :
2613 : static void
2614 14057 : optimizeseq(long n)
2615 : {
2616 14057 : pari_sp av = avma;
2617 14057 : GEN L = listtogen(n, Fseq);
2618 14057 : long i, l = lg(L)-1, flags=-1L;
2619 58151 : for(i = 1; i <= l; i++)
2620 : {
2621 44094 : optimizenode(L[i]);
2622 44094 : flags &= tree[L[i]].flags;
2623 : }
2624 14057 : set_avma(av);
2625 14057 : tree[n].flags = flags;
2626 14057 : }
2627 :
2628 : void
2629 21970919 : optimizenode(long n)
2630 : {
2631 : long x,y;
2632 : #ifdef STACK_CHECK
2633 21970919 : if (PARI_stack_limit && (void*) &x <= PARI_stack_limit)
2634 0 : pari_err(e_MISC, "expression nested too deeply");
2635 : #endif
2636 21970919 : if (n<0)
2637 0 : pari_err_BUG("optimizenode");
2638 21970919 : x=tree[n].x;
2639 21970919 : y=tree[n].y;
2640 :
2641 21970919 : switch(tree[n].f)
2642 : {
2643 14057 : case Fseq:
2644 14057 : optimizeseq(n);
2645 21897690 : return;
2646 15136 : case Frange:
2647 15136 : optimizenode(x);
2648 15136 : optimizenode(y);
2649 15136 : tree[n].flags=tree[x].flags&tree[y].flags;
2650 15136 : break;
2651 13470 : case Fmatcoeff:
2652 13470 : optimizematcoeff(n);
2653 13470 : break;
2654 44581 : case Fassign:
2655 44581 : optimizenode(x);
2656 44581 : optimizenode(y);
2657 44581 : tree[n].flags=0;
2658 44581 : break;
2659 12926085 : case Fnoarg:
2660 : case Fnorange:
2661 : case Fsmall:
2662 : case Fconst:
2663 : case Fentry:
2664 12926085 : tree[n].flags=COsafelex|COsafedyn;
2665 12926085 : return;
2666 4334935 : case Fvec:
2667 4334935 : optimizevec(n);
2668 4334935 : return;
2669 9408 : case Fmat:
2670 9408 : optimizemat(n);
2671 9408 : return;
2672 7 : case Frefarg:
2673 7 : compile_err("unexpected character '&'",tree[n].str);
2674 0 : return;
2675 91 : case Findarg:
2676 91 : return;
2677 0 : case Fvararg:
2678 0 : compile_err("unexpected characters '..'",tree[n].str);
2679 0 : return;
2680 4603910 : case Ffunction:
2681 : {
2682 4603910 : entree *ep=getfunc(n);
2683 4603910 : if (EpVALENCE(ep)==EpVAR || EpVALENCE(ep)==EpNEW)
2684 22094 : optimizecall(n);
2685 : else
2686 4581816 : optimizefunc(ep,n);
2687 4603875 : return;
2688 : }
2689 322 : case Fcall:
2690 322 : optimizecall(n);
2691 322 : return;
2692 8917 : case Flambda:
2693 8917 : optimizenode(y);
2694 8917 : tree[n].flags=COsafelex|COsafedyn;
2695 8917 : 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 : }
|
