* bug 7599 fixed - Intersci-n and intersci did not create code from a .desc file...
[scilab.git] / scilab / modules / intersci / src / exe / read.c
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ????-2008 - INRIA
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution.  The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13 #include <stdlib.h>
14
15 #include "intersci-n.h"
16
17 #ifndef nlgh
18 #define nlgh 24
19 #endif
20
21 #define CR '\r'
22
23 static int removeEOL(char *_str)
24 {
25     if (_str)
26     {
27         int len = (int)strlen(_str);
28         if (len > 0)
29         {
30             if (_str[len - 1] == CR)
31             {
32                 _str[len - 1] = 0;
33                 return 1;
34             }
35         }
36     }
37     return 0;
38 }
39 /**********************************************************
40 *Reading the intersci description file
41 **********************************************************/
42
43 int ReadFunction(FILE *f)
44 {
45     int i = 0, j = 0, l = 0, type = 0, ftype = 0;
46     char s[MAXLINE];
47     char *words[MAXLINE];
48     char *optwords[MAXLINE];
49     IVAR ivar = 0;
50     int nwords = 0, line1 = 0, inbas = 0, fline1 = 0, infor = 0, nopt = 0, out1 = 0;
51
52     nVariable = 0;
53     icre = 1;
54     basfun->maxOpt = 0;
55     basfun->NewMaxOpt = 0;
56     line1 = 1;
57     inbas = 0;
58     fline1 = 0;
59     infor = 0;
60     out1 = 0;
61
62     strcpy(s, "");
63
64     while (fgets(s, MAXLINE, f) != NULL)
65     {
66         removeEOL(s);
67         /* ignoring comments */
68         if (s[0] == '/' && s[1] == '/' ) continue;
69
70         /* analysis of one line */
71         if (line1 != 1)
72             nwords = ParseLine(s,words);
73         else
74             nwords = ParseScilabLine(s,words);
75         /* empty definition at end of file */
76         if (line1 == 1 && nwords == 0)
77         {
78             return 0;
79         }
80         /* end of description */
81         if (words[0][0] == '*') return(1);
82         if (line1 == 1)
83         {
84             /* SCILAB function description */
85             if ((int)strlen(words[0]) > nlgh)
86             {
87                 printf("SCILAB function name too long: \"%s\"\n",words[0]);
88                 exit(1);
89             }
90             basfun->name = (char *)malloc((unsigned)(strlen(words[0])+1));
91             strcpy(basfun->name,words[0]);
92             printf("**************************\n");
93             printf("processing SCILAB function \"%s\"\n",words[0]);
94             funNames[nFun] = basfun->name;
95             i = nwords - 1;
96             if (i > MAXARG)
97             {
98                 printf("too may input arguments for SCILAB function\"%s\"\n",
99                     words[0]);
100                 printf("  augment constant \"MAXARG\" and recompile intersci\n");
101                 exit(1);
102             }
103             basfun->nin = i;
104             for (i = 0; i < basfun->nin ; i++)
105             {
106                 if (words[i+1][0] == '{')
107                 {
108                     basfun->maxOpt++;
109                     nopt = ParseLine(words[i+1]+1,optwords);
110                     if (nopt != 2) {
111                         printf("Bad syntax for optional argument. Two variables needed\n");
112                         exit(1);
113                     }
114                     ivar = GetVar(optwords[0],1);
115                     basfun->in[i] = ivar;
116                     variables[ivar-1]->opt_type = NAME;
117                     variables[ivar-1]->opt_name =
118                         (char *)malloc((unsigned)(strlen(optwords[1])+1));
119                     variables[ivar-1]->stack_position = icre++;
120                     strcpy(variables[ivar-1]->opt_name,optwords[1]);
121                     variables[ivar-1]->is_sciarg = 1;
122                 }
123                 else if (words[i+1][0] == '[')
124                 {
125                     basfun->maxOpt++;
126                     nopt = ParseLine(words[i+1]+1,optwords);
127                     if (nopt != 2)
128                     {
129                         printf("Bad syntax for optional argument. Two variables needed\n");
130                         exit(1);
131                     }
132                     ivar = GetVar(optwords[0],1);
133                     basfun->in[i] = ivar;
134                     variables[ivar-1]->opt_type = VALUE;
135                     variables[ivar-1]->opt_name =
136                         (char *)malloc((unsigned)(strlen(optwords[1])+1));
137                     strcpy(variables[ivar-1]->opt_name,optwords[1]);
138                     variables[ivar-1]->stack_position = icre++;
139                     variables[ivar-1]->is_sciarg = 1;
140                 }
141                 else
142                 {
143                     basfun->in[i] = GetVar(words[i+1],1);
144                     variables[basfun->in[i]-1]->stack_position = icre++;
145                     variables[basfun->in[i]-1]->is_sciarg = 1;
146                 }
147             }
148             line1 = 0;
149             inbas = 1;
150         }
151         else if (inbas == 1)
152         {
153             if (nwords == 0)
154             {
155                 /* end of SCILAB variable description */
156                 inbas = 0;
157                 fline1 = 1;
158             }
159             else
160             {
161                 /* SCILAB variable description */
162                 ivar = GetVar(words[0],1);
163                 i = ivar - 1;
164                 if ( variables[i]->is_sciarg == 0)
165                 {
166                     /** we only fix stack_position for remaining arguments**/
167                     variables[i]->stack_position = icre++;
168                 }
169                 if (nwords == 1)
170                 {
171                     printf("type missing for variable \"%s\"\n",words[0]);
172                     exit(1);
173                 }
174                 type = GetBasType(words[1]);
175                 variables[i]->type = type;
176                 switch (type)
177                 {
178                 case SCALAR:
179                 case ANY:
180                 case SCIMPOINTER:
181                 case SCISMPOINTER:
182                 case SCILPOINTER:
183                 case SCIBPOINTER:
184                 case SCIOPOINTER:
185                     break;
186                 case COLUMN:
187                 case ROW:
188                 case STRING:
189                 case WORK:
190                 case VECTOR:
191                     if (nwords != 3)
192                     {
193                         printf("bad type specification for variable \"%s\"\n", words[0]);
194                         printf("only %d argument given and %d are expected\n", nwords,3);
195                         exit(1);
196                     }
197                     variables[i]->el[0] = GetVar(words[2],1);
198                     variables[i]->length++;
199                     break;
200                 case LIST:
201                 case TLIST:
202                     if (nwords != 3)
203                     {
204                         printf("bad type specification for variable \"%s\"\n", words[0]);
205                         printf("only %d argument given and %d are expected\n", nwords,3);
206                         exit(1);
207                     }
208                     ReadListFile(words[2],words[0],i,
209                         variables[i]->stack_position);
210                     break;
211                 case POLYNOM:
212                 case MATRIX:
213                 case BMATRIX:
214                 case STRINGMAT:
215                     if (nwords != 4)
216                     {
217                         printf("bad type specification for variable \"%s\"\n",words[0]);
218                         printf("%d argument given and %d are expected\n", nwords,4);
219                         exit(1);
220                     }
221                     variables[i]->el[0] = GetVar(words[2],1);
222                     variables[i]->el[1] = GetVar(words[3],1);
223                     variables[i]->length = 2;
224                     break;
225                 case IMATRIX:
226                     if (nwords != 5)
227                     {
228                         printf("bad type specification for variable \"%s\"\n",words[0]);
229                         printf("%d argument given and %d are expected\n", nwords,4);
230                         exit(1);
231                     }
232                     variables[i]->el[0] = GetVar(words[2],1);
233                     variables[i]->el[1] = GetVar(words[3],1);
234                     variables[i]->el[2] = GetVar(words[4],1);
235                     variables[i]->length = 3;
236                     break;
237                 case SPARSE:
238                     if (nwords != 6)
239                     {
240                         printf("bad type specification for variable \"%s\"\n",words[0]);
241                         printf("%d argument given and %d are expected\n", nwords,6);
242                         printf("name sparse m n nel it\n");
243                         exit(1);
244                     }
245                     variables[i]->el[0] = GetVar(words[2],1);
246                     variables[i]->el[1] = GetVar(words[3],1);
247                     variables[i]->el[2] = GetVar(words[4],1);
248                     variables[i]->el[3] = GetVar(words[5],1);
249                     variables[i]->length = 4;
250                     break;
251                 case SEQUENCE:
252                     printf("variable \"%s\" cannot have type \"SEQUENCE\"\n",
253                         words[0]);
254                     exit(1);
255                     break;
256                 case EMPTY:
257                     printf("variable \"%s\" cannot have type \"EMPTY\"\n",
258                         words[0]);
259                     exit(1);
260                     break;
261                 }
262             }
263         }
264         else if (fline1 == 1)
265         {
266             /* FORTRAN subroutine description */
267             forsub->name = (char *)malloc((unsigned)(strlen(words[0])+1));
268             strcpy(forsub->name,words[0]);
269             i = nwords - 1;
270             if (i > MAXARG)
271             {
272                 printf("too many argument for FORTRAN subroutine \"%s\"\n",
273                     words[0]);
274                 printf("  augment constant \"MAXARG\" and recompile intersci\n");
275                 exit(1);
276             }
277             forsub->narg = i;
278             for (i = 0; i < nwords - 1; i++)
279             {
280                 forsub->arg[i] = GetExistVar(words[i+1]);
281             }
282             fline1 = 0;
283             infor = 1;
284         }
285         else if (infor == 1)
286         {
287             if (nwords == 0)
288             {
289                 /* end of FORTRAN subroutine description */
290                 infor = 0;
291                 out1 = 1;
292             }
293             else
294             {
295                 /* FORTRAN variable description */
296                 if (nwords == 1)
297                 {
298                     printf("type missing for FORTRAN argument \"%s\"\n",
299                         words[0]);
300                     exit(1);
301                 }
302                 ivar = GetExistVar(words[0]);
303                 ftype = GetForType(words[1]);
304                 variables[ivar-1]->for_type = ftype;
305                 if (ftype == EXTERNAL)
306                 {
307                     strcpy((char *)(variables[ivar-1]->fexternal),words[1]);
308                     switch (variables[ivar-1]->type)
309                     {
310                     case LIST :
311                     case TLIST :
312                     case SCALAR :
313                     case SEQUENCE :
314                     case WORK:
315                     case EMPTY :
316                     case ANY:
317                     case SCIMPOINTER :
318                     case SCISMPOINTER :
319                     case SCILPOINTER :
320                     case SCIBPOINTER :
321                     case SCIOPOINTER :
322                         printf("FORTRAN argument \"%s\" with external type \"%s\"\n",
323                             variables[ivar-1]->name,words[1]);
324                         printf("  cannot have a variable type of \"%s\"\n",SGetSciType(variables[ivar-1]->type));
325                         exit(1);
326                         break;
327                     }
328                 }
329             }
330         }
331         else if (out1 == 1)
332         {
333             /* output variable description */
334             i = ivar - 1;
335             if (nwords == 1)
336             {
337                 printf("type missing for output variable \"out\"\n");
338                 exit(1);
339             }
340             ivar = GetOutVar(words[0]);
341             basfun->out = ivar;
342             i = ivar - 1;
343             type = GetBasType(words[1]);
344             variables[i]->type = type;
345             switch (type)
346             {
347             case LIST:
348             case TLIST:
349             case SEQUENCE:
350                 l = nwords - 2;
351                 if (l > MAXEL)
352                 {
353                     printf("list or sequence too long for output variable \"out\"\n");
354                     printf("  augment constant \"MAXEL\" and recompile intersci\n");
355                     exit(1);
356                 }
357                 for (j = 0; j < l; j++)
358                 {
359                     int k = GetExistVar(words[j+2]);
360                     variables[i]->el[j] = k;
361                     variables[k-1]->out_position = j+1;
362                 }
363                 variables[i]->length = l;
364                 break;
365             case EMPTY:
366                 break;
367             default:
368                 printf("output variable \"out\" of SCILAB function\n");
369                 printf("  must have type \"LIST\", \"TLIST\", \"SEQUENCE\" or\n");
370                 printf("  \"EMPTY\"\n");
371                 exit(1);
372                 break;
373             }
374             out1 = 0;
375         }
376         else
377         {
378             /* possibly equal variables */
379             ivar = GetExistVar(words[0]);
380             i = ivar -1 ;
381             variables[i]->equal = GetExistVar(words[1]);
382         }
383         strcpy(s, "");
384     }
385     /* end of description file */
386     return(0);
387 }
388
389 /***********************************************************************
390 *  put the words of SCILAB function description line "s" in "words" and
391 * return the number of words with checking syntax of optional variables:
392 * "{g  the_g }" => 1 word "{g  the_g\n"
393 * "[f v]" => 1 word "[f v\n"
394 **************************************************************************/
395
396 int ParseScilabLine(char *s,char *words[])
397 {
398     char w[MAXNAM];
399     int nwords = 0;
400     int inword = 1;
401     int inopt1 = 0; /* {  } */
402     int inopt2 = 0; /* [  ] */
403     int i = 0;
404     if (*s == ' ' || *s == '\t') inword = 0;
405     if (*s == '{') inopt1 = 1;
406     if (*s == '[') inopt2 = 1;
407     while (*s) {
408         if (inopt1) {
409             w[i++] = *s++;
410             if (*s == '{' || *s == '[' || *s == ']' || *s == '\n') {
411                 printf("Bad syntax for optional argument. No matching \"}\"\n");
412                 exit(1);
413             }
414             else if (*s == '}') {
415                 w[i++] = '\n';
416                 w[i] = '\0';
417                 words[nwords] = (char *)malloc((unsigned)(i+1));
418                 strcpy(words[nwords],w);
419                 nwords++;
420                 inopt1 = 0;
421                 inword = 0;
422             }
423         }
424         else if (inopt2) {
425             w[i++] = *s++;
426             if (*s == '[' || *s == '{' || *s == '}' || *s == '\n') {
427                 printf("Bad syntax for optional argument. No matching \"]\"\n");
428                 exit(1);
429             }
430             else if (*s == ']') {
431                 w[i++] = '\n';
432                 w[i] = '\0';
433                 words[nwords] = (char *)malloc((unsigned)(i+1));
434                 strcpy(words[nwords],w);
435                 nwords++;
436                 inopt2 = 0;
437                 inword = 0;
438             }
439         }
440         else if (inword) {
441             w[i++] = *s++;
442             if (*s == ' ' || *s == '\t' || *s == '\n') {
443                 w[i] = '\0';
444                 words[nwords] = (char *)malloc((unsigned)(i+1));
445                 strcpy(words[nwords],w);
446                 nwords++;
447                 inword = 0;
448             }
449         }
450         else {
451             s++; /* *s++; */
452             if (*s != ' ' && *s != '\t') {
453                 /* beginning of a word */
454                 i = 0;
455                 inword = 1;
456                 if (*s == '{') inopt1 = 1;
457                 if (*s == '[') inopt2 = 1;
458             }
459         }
460     }
461     return(nwords);
462 }
463
464 /* put the words of line "s" in "words" and return the number of words */
465
466 int ParseLine(char *s,char *words[])
467 {
468     char w[MAXNAM];
469     int nwords = 0;
470     int inword = 1;
471     int i = 0;
472     if(*s == ' ' || *s == '\t') inword = 0;
473     while (*s) 
474     {
475         if (inword) 
476         {
477             w[i++] = *s++;
478             if (*s == ' ' || *s == '\t' || *s == '\n') 
479             {
480                 w[i] = '\0';
481                 words[nwords] = (char *)malloc((unsigned)(i+1));
482                 strcpy(words[nwords],w);
483                 nwords++;
484                 inword = 0;
485             }
486         }
487         else 
488         {
489             s++; /* *s++; */
490             if (*s != ' ' && *s != '\t') 
491             {
492                 i = 0;
493                 inword = 1;
494             }
495         }
496     }
497
498     /* bug 7599 fixed: if the last line end with eof, not eol then one word missed */
499     if (i > 1) 
500     {
501         w[i] = '\0';
502         words[nwords] = (char *)malloc((unsigned)(i+1));
503         strcpy(words[nwords], w);
504         nwords++;
505     }
506
507     return(nwords);
508 }
509
510 /***********************************************************************
511 * Read a List description file
512 **************************************************************************/
513
514
515 void ReadListFile(char *listname,char *varlistname,IVAR ivar,int stack_position)
516 {
517     FILE *fin;
518     char filin[MAXNAM];
519     int nel;
520
521     sprintf(filin,"%s.list",listname);
522     fin = fopen(filin,"rt");
523     if (fin == 0)
524     {
525         printf("description file for list or tlist \"%s\" does not exist\n",
526             filin);
527         exit(1);
528     }
529     printf("reading description file for list or tlist \"%s\"\n", listname);
530
531     nel = 0;
532     while(ReadListElement(fin,varlistname,ivar,nel,stack_position))
533     {
534         nel++;
535     }
536
537     fclose(fin);
538 }
539
540 int ReadListElement(FILE *f,char *varlistname,IVAR iivar,int nel,int stack_position)
541 {
542     char s[MAXLINE];
543     char *words[MAXLINE];
544     int i = 0, nline = 0, nwords = 0, type = 0;
545     IVAR ivar = 0;
546     char str[MAXNAM];
547
548     strcpy(s, "");
549     nline = 0;
550     while (fgets(s, MAXLINE, f) != NULL)
551     {
552         removeEOL(s);
553         /* analyse of one line */
554         nline++;
555         switch (nline)
556         {
557         case 1:
558             break;
559         case 2:
560             /* SCILAB variable description */
561             nwords = ParseLine(s,words);
562             sprintf(str,"%s(%s)",words[0],varlistname);
563             ivar = GetVar(str,0);
564             i = ivar - 1;
565             variables[ivar-1]->stack_position =stack_position;
566             if (nwords == 1)
567             {
568                 printf("type missing for variable \"%s\"\n",words[0]);
569                 exit(1);
570             }
571             type = GetBasType(words[1]);
572             variables[i]->type = type;
573             variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1));
574             strcpy(variables[i]->list_name,varlistname);
575             variables[i]->list_el = nel+1;
576             switch (type)
577             {
578             case SCALAR:
579             case ANY:
580                 break;
581             case COLUMN:
582             case ROW:
583             case STRING:
584             case VECTOR:
585                 if (nwords != 3)
586                 {
587                     printf("bad type for variable \"%s\"\n",
588                         words[0]);
589                     exit(1);
590                 }
591                 if (isdigit(words[2][0]))
592                 {
593                     variables[i]->el[0] = GetVar(words[2],0);
594                     variables[i]->length = 1;
595                 }
596                 else
597                 {
598                     sprintf(str,"%s(%s)",words[2],varlistname);
599                     variables[i]->el[0] = GetVar(str,0);
600                     variables[i]->length = 1;
601                 }
602                 break;
603             case POLYNOM:
604             case MATRIX:
605             case BMATRIX:
606             case STRINGMAT:
607                 if (nwords != 4)
608                 {
609                     printf("bad type for variable \"%s\"\n",
610                         words[0]);
611                     exit(1);
612                 }
613                 if (isdigit(words[2][0]))
614                 {
615                     variables[i]->el[0] = GetVar(words[2],0);
616                     variables[i]->length = 1;
617                 }
618                 else
619                 {
620                     sprintf(str,"%s(%s)",words[2],varlistname);
621                     variables[i]->el[0] = GetVar(str,0);
622                     variables[i]->length = 1;
623                 }
624                 if (isdigit(words[3][0]))
625                 {
626                     variables[i]->el[1] = GetVar(words[3],0);
627                     variables[i]->length = 2;
628                 }
629                 else
630                 {
631                     sprintf(str,"%s(%s)",words[3],varlistname);
632                     variables[i]->el[1] = GetVar(str,0);
633                     variables[i]->length = 2;
634                 }
635                 break;
636             case IMATRIX:
637                 if (nwords != 5)
638                 {
639                     printf("bad type for variable \"%s\"\n",
640                         words[0]);
641                     exit(1);
642                 }
643                 if (isdigit(words[2][0]))
644                 {
645                     variables[i]->el[0] = GetVar(words[2],0);
646                     variables[i]->length = 1;
647                 }
648                 else
649                 {
650                     sprintf(str,"%s(%s)",words[2],varlistname);
651                     variables[i]->el[0] = GetVar(str,0);
652                     variables[i]->length = 1;
653                 }
654                 if (isdigit(words[3][0]))
655                 {
656                     variables[i]->el[1] = GetVar(words[3],0);
657                     variables[i]->length = 2;
658                 }
659                 else
660                 {
661                     sprintf(str,"%s(%s)",words[3],varlistname);
662                     variables[i]->el[1] = GetVar(str,0);
663                     variables[i]->length = 2;
664                 }
665                 sprintf(str,"%s(%s)",words[4],varlistname);
666                 variables[i]->el[2] = GetVar(str,0);
667                 variables[i]->length = 3;
668                 break;
669             case SPARSE:
670                 if (nwords != 6)
671                 {
672                     printf("bad type for variable \"%s\"\n",
673                         words[0]);
674                     exit(1);
675                 }
676                 if (isdigit(words[2][0]))
677                 {
678                     variables[i]->el[0] = GetVar(words[2],0);
679                     variables[i]->length = 1;
680                 }
681                 else
682                 {
683                     sprintf(str,"%s(%s)",words[2],varlistname);
684                     variables[i]->el[0] = GetVar(str,0);
685                     variables[i]->length = 1;
686                 }
687                 if (isdigit(words[3][0]))
688                 {
689                     variables[i]->el[1] = GetVar(words[3],0);
690                     variables[i]->length = 2;
691                 }
692                 else
693                 {
694                     sprintf(str,"%s(%s)",words[3],varlistname);
695                     variables[i]->el[1] = GetVar(str,0);
696                     variables[i]->length = 2;
697                 }
698                 if (isdigit(words[4][0]))
699                 {
700                     variables[i]->el[2] = GetVar(words[4],0);
701                     variables[i]->length = 3;
702                 }
703                 else
704                 {
705                     sprintf(str,"%s(%s)",words[4],varlistname);
706                     variables[i]->el[2] = GetVar(str,0);
707                     variables[i]->length = 3;
708                 }
709                 sprintf(str,"%s(%s)",words[5],varlistname);
710                 variables[i]->el[3] = GetVar(str,0);
711                 variables[i]->length = 4;
712                 break;
713             case WORK:
714             case SEQUENCE:
715             case EMPTY:
716             case LIST:
717             case TLIST:
718                 printf("variable \"%s\" cannot have type \"%s\"\n",
719                     words[0],SGetSciType(type));
720                 exit(1);
721             default:
722                 printf("variable \"%s\" has unknown type \"%s\"\n",
723                     words[0],SGetSciType(type));
724             }
725             break;
726         default:
727             /* end of description */
728             if (s[0] == '*')
729             {
730                 return(1);
731             }
732             else
733             {
734                 printf("bad description file for list or tlist \"%s\"\n",
735                     varlistname);
736                 exit(1);
737             }
738             break;
739         }
740         strcpy(s, "");
741     }
742     return(0);
743 }
744