1 /*
2 Copyright (C) 2000-2013  The PARI group.
3 
4 This file is part of the GP2C package.
5 
6 PARI/GP is free software; you can redistribute it and/or modify it under the
7 terms of the GNU General Public License as published by the Free Software
8 Foundation. 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 "config.h"
16 #include <stdlib.h>
17 #include <stdio.h>
18 #include <string.h>
19 #include <ctype.h>
20 #include "header.h"
21 
newdesc(int nb)22 gpdesc *newdesc(int nb)
23 {
24   gpdesc *gd = (gpdesc *) malloc(sizeof(*gd));
25   gd->nb=nb;
26   gd->a=nb?(gpdescarg *)calloc(nb,sizeof(*(gd->a))):NULL;
27   return gd;
28 }
29 
newwrap(int nb)30 gpwrap *newwrap(int nb)
31 {
32   gpwrap *gw = (gpwrap *) malloc(sizeof(*gw));
33   gw->nb=nb;
34   gw->w=nb?(int *)calloc(nb,sizeof(*(gw->w))):NULL;
35   return gw;
36 }
37 
38 static void
strtoargsdefault(char * s,descargatom * aa,int opt)39 strtoargsdefault(char *s, descargatom *aa, int opt)
40 {
41   if (isdigit(*s) || *s=='-' || *s=='+')
42   {
43     aa->t=opt?AAoptsmall:AAsmall;
44     aa->type=Gsmall;
45     aa->misc=atol(s);
46   }
47   else
48   {
49     int t=strtotype(s);
50     aa->t=opt?AAopttype:AAtype;
51     aa->type=t;
52   }
53 }
54 /*modify s*/
55 descargatom
strtoargs(char * s)56 strtoargs(char *s)
57 {
58   descargatom aa;
59   int t;
60   char *mstr=s;
61   aa.mode=0;
62   aa.type=Gnotype;
63   aa.misc=0;
64   while ((mstr=strrchr(mstr,':')))
65   {
66     aa.mode|=1<<strtomode(mstr+1);
67     *mstr=0;
68   }
69   switch(*s)
70   {
71   case 0:
72     aa.t=AAnoarg;
73     return aa;
74   case '&':
75     aa.t=AAreftype;
76     break;
77   case '#':
78     aa.t=AAherevalue;
79     break;
80   case '*':
81     aa.t=AAlvalue;
82     break;
83   case '"':
84     aa.t=AAstring;
85     aa.str=xstrndup(s+1,strlen(s)-2);
86     return aa;
87     break;
88   case '@':
89     aa.t=AAmulti;
90     break;
91   case '.':
92     if (s[1]=='.' && s[2]=='.' && s[3]==0)
93     {
94       aa.t=AAstdarg;
95       return aa;
96     }
97     die(err_desc,"Unknown atom `%s' in description file",s);
98   case 'C':
99     switch(s[1])
100     {
101     case '!':
102       aa.t=AActype;
103       aa.misc=strtoctype(s+2);
104       return aa;
105     default:
106       die(err_desc,"Unknown atom `%s' in description file",s);
107     }
108   case '?':
109     strtoargsdefault(s+1,&aa,1);
110     return aa;
111   default:
112     strtoargsdefault(s,&aa,0);
113     return aa;
114   }
115   t=strtotype(s+1);
116   if (t==-1)
117     die(err_desc,"Bad reference in description file");
118   aa.type=t;
119   return aa;
120 }
readentry(FILE * f,char * buf,int len)121 void readentry(FILE *f, char *buf, int len)
122 {
123   if (!fgets(buf,len,f))
124     perror("gp2c");
125   if (!*buf)
126     die(err_desc,"Bad description file <entry>");
127   buf[strlen(buf)-1]=0;
128 }
129 
readnumber(FILE * f,char * buf,int len)130 int readnumber(FILE *f, char *buf, int len)
131 {
132   readentry(f,buf,len);
133   return atol(buf);
134 }
135 
readtypemode(FILE * f,char * buf,int len,int * mode)136 int readtypemode(FILE *f,char *buf, int len, int *mode)
137 {
138   int nb=readnumber(f,buf,len);
139   int type;
140   *mode=0;
141   if (nb)
142   {
143     int j;
144     readentry(f,buf,len);
145     type=strtotype(buf);
146     for(j=1;j<nb;j++)
147     {
148       readentry(f,buf,len);
149       *mode|=1<<strtomode(buf);
150     }
151   }
152   else
153     type=Gempty;
154   return type;
155 }
156 
157 #define BUFFER_SIZE 1024
158 
initdesc(const char * descfile)159 void initdesc(const char *descfile)
160 {
161   char buf[BUFFER_SIZE];
162   FILE *dfile;
163   if (!(dfile=fopen(descfile,"r")))
164     die(err_desc,"Cannot find description file %s",descfile);
165   while(!feof(dfile))
166   {
167     int i, nb, nf;
168     gpfunc *func;
169     gpdesc *gd;
170     if (!fgets(buf,BUFFER_SIZE,dfile))
171       break;
172     if (!*buf)
173       die(err_desc,"Bad description file %s",descfile);
174     buf[strlen(buf)-1]=0;
175     nf=getfunc(buf); func=lfunc+nf;
176     nb=readnumber(dfile,buf,BUFFER_SIZE);/*number of description*/
177     if (nb<0)
178       die(err_desc,"Bad description file %s, func %s",descfile,func->gpname);
179     for(i=0;i<nb;i++)
180     {
181       int j,nargs,type,ndesc;
182       type=readnumber(dfile,buf,BUFFER_SIZE);
183       switch(type)
184       {
185         case 0: case 3:
186           /* This is a description or an iterator*/
187           ndesc=readnumber(dfile,buf,BUFFER_SIZE);
188           if (ndesc)
189           {
190             gd = newdesc(ndesc);
191             if (type==0) func->dsc=gd;
192             else         func->iter=gd;
193           }
194           for(j=0; j<ndesc; j++)
195           {
196             int k;
197             gpdescarg *da=gd->a+j;
198             if (type==0)
199             {
200               readentry(dfile,buf,BUFFER_SIZE);
201               da->cname=strdup(buf);
202             }
203             else
204             {
205               gpiterator *iter = &(da->iter);
206               int niter=readnumber(dfile,buf,BUFFER_SIZE);
207               if (niter<3 && niter>4) die(err_desc,"unsupported iterator");
208               readentry(dfile,buf,BUFFER_SIZE);
209               iter->type=strtotype(buf);
210               readentry(dfile,buf,BUFFER_SIZE);
211               iter->init=getfunc(buf); func = lfunc+nf;
212               readentry(dfile,buf,BUFFER_SIZE);
213               iter->next=getfunc(buf); func = lfunc+nf;
214               if (niter==4)
215               {
216                 readentry(dfile,buf,BUFFER_SIZE);
217                 iter->end=getfunc(buf); func = lfunc+nf;
218               }
219               else
220                 iter->end=-1;
221             }
222             nargs=readnumber(dfile,buf,BUFFER_SIZE);
223             da->nargs=nargs;
224             if (nargs)
225               da->args=(descargatom *) calloc(nargs,sizeof(*da->args));
226             else
227               da->args=NULL;
228             for(k=0; k<nargs;k++)
229             {
230               readentry(dfile,buf,BUFFER_SIZE);
231               da->args[k]=strtoargs(buf);
232             }
233             da->type=readtypemode(dfile,buf,BUFFER_SIZE,&da->mode);
234           }
235           break;
236         case 1: /*This is a prototype*/
237           readentry(dfile,buf,BUFFER_SIZE);
238           func->proto.cname=strdup(buf);
239           readentry(dfile,buf,BUFFER_SIZE);
240           func->proto.code=strdup(buf);
241           functype(*func)=readtypemode(dfile,buf,BUFFER_SIZE,&funcmode(*func));
242           break;
243         case 2: /*This is a wrapper*/
244           nargs=readnumber(dfile,buf,BUFFER_SIZE);
245           func->wrap = newwrap(nargs);
246           for(j=0;j<nargs;j++)
247           {
248             int nw;
249             readentry(dfile,buf,BUFFER_SIZE);
250             nw = getfunc(buf); func = lfunc+nf; /* getfunc can realloc lfunc */
251             func->wrap->w[j]=*buf?(buf[1]?nw:-1):-2;
252           }
253           break;
254         default:
255           die(err_desc,"Unknown description type %d in %s",type,descfile);
256       }
257     }
258   }
259   fclose(dfile);
260 }
261 
262 int
descrulescore(int nb,int * args,gpdescarg * ga,int * const psc,int * const pesc)263 descrulescore(int nb, int *args, gpdescarg *ga, int * const psc,int * const pesc)
264 {
265   int sc=0, esc=0;
266   int i,j;
267   descargatom *da=ga->args;
268   for (i=0, j=0;j<ga->nargs;j++, i++)
269   {
270     int t;
271     int arg=(i<nb)?args[i]:GNOARG;
272     if (da[j].t==AAstdarg)
273     {
274       if (j==0)
275         die(err_desc,"No argument before ellipsis  (...)");
276       if (i>=nb)
277         break;
278       j--;
279     }
280     if (arg==GNOARG)
281     {
282       if (da[j].t==AAnoarg || da[j].t==AAoptsmall || da[j].t==AAopttype)
283       {
284         esc++;
285         if (i>=nb)
286           sc++;
287         continue;
288       }
289       return 1;
290     }
291     if (arg<0)
292       die(err_desc,"Internal error: Bad argument in descfindrules");
293     if (da[j].mode>=0)
294     {
295       if ((tree[arg].m&da[j].mode)==da[j].mode)
296         esc++;
297       else
298         return 1;
299     }
300     t=tree[arg].t;
301     switch(da[j].t)
302     {
303     case AAopttype: /* Since arg is not GNOARG, arg is present */
304     case AAtype:
305       if (t==da[j].type)
306         esc++;
307       if (is_subtype(t,da[j].type))
308         break;
309       if (is_subtype(da[j].type,t))
310         sc++;
311       else
312         return 1;
313       break;
314     case AActype:
315       if (ctype[t]==da[j].misc)
316         esc++;
317       else
318         return 1;
319       break;
320     case AAoptsmall: /* Since arg is not GNOARG, arg is present */
321     case AAsmall:
322       if (tree[arg].f==Fsmall && tree[arg].x==da[j].misc)
323         esc++;
324       else
325         return 1;
326       break;
327     case AAstring:
328       if (is_const(arg,CSTstr) &&  strcmp(entryname(arg),da[j].str)==0)
329         esc++;
330       else
331         return 1;
332       break;
333     case AAreftype:
334       if (t==da[j].type)
335         esc++;
336       if (tree[arg].f==Frefarg && is_subtype(da[j].type,t)
337                                && ctype[t]==ctype[da[j].type])
338         break;
339       return 1;
340     case AAherevalue:
341       if (t==da[j].type && (tree[arg].f==Fsmall || tree[arg].f==Fconst))
342       {
343         esc++;
344         break;
345       }
346       return 1;
347     case AAlvalue:
348       if (getlvalue(arg)<0)
349         return 1;
350       if (t==da[j].type)
351         esc++;
352       else if (ctype[t]!=ctype[da[j].type] || !is_subtype(t,da[j].type))
353         return 1;
354       break;
355     case AAmulti:
356       if (tree[arg].f==Fentry || tree[arg].f==Fsmall)
357         break;
358       return 1;
359     case AAnoarg:/* Since arg is not GNOARG, reject*/
360       return 1;
361     default:
362       die(err_desc,"Internal error unknown AAvalue in descrulescore");
363     }
364   }
365   if (i<nb) return 1;
366   *psc=sc; *pesc=esc;
367   return 0;
368 }
369 
descfindrulesdsc(int nb,int * arg,gpdesc * dsc)370 gpdescarg *descfindrulesdsc(int nb, int *arg, gpdesc *dsc)
371 {
372   int i;
373   int best=-1,score=-1,escore=-1;
374   gpdescarg *ga=dsc->a;
375   for(i=0;i<dsc->nb;i++)
376   {
377     int sc=0, esc=0;
378     if (descrulescore(nb,arg,ga+i,&sc,&esc))
379       continue;
380     if (best==-1 || sc<score || (sc==score &&  esc>escore ))
381     {
382       score=sc;
383       escore=esc;
384       best=i;
385     }
386   }
387   return (best==-1)?NULL:ga+best;
388 }
389 
390 
descfindrules(int nb,int * arg,gpfunc * gp)391 gpdescarg *descfindrules(int nb, int *arg, gpfunc *gp)
392 {
393   return descfindrulesdsc(nb, arg, gp->dsc);
394 }
395 
descfindrules1(int arg,int nf)396 gpdescarg *descfindrules1(int arg, int nf)
397 {
398   return descfindrules(1, &arg, lfunc+nf);
399 }
400 
gentypefuncdesc(int n,gpfunc * gp)401 int gentypefuncdesc(int n, gpfunc *gp)
402 {
403   int arg[STACKSZ];
404   int i, nb;
405   int y=tree[n].y;
406   gpdescarg *rule;
407   if ( y!=-1 )
408   {
409     gentype(y);
410     tree[n].m|=tree[y].m&MODHERIT;
411   }
412   nb=genlistargs(n,arg,0,STACKSZ);
413   rule=descfindrules(nb,arg,gp);
414   if (!rule)
415     return Gnotype;
416   for(i=0;i<rule->nargs;i++)
417     if (rule->args[i].t==AAlvalue)
418     {
419       int ta=tree[arg[i]].t, ts=rule->args[i].type;
420       if (!is_subtype(ts,ta))
421         warning(n,"Assignement to a less precise type: %s<-%s",GPname(ta),GPname(ts));
422     }
423   tree[n].m|=rule->mode;
424   return rule->type;
425 }
426 
427 enum FBenum {FBparens, FBstdref} flagbit;
428 
429 struct rpn_data
430 {
431   FILE *fout;
432   gpdescarg *rule;
433   int nbarg;
434   int *arg;
435   int nerr;
436   int nf;
437   int sp;
438   long flag;
439 };
440 
get_arg(struct rpn_data * d,int n)441 static int get_arg(struct rpn_data *d, int n)
442 {
443   if (n<=d->nbarg)
444     return d->arg[n-1];
445   return GNOARG;
446 }
447 
get_str(struct rpn_data * d,int n)448 static int get_str(struct rpn_data *d, int n)
449 {
450   int x=get_arg(d,n);
451   if (tree[x].f!=Fconst && value[tree[x].x].type!=CSTstr)
452     die(n,"Constant string expected");
453   return x;
454 }
455 
get_atom(struct rpn_data * d,int n)456 static descargatom* get_atom(struct rpn_data *d, int n)
457 {
458   if(n>d->rule->nargs) die(d->nerr,"Too few parameters");
459   return d->rule->args+n-1;
460 }
461 
cast_flag(struct rpn_data * d,int n,int t)462 static void cast_flag(struct rpn_data *d, int n, int t)
463 {
464   gencastf(d->fout,n,t,d->flag&(1<<FBparens));
465 }
466 
467 #define RPN(f) void (f)(struct rpn_data *d, int *stk)
468 
469 struct rpn_func
470 {
471   const char *name;
472   int arity;
473   RPN(*function);
474 };
475 
476 #define pop(n)  d->sp-=(n)
477 #define push(n) d->sp+=(n)
478 #define LVL(n)  (stk[d->sp-1-(n)])
479 #define NOLVL   ((void)stk)
480 
RPN(rpn_add)481 RPN(rpn_add) {LVL(1)+=LVL(0); pop(1);}
RPN(rpn_sub)482 RPN(rpn_sub) {LVL(1)-=LVL(0); pop(1);}
RPN(rpn_mul)483 RPN(rpn_mul) {LVL(1)*=LVL(0); pop(1);}
RPN(rpn_div)484 RPN(rpn_div) {LVL(1)/=LVL(0); pop(1);}
RPN(rpn_mod)485 RPN(rpn_mod) {LVL(1)%=LVL(0); pop(1);}
486 
RPN(rpn_and)487 RPN(rpn_and) {LVL(1)&=LVL(0); pop(1);}
RPN(rpn_or)488 RPN(rpn_or)  {LVL(1)|=LVL(0); pop(1);}
RPN(rpn_xor)489 RPN(rpn_xor) {LVL(1)^=LVL(0); pop(1);}
490 
RPN(rpn_neg)491 RPN(rpn_neg) {LVL(0)=-LVL(0);}
RPN(rpn_not)492 RPN(rpn_not) {LVL(0)=!LVL(0);}
493 
RPN(rpn_nbarg)494 RPN(rpn_nbarg)  {push(1);LVL(0)=d->nbarg;}
495 
RPN(rpn_parens)496 RPN(rpn_parens) {NOLVL;d->flag|=1<<FBparens;}
RPN(rpn_stdref)497 RPN(rpn_stdref) {NOLVL;d->flag|=1<<FBstdref;}
498 
RPN(rpn_str_format)499 RPN(rpn_str_format) { genpercent(d->fout, get_str(d, LVL(0))); pop(1); }
RPN(rpn_str_raw)500 RPN(rpn_str_raw)    { fputs(entryname(get_str(d, LVL(0))),d->fout); pop(1); }
RPN(rpn_type)501 RPN(rpn_type) { LVL(0)=get_atom(d, LVL(0))->type; }
502 
RPN(rpn_value)503 RPN(rpn_value)
504 {
505   int n=get_arg(d,LVL(0));
506   if (tree[n].f!=Fsmall) die(n,"Not an immediate small");
507   LVL(0)=tree[n].x;
508 }
509 
RPN(rpn_cast)510 RPN(rpn_cast)
511 {
512   int n=get_arg(d,LVL(1));
513   int cast=LVL(0);
514   descargatom *r=get_atom(d, LVL(1));
515   int t=(cast==-1)?r->type:cast;
516   switch(r->t)
517   {
518   case AAstdarg:
519     {
520       int i;
521       int x=LVL(1)-1;
522       if (x==0) die(d->nerr,"No argument before ellipsis  (...)");
523       t=r[-1].type;
524       for(i=x-1;i<d->nbarg;i++)
525       {
526         if (i>=x) fprintf(d->fout,", ");
527         if (d->flag&(1<<FBstdref))
528           fprintf(d->fout,"&");
529         gencast(d->fout,d->arg[i],t);
530       }
531     }
532     break;
533   case AAoptsmall:
534     fprintf(d->fout,"%d",r->misc);
535     break;
536   case AAopttype:
537     if (n==GNOARG)
538       gencodenoarg(d->fout,t,n);
539     else
540       cast_flag(d,n,t);
541     break;
542   case AActype:
543     if (cast==-1) t=tree[n].t;
544   default: /*Fall through*/
545     cast_flag(d,n,t);
546     break;
547   }
548   pop(2);
549 }
550 
RPN(rpn_prec)551 RPN(rpn_prec)
552 {
553   genprec(d->fout, preclevel);
554 }
555 
RPN(rpn_bitprec)556 RPN(rpn_bitprec)
557 {
558   genbitprec(d->fout, preclevel);
559 }
560 
RPN(rpn_code)561 RPN(rpn_code) { push(1); LVL(0)=-1; rpn_cast(d,stk); }
562 
RPN(rpn_wrapper)563 RPN(rpn_wrapper)
564 {
565   int idx = LVL(0);
566   int n = get_arg(d,idx);
567   gpfunc *gp;
568   pop(1);
569   if (isfunc(n,"_closure"))
570   {
571     int y = tree[n].y;
572     while(tree[y].f==Flistarg) y=tree[y].x;
573     gp = lfunc+findfunction(entryname(y));
574     if (gp->spec==GPuser && gp->user->wrapper>=0)
575     {
576       fprintf(d->fout, "wrap_%s", gp->proto.cname);
577       return;
578     }
579   }
580   gp = lfunc+lfunc[d->nf].wrap->w[idx-1];
581   fputs(gp->proto.cname, d->fout);
582 }
583 
RPN(rpn_cookie)584 RPN(rpn_cookie)
585 {
586   int arg[STACKSZ];
587   int n=get_arg(d,LVL(0));
588   if (isfunc(n,"_closure"))
589   {
590     int nb=genlistargs(n,arg,1,STACKSZ-1);
591     gpfunc *gp = lfunc + findfunction(entryname(arg[0]));
592     if (gp->spec==GPuser && gp->user->wrapper>=0)
593     {
594       gpfunc *wr = lfunc + gp->user->wrapper;
595       if ((funcmode(*gp)&(1<<Mprec)) && !(funcmode(*wr)&(1<<Mprec)))
596         genfuncbydesc(d->fout, nb-1,arg+1,FC_tovecprec,d->nerr);
597       else
598       {
599         if (nb==1)
600           fputs("NULL", d->fout);
601         else
602           genfuncbydesc(d->fout, nb-1,arg+1,FC_tovec,d->nerr);
603       }
604       pop(1);
605       return;
606     }
607   }
608   rpn_code(d,stk);
609 }
610 
RPN(rpn_format_string)611 RPN(rpn_format_string)
612 {
613   int x=LVL(0)-1;
614   int i,j;
615   int arg[STACKSZ];
616   if (x==0) die(d->nerr,"Ellipsis at start of description");
617   for(j=x-1;j<d->nbarg;j++)
618   {
619     int nb=genlistcats(d->arg[j],arg,STACKSZ);
620     for(i=0;i<nb;i++)
621     {
622       int n=arg[i];
623       if (n==GNOARG) continue;
624       if (genfuncbydesc1(d->fout,n,FC_formatcode,n))
625         die(n,"No format for %s arg",GPname(tree[n].t));
626     }
627   }
628   pop(1);
629 }
630 
RPN(rpn_format_args)631 RPN(rpn_format_args)
632 {
633   int x=LVL(0)-1;
634   int arg[STACKSZ];
635   int i,j;
636   if (x==0) die(d->nerr,"Ellipsis at start of description");
637   for(j=x-1;j<d->nbarg;j++)
638   {
639     int nb=genlistcats(d->arg[j],arg,STACKSZ);
640     for(i=0;i<nb;i++)
641     {
642       gpdescarg *rule;
643       int n=arg[i];
644       if (n==GNOARG) continue;
645       rule=descfindrules1(n, FC_formatcode);
646       if (!rule) die(n,"Not format for %s arg",GPname(tree[n].t));
647       if (rule->type!=Gvoid)
648       {
649         fprintf(d->fout,", ");
650         gencast(d->fout,arg[i],rule->type);
651       }
652     }
653   }
654   pop(1);
655 }
656 
gencoderpn(FILE * fout,const char * p,gpdescarg * rule,int nbarg,int * arg,int nerr,int nf)657 const char *gencoderpn(FILE *fout, const char *p, gpdescarg *rule, int nbarg, int *arg, int nerr, int nf)
658 {
659   int stk[STACKSZ];
660   struct rpn_data data;
661   const char *ps = p+1;
662   struct rpn_func rpn[] =
663   {
664     {"add",2,rpn_add},{"sub",2,rpn_sub},{"neg",1,rpn_neg},
665     {"mul",2,rpn_mul},{"div",2,rpn_div},{"mod",2,rpn_mod},
666     {"and",2,rpn_and},{"or",2,rpn_or},{"xor",2,rpn_xor},{"not",1,rpn_not},
667     {"value",1,rpn_value},{"type",1,rpn_type},{"nbarg",0,rpn_nbarg},
668     {"parens",0,rpn_parens},{"stdref",0,rpn_stdref},
669     {"str_format",1,rpn_str_format},{"str_raw",1,rpn_str_raw},
670     {"code",1,rpn_code},{"cast",2,rpn_cast},
671     {"prec",0,rpn_prec},{"bitprec",0,rpn_bitprec},
672     {"format_string",1,rpn_format_string}, {"format_args",1,rpn_format_args},
673     {"cookie",1,rpn_cookie}, {"wrapper",1,rpn_wrapper},
674     {NULL,0,NULL}
675   };
676   data.fout=fout;
677   data.rule=rule;
678   data.nbarg=nbarg;
679   data.arg=arg;
680   data.nerr=nerr;
681   data.nf=nf;
682   data.flag=0;
683   data.sp=0;
684   for(;;p++)
685   {
686     if (!*p) die(nerr,"Unfinished ${} in description");
687     if (*p==' ' || *p=='}' )
688     {
689       size_t l=p-ps;
690       if (isdigit(ps[0]) || ps[0]=='-')
691         stk[data.sp++]=strtol(ps,NULL,10);
692       else if (ps[0]==':')
693         stk[data.sp++]=strtotype_len(ps+1,l-1);
694       else
695       {
696         int r;
697         for(r=0; rpn[r].name; r++)
698         {
699           const char *name=rpn[r].name;
700           if (l==strlen(name) && !strncmp(ps,name,l))
701           {
702             if (rpn[r].arity>data.sp)
703               die(nerr,"Too few arguments for %s",name);
704             rpn[r].function(&data,stk);
705             break;
706           }
707         }
708         if(!rpn[r].name)
709           die(nerr,"Unknown description command %s",xstrndup(ps,l));
710       }
711       ps=p+1;
712       if(*p=='}')
713         break;
714     }
715   }
716   if (data.sp)
717     fprintf(fout,"%d",stk[--data.sp]);
718   return p;
719 }
720 
gencodedesc(FILE * fout,int nb,int * arg,gpdescarg * rule,int nerr,int nf)721 void gencodedesc(FILE *fout, int nb, int *arg, gpdescarg *rule, int nerr, int nf)
722 {
723   char buf[STACKSZ];
724   const char *p;
725   int mode;
726   p=rule->cname;
727   mode=0;
728   do
729   {
730     switch(mode)
731     {
732     case 0:
733       if (*p=='$')
734         mode=1;
735       else if (*p)
736         fputc(*p,fout);
737       break;
738     case 1:
739       switch(*p)
740       {
741       case '$':
742         mode=0;
743         fprintf(fout,"$");
744         break;
745       case '"':
746         {
747           char *s=(char*) memccpy(buf,p+1,'"',STACKSZ-1);
748           if (!s)
749             die(nerr,"Unfinished \" in description");
750           *(s-1)=0;
751           die(nerr,buf);
752         }
753       case 0:
754         die(nerr,"Unfinished $ in description");
755       case '{':
756         p=gencoderpn(fout, p, rule, nb, arg, nerr, nf);
757         mode=0;
758         break;
759       default:
760         die(nerr,"Unknown description");
761       }
762     }
763   } while(*p++);
764 }
765 
genfuncbydesc(FILE * fout,int nb,int * arg,int nf,int nerr)766 int genfuncbydesc(FILE *fout, int nb, int *arg, int nf, int nerr)
767 {
768   gpdescarg *rule=descfindrules(nb, arg, lfunc+nf);
769   if (!rule)
770     return 1;
771   gencodedesc(fout,nb, arg, rule, nerr, nf);
772   return 0;
773 }
774 
genfuncbydesc1(FILE * fout,int arg,int nf,int nerr)775 int genfuncbydesc1(FILE *fout, int arg, int nf, int nerr)
776 {
777   return genfuncbydesc(fout, 1, &arg, nf, nerr);
778 }
779