4ca0079afe477d22ed723c567c0f3d472faaf478
[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         if (inword) {
475             w[i++] = *s++;
476             if (*s == ' ' || *s == '\t' || *s == '\n') {
477                 w[i] = '\0';
478                 words[nwords] = (char *)malloc((unsigned)(i+1));
479                 strcpy(words[nwords],w);
480                 nwords++;
481                 inword = 0;
482             }
483         }
484         else {
485             s++; /* *s++; */
486             if (*s != ' ' && *s != '\t') {
487                 i = 0;
488                 inword = 1;
489             }
490         }
491     }
492     return(nwords);
493 }
494
495 /***********************************************************************
496 * Read a List description file
497 **************************************************************************/
498
499
500 void ReadListFile(char *listname,char *varlistname,IVAR ivar,int stack_position)
501 {
502     FILE *fin;
503     char filin[MAXNAM];
504     int nel;
505
506     sprintf(filin,"%s.list",listname);
507     fin = fopen(filin,"rt");
508     if (fin == 0)
509     {
510         printf("description file for list or tlist \"%s\" does not exist\n",
511             filin);
512         exit(1);
513     }
514     printf("reading description file for list or tlist \"%s\"\n", listname);
515
516     nel = 0;
517     while(ReadListElement(fin,varlistname,ivar,nel,stack_position))
518     {
519         nel++;
520     }
521
522     fclose(fin);
523 }
524
525 int ReadListElement(FILE *f,char *varlistname,IVAR iivar,int nel,int stack_position)
526 {
527     char s[MAXLINE];
528     char *words[MAXLINE];
529     int i = 0, nline = 0, nwords = 0, type = 0;
530     IVAR ivar = 0;
531     char str[MAXNAM];
532
533     strcpy(s, "");
534     nline = 0;
535     while (fgets(s, MAXLINE, f) != NULL)
536     {
537         removeEOL(s);
538         /* analyse of one line */
539         nline++;
540         switch (nline)
541         {
542         case 1:
543             break;
544         case 2:
545             /* SCILAB variable description */
546             nwords = ParseLine(s,words);
547             sprintf(str,"%s(%s)",words[0],varlistname);
548             ivar = GetVar(str,0);
549             i = ivar - 1;
550             variables[ivar-1]->stack_position =stack_position;
551             if (nwords == 1)
552             {
553                 printf("type missing for variable \"%s\"\n",words[0]);
554                 exit(1);
555             }
556             type = GetBasType(words[1]);
557             variables[i]->type = type;
558             variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1));
559             strcpy(variables[i]->list_name,varlistname);
560             variables[i]->list_el = nel+1;
561             switch (type)
562             {
563             case SCALAR:
564             case ANY:
565                 break;
566             case COLUMN:
567             case ROW:
568             case STRING:
569             case VECTOR:
570                 if (nwords != 3)
571                 {
572                     printf("bad type for variable \"%s\"\n",
573                         words[0]);
574                     exit(1);
575                 }
576                 if (isdigit(words[2][0]))
577                 {
578                     variables[i]->el[0] = GetVar(words[2],0);
579                     variables[i]->length = 1;
580                 }
581                 else
582                 {
583                     sprintf(str,"%s(%s)",words[2],varlistname);
584                     variables[i]->el[0] = GetVar(str,0);
585                     variables[i]->length = 1;
586                 }
587                 break;
588             case POLYNOM:
589             case MATRIX:
590             case BMATRIX:
591             case STRINGMAT:
592                 if (nwords != 4)
593                 {
594                     printf("bad type for variable \"%s\"\n",
595                         words[0]);
596                     exit(1);
597                 }
598                 if (isdigit(words[2][0]))
599                 {
600                     variables[i]->el[0] = GetVar(words[2],0);
601                     variables[i]->length = 1;
602                 }
603                 else
604                 {
605                     sprintf(str,"%s(%s)",words[2],varlistname);
606                     variables[i]->el[0] = GetVar(str,0);
607                     variables[i]->length = 1;
608                 }
609                 if (isdigit(words[3][0]))
610                 {
611                     variables[i]->el[1] = GetVar(words[3],0);
612                     variables[i]->length = 2;
613                 }
614                 else
615                 {
616                     sprintf(str,"%s(%s)",words[3],varlistname);
617                     variables[i]->el[1] = GetVar(str,0);
618                     variables[i]->length = 2;
619                 }
620                 break;
621             case IMATRIX:
622                 if (nwords != 5)
623                 {
624                     printf("bad type for variable \"%s\"\n",
625                         words[0]);
626                     exit(1);
627                 }
628                 if (isdigit(words[2][0]))
629                 {
630                     variables[i]->el[0] = GetVar(words[2],0);
631                     variables[i]->length = 1;
632                 }
633                 else
634                 {
635                     sprintf(str,"%s(%s)",words[2],varlistname);
636                     variables[i]->el[0] = GetVar(str,0);
637                     variables[i]->length = 1;
638                 }
639                 if (isdigit(words[3][0]))
640                 {
641                     variables[i]->el[1] = GetVar(words[3],0);
642                     variables[i]->length = 2;
643                 }
644                 else
645                 {
646                     sprintf(str,"%s(%s)",words[3],varlistname);
647                     variables[i]->el[1] = GetVar(str,0);
648                     variables[i]->length = 2;
649                 }
650                 sprintf(str,"%s(%s)",words[4],varlistname);
651                 variables[i]->el[2] = GetVar(str,0);
652                 variables[i]->length = 3;
653                 break;
654             case SPARSE:
655                 if (nwords != 6)
656                 {
657                     printf("bad type for variable \"%s\"\n",
658                         words[0]);
659                     exit(1);
660                 }
661                 if (isdigit(words[2][0]))
662                 {
663                     variables[i]->el[0] = GetVar(words[2],0);
664                     variables[i]->length = 1;
665                 }
666                 else
667                 {
668                     sprintf(str,"%s(%s)",words[2],varlistname);
669                     variables[i]->el[0] = GetVar(str,0);
670                     variables[i]->length = 1;
671                 }
672                 if (isdigit(words[3][0]))
673                 {
674                     variables[i]->el[1] = GetVar(words[3],0);
675                     variables[i]->length = 2;
676                 }
677                 else
678                 {
679                     sprintf(str,"%s(%s)",words[3],varlistname);
680                     variables[i]->el[1] = GetVar(str,0);
681                     variables[i]->length = 2;
682                 }
683                 if (isdigit(words[4][0]))
684                 {
685                     variables[i]->el[2] = GetVar(words[4],0);
686                     variables[i]->length = 3;
687                 }
688                 else
689                 {
690                     sprintf(str,"%s(%s)",words[4],varlistname);
691                     variables[i]->el[2] = GetVar(str,0);
692                     variables[i]->length = 3;
693                 }
694                 sprintf(str,"%s(%s)",words[5],varlistname);
695                 variables[i]->el[3] = GetVar(str,0);
696                 variables[i]->length = 4;
697                 break;
698             case WORK:
699             case SEQUENCE:
700             case EMPTY:
701             case LIST:
702             case TLIST:
703                 printf("variable \"%s\" cannot have type \"%s\"\n",
704                     words[0],SGetSciType(type));
705                 exit(1);
706             default:
707                 printf("variable \"%s\" has unknown type \"%s\"\n",
708                     words[0],SGetSciType(type));
709             }
710             break;
711         default:
712             /* end of description */
713             if (s[0] == '*')
714             {
715                 return(1);
716             }
717             else
718             {
719                 printf("bad description file for list or tlist \"%s\"\n",
720                     varlistname);
721                 exit(1);
722             }
723             break;
724         }
725         strcpy(s, "");
726     }
727     return(0);
728 }
729