Many files cleaned
[scilab.git] / scilab / modules / core / src / c / intmacr2tree.c
1 /**************************************************/
2 /* intmacr2tree.c                                 */
3 /* Functions used for macr2tree() Scilab function */
4 /* Copyright INRIA                                */
5 /* V.C. - 2004                                    */
6 /**************************************************/
7 #include "MALLOC.h"
8
9 #include "intmacr2tree.h"
10 #include "sciprint.h"
11 #include "cvstr.h"
12 #include "localization.h"
13 #include "machine.h"
14
15 /* Table to store variable names */
16 static char varnames[isizt][nlgh+1];
17
18 /* Number of variables */
19 static int nbvars = 0;
20
21 /* Store stack index for last EOL */
22 static int last_eol_pos = 0;
23
24 /****************************************************************/
25 static int CreateRecursiveIndex2List(int *data,int *index2);
26 /****************************************************************
27  Function name: macr2tree
28 ****************************************************************/
29 int C2F(macr2tree) _PARAMS((char *fname,unsigned long fname_len))
30 {
31   /* Returned value parameters */
32   int m_pgrm_tlist = 1,n_pgrm_tlist = 6;
33   char *pgrm_tlist[] = {"program","name","outputs","inputs","statements","nblines"};
34   
35   int *stkdata = NULL; /* Pointeur to rhs arguments */
36   int *data = NULL; /* Macro integer vector (pointer to copy of rhs argument) */
37  
38   int il = 0,ils = 0,ile = 0,ilt = 0,codelength = 0;
39   
40   int i = 0,cod_ind = 0; /* Loop index */
41   int job1 = 1; /* Used when job passed as a pointer to a function */
42   
43   /* Number of lines */
44   int nblines = 1;
45
46   /* Name (character string used to store function/lhs/rhs names */
47   char **name = NULL;
48   int namelgth = 0;
49
50   /* Number of statements in macro */
51   int nbstat = 0;
52
53   /* Generic variables */
54   int one = 1;
55
56   /* Save Top */
57   int TopSave = 0;
58   
59   /* Save last code interpreted */
60   int cod_sav = 0;
61
62   /* Loop index */
63   int k = 0;
64
65   /* Used for statements list creation */
66   int sz = 0; /* Size */
67   int newinstr = 0; /* flag used to know if a new instruction has been created (1->TRUE) */
68
69   /* Verify number of RHS arguments */
70   CheckRhs(1,1);
71   
72   /* Verify number of LHS arguments */
73   CheckLhs(1,1);
74
75   /* Read all data */
76   stkdata = (int *) stk(*Lstk(Top));
77
78   if (stkdata[0] > 0) /* Not a reference to variable */
79     {
80                 Scierror(999,_("%s: input argument must be a named variable\n"),"acr2tree");
81       return 0;
82     }
83   else
84     {
85       stkdata = (int *) stk(stkdata[1]);
86     }
87
88   /* Verify good type for input: must be a compiled macro (type 13) */
89   if(stkdata[0] != 13)
90     {
91                 Scierror(999,_("%s: Wrong input type (must be a compiled macro)!\n"),"macr2tree");
92       return 0;
93     }
94
95   /* Memory allocation */
96   if((name=CALLOC(1,sizeof(char)))==NULL)
97     {
98                 Scierror(999,_("%s: No more memory.\n"),"macr2tree");
99       return 0;
100     }
101   if((name[0]=(char *)CALLOC(1,sizeof(char)*(nlgh+1)))==NULL)
102     {
103                 Scierror(999,_("%s: Out of code\n"),"macr2tree");
104       return 0;
105     }
106   (name[0])[nlgh]='\0';
107   
108   /* Get function name: variable name on top of idstk */
109   /* Must be done before writing anything on stack or else we have to save Top when entering this program */
110
111   CvNameL(idstk(1,Top),name[0],&job1,&namelgth);
112   (name[0])[namelgth]='\0';
113
114   /* Input variable is no more useful */
115   Top--;
116
117   /* Write 'program' tlist first element on stack */
118   str2sci(pgrm_tlist,m_pgrm_tlist,n_pgrm_tlist);
119  
120   /* Write function name on stack */
121   str2sci(name,one,one);
122  
123   ils=il+1; /* stkdata[ils] = number of outputs */
124
125   /* Read output parameters names */
126   for(i=0;i<stkdata[ils];i++)
127     {
128       CvNameL(&stkdata[ils+1+i*nsiz],name[0],&job1,&namelgth);
129       (name[0])[namelgth]='\0';
130       CreateVariableTList(name);
131     }
132   C2F(mklist)(&stkdata[ils]);
133
134   ile = ils+nsiz*stkdata[ils]+1; /* stkdata[ile] = number of outputs */
135
136   /* Read input parameters names */
137   for(i=0;i<stkdata[ile];i++)
138     {
139       CvNameL(&stkdata[ile+1+i*nsiz],name[0],&job1,&namelgth);
140       (name[0])[namelgth]='\0';
141       CreateVariableTList(name);
142     }
143   C2F(mklist)(&stkdata[ile]);
144
145   ilt=ile+nsiz*stkdata[ile]+1;
146
147   codelength=stkdata[ilt];
148
149   /* Make a copy variable passed as reference */
150   /* Memory allocation */
151   if((data=(int *)CALLOC(1,sizeof(int)*(codelength+ilt+1)))==NULL)
152   {
153           Scierror(999,_("%s: No more memory.\n"),"macr2tree");
154       return 0;
155     }
156   /* Copy */
157   for(k=0;k<(codelength+ilt+1);k++)
158     data[k]=stkdata[k];
159
160   /* List header */
161   /* Considering Top is pointing last occupied place */
162
163   /* Number of elements in list */
164   cod_ind = ilt + 1;
165   nbstat = complexity(data,&ilt,&codelength);
166
167   Top++; /* First free place */
168    
169   il = iadr(*Lstk(Top));
170   *istk(il) = 15;
171   *istk(il+1) = nbstat;
172   *istk(il+2) = 1;
173
174   *Lstk(Top+1) = sadr(il+3+nbstat);
175   
176   /* Error handling (S. Steer */
177   if (*Lstk(Top+1) >= *Lstk(Bot)) 
178   {
179           Scierror(17,_("%s : stack size exceeded (Use stacksize function to increase it).\n"));
180
181     /* Free memory */
182     FREE(name[0]);
183     name[0]=NULL;
184     FREE(name);
185     name=NULL;
186     FREE(data);
187     
188     return 0;
189   }
190
191   /* Fill list */
192   for(k=1;k<=nbstat;k++)
193     {
194       newinstr = 0;
195       TopSave=Top;
196       while(newinstr==0)
197         {
198           cod_sav=data[cod_ind];
199           GetInstruction(data,&cod_ind,&nblines,&newinstr);
200
201           /* Error handling (S. Steer) */
202           if (Err>0 || C2F(errgst).err1>0)
203             {
204               /* Free memory */
205               FREE(name[0]);
206               name[0]=NULL;
207               FREE(name);
208               name=NULL;
209               FREE(data);
210
211               return 0;
212             }
213           if(cod_sav==15 && data[cod_ind+1]==29) /* EOL as the last component of a column concatenation */
214             {
215               /* a = ['a'
216                  'b'
217                  ] */
218               Top--; /* EOL is erased */
219               last_eol_pos=-10; /* EOL position is erased */
220               newinstr=0; /* No new instruction created */
221               nbstat--; /* One statement deleted */
222             }
223           else if(cod_sav==15 && Top!=TopSave+1) /* Column catenation with EOL after semi-colon */
224             newinstr=0;
225           else if(cod_sav==15) /* If EOL is not after semi-colon in catenation, it is ignored */
226             last_eol_pos=-10;
227
228           cod_ind++;
229           if(cod_ind>codelength+ilt+1)
230           {
231                   Scierror(999,_("%s: Out of code\n"),"macr2tree");
232  
233               /* Free memory */
234               FREE(name[0]);
235               name[0]=NULL;
236               FREE(name);
237               name=NULL;
238               FREE(data);
239               
240               return 0;
241           }
242
243         }
244       if(TopSave!=Top-1) 
245           {
246                   Scierror(999,_("%s: wrong Top value %d instead of %d\n"),"macr2tree",Top,TopSave+1);
247
248
249         /* Free memory */
250         FREE(name[0]);
251         name[0]=NULL;
252         FREE(name);
253         name=NULL;
254         FREE(data);
255         
256         return 0;
257       }
258
259       sz = *Lstk(Top+1) - *Lstk(Top);
260
261       *istk(il+2+k) = *istk(il+1+k) + sz ;
262
263       Top--;
264       
265       *Lstk(Top+1) = *Lstk(Top+2);
266     }
267
268   /* Number of lines */
269   C2F(itosci)(&nblines,&one,&one);
270
271   C2F(mktlist)(&n_pgrm_tlist);
272
273   /* Free memory */
274   FREE(name[0]);
275   name[0]=NULL;
276   FREE(name);
277   name=NULL;
278   FREE(data);
279   
280   return 0;
281 }
282
283 /****************************************************************
284  Function name: CreateVariableTList
285 ****************************************************************/
286 static int CreateVariableTList(char **varname)
287 {
288   char *variable_tlist[] = {"variable","name"};
289   int m_variable_tlist = 1;
290   int n_variable_tlist = 2;
291
292   int one = 1;
293
294   /* Add 'variable' tlist items to stack */
295   str2sci(variable_tlist,m_variable_tlist,n_variable_tlist);
296
297   /* Add variable name to stack */
298   str2sci(varname,one,one);
299
300   /* Create tlist */
301   C2F(mktlist)(&n_variable_tlist);
302
303   /* Add variable to known variables table */
304   AddVar(varname[0]);
305
306   return 0;
307 }
308
309 /****************************************************************
310  Function name: CreateEOLList
311 ****************************************************************/
312 static int CreateEOLList(void)
313 {
314   char **eol;
315
316   int one = 1;
317
318   /* Memory allocation */
319   if((eol=CALLOC(1,sizeof(char)))==NULL)
320     {
321           Scierror(999,_("%s: No more memory.\n"),"CreateEOLList");
322       return 0;
323     }
324   if((eol[0]=(char *)CALLOC(1,sizeof(char)*(strlen("EOL")+1)))==NULL)
325     {
326       Scierror(999,_("%s: No more memory.\n"),"CreateEOLList");
327       return 0;
328     }
329   (eol[0])[3]='\0';
330   strncpy(eol[0],"EOL",3);
331
332   /* Add eol to stack */
333   str2sci(eol,one,one);
334
335   /* Create list */
336   C2F(mklist)(&one);
337
338   /* Free memory */
339   FREE(eol[0]);
340   eol[0]=NULL;
341   FREE(eol);
342   eol=NULL;
343
344   return 0;
345 }
346
347 /****************************************************************
348  Function name: AddVar
349 ****************************************************************/
350 static int AddVar(char *name)
351 {
352   if(IsDefinedVar(name)==-1)
353       {
354         strcpy(varnames[nbvars],name);
355         nbvars++;
356        }
357   return 0;
358 }
359
360 /****************************************************************
361  Function name: IsDefinedVar
362 ****************************************************************/
363 static int IsDefinedVar(char *name)
364 {
365   int index2 = -1;
366   int k;
367   int maxlgth;
368
369   for(k=0;k<isizt;k++)
370     {
371       if(strlen(name)>=strlen(varnames[k]))
372         {
373           maxlgth=(int)strlen(name);
374         }
375       else
376         {
377           maxlgth=(int)strlen(varnames[k]);
378         }
379       if(varnames[k][0]=='\0')
380         {
381           index2 = -1;
382           break;
383         } 
384       else if(!strncmp(name,varnames[k],maxlgth))
385         {
386           index2 = k;
387           break;
388         }
389     }
390   return index2;
391 }
392
393 /****************************************************************
394  Function name: GetInstruction
395 ****************************************************************/
396 static int GetInstruction(int *data,int *index2,int *nblines,int *addinstr)
397 {
398   int job1 = 1;
399
400   char **name;
401   int namelgth;
402   
403   *addinstr=0;
404
405   /* Memory allocation */
406   if((name=CALLOC(1,sizeof(char)))==NULL)
407     {
408                 Scierror(999,_("%s: No more memory.\n"),"GetInstruction");
409         return 0;
410     }
411   if((name[0]=(char *)CALLOC(1,sizeof(char)*(nlgh+1)))==NULL)
412     {
413       Scierror(999,_("%s: No more memory.\n"),"GetInstruction");
414       return 0;
415     }
416   (name[0])[nlgh]='\0';
417
418   switch(data[*index2]) {
419   case 0: /* Deleted operation */
420     /* This code is ignored */
421     *index2 += data[*index2+1]-1;;
422     break;
423   case 1: /* Stack put (Obsolete) */
424     CreateEqualTList("code1",data,index2);
425     *addinstr=1;
426     break;
427   case 2: /* Stack get */
428     /* Read name */
429     CvNameL(&data[*index2+1],name[0],&job1,&namelgth);
430     (name[0])[namelgth]='\0';
431     *index2 += nsiz;
432
433     if(data[*index2+2]==0) /* stack get (rhs=0) */
434       {
435         CreateVariableTList(name);
436         *index2 += 2;
437      }
438     else
439       {
440         if( (IsDefinedVar(name[0])>=0) || ( (data[*index2+1]==-3) && (data[*index2+2]!=0) ) )
441           {
442             /* Stack get for extraction from variable */
443             CreateVariableTList(name);
444             *index2 += 2;
445           }
446         else
447           {
448             /* Macro call */
449             data[*index2+1] = data[*index2+2];
450             if(data[*index2+3]==5 && data[*index2+4]==3) /* 3=code for extraction */
451               /* If next instruction is an extraction, it is ignored */
452               {
453                 data[*index2+2] = data[*index2+6]; /* Replace number of lhs for macro call by the one of extraction */
454                 CreateFuncallTList("macro",data,index2);
455                 *index2 += 4;
456               }
457             else
458               {
459                 data[*index2+2] = 1;
460                 CreateFuncallTList("macro",data,index2);
461                 *index2 += 4;
462               }
463           }
464       }
465     break;
466   case 3: /* String */
467     CreateCsteTList("string",data,index2);
468     break;
469   case 4: /* Empty matrix */
470     CreateCsteTList("emptymatrix",data,index2);
471     break;
472   case 5: /* Operations */
473     if(data[*index2+2]==0) 
474       {
475         *index2 +=3;
476         break;
477       }
478     CreateOperationTList(data,index2);
479     break;
480   case 6: /* Number */
481     CreateCsteTList("number",data,index2);
482     break;
483   case 7: /* 'for' control instruction */
484     GetControlInstruction(data,index2,nblines);
485     *addinstr=1;
486     break;
487   case 8: /* 'if-then-else' control instruction */
488     GetControlInstruction(data,index2,nblines);
489     *addinstr=1;
490     break;
491   case 9: /* 'while' control instruction */
492     GetControlInstruction(data,index2,nblines);
493     *addinstr=1;
494     break;
495   case 10: /* 'select-case' control instruction */
496     GetControlInstruction(data,index2,nblines);
497     *addinstr=1;
498     break;
499   case 11: /* 'try-catch' control instruction */
500     GetControlInstruction(data,index2,nblines);
501     *addinstr=1;
502     break;
503   case 12: /* pause */
504   case 13: /* break */
505   case 14: /* abort */
506     CreateFuncallTList("datacode",data,index2);
507     *addinstr=1;
508     break;
509   case 15: /* EOL */
510     (*nblines)++;
511     CreateEOLList();
512     last_eol_pos = Top;
513     *addinstr=1;
514     break;
515   case 16: /* Set line number */
516     /* This code is ignored */
517     (*index2)++;
518     break;
519   case 17: /* quit (Should never append) */
520     CreateFuncallTList("datacode",data,index2);
521     *addinstr=1;
522     break;
523   case 18: /* Mark named variable */
524     CreateEqualTList("code18",data,index2);
525     break;
526   case 19: /* Form recursive index2 list */
527     CreateRecursiveIndex2List(data,index2);
528     break;
529   case 20: /* exit */
530     CreateFuncallTList("datacode",data,index2);
531     *addinstr=1;
532     break;
533   case 21: /* Beginning of rhs */
534     /* This code is ignored */
535     /* Code also ignored in CreateEqualTList with fromwhat=="code1" */
536     break;
537   case 22: /* Set print mode (ignored ?) */
538     /* This code is ignored */
539     break;
540   case 23: /* Create variable from name */
541     CreateCsteTList("code23",data,index2);
542     break;
543   case 24: /* Create an object with type 0 */
544     Scierror(999,_("%s: No more memory.\n"),"GetInstruction",data[*index2]);
545     break;
546   case 25: /* Compute profiling data */
547  /* This code is ignored */
548     *index2 += 2;
549     break;
550   case 26: /* Vector of strings */
551     Scierror(999,_("%s: No more memory.\n"),"GetInstruction",data[*index2]);
552     break;
553   case 27: /* varfunptr */
554     Scierror(999,_("%s: No more memory.\n"),"GetInstruction",data[*index2]);
555     break;
556   case 28: /* continue */
557     CreateFuncallTList("datacode",data,index2);
558     *addinstr=1;
559     break;
560   case 29: /* Affectation */
561     CreateEqualTList("code29",data,index2);
562     *addinstr=1;
563     break;
564   case 30: /* Expression evaluation short circuiting */
565     /* This code is ignored */
566     *index2 += 2;
567     break;
568   case 31: /* comment */
569      CreateCommentTList(data,index2);
570     *addinstr=1;
571     break;
572
573   case 99: /* return */
574     CreateFuncallTList("datacode",data,index2);
575     *addinstr=1;
576     break;
577   default:
578     if(data[*index2]/100*100==data[*index2] && data[*index2]!=0)
579       {
580         /* funptr */
581         CreateFuncallTList("funptr",data,index2);
582       }
583     else
584       {
585         Scierror(999,_("GetInstruction: unknown code %d at index2 %d.\n"),data[*index2],*index2 );
586         return 0;
587       }
588     break;
589   }
590   
591   /* Free memory */
592   FREE(name[0]);
593   name[0]=NULL;
594   FREE(name);
595   name=NULL;
596
597   return 0;
598 }
599
600 /****************************************************************
601  Function name: GetControlInstruction
602 ****************************************************************/
603 static int GetControlInstruction(int *data,int *index2,int *nblines)
604 {
605   /* try-catch */
606   char *trycatch_tlist[] = {"trycatch","trystat","catchstat"};
607   int m_trycatch_tlist = 1;
608   int n_trycatch_tlist = 3;
609   
610   /* if */
611   char *if_tlist[] = {"ifthenelse","expression","then","elseifs","else"};
612   int m_if_tlist = 1;
613   int n_if_tlist = 5;
614
615   char *elseif_tlist[] = {"elseif","expression","then"};
616   int m_elseif_tlist = 1;
617   int n_elseif_tlist = 3;
618
619   /* while */
620   char *while_tlist[] = {"while","expression","statements"};
621   int m_while_tlist = 1;
622   int n_while_tlist = 3;
623
624   /* select */
625   char *select_tlist[] = {"selectcase","expression","cases","else"};
626   int m_select_tlist = 1;
627   int n_select_tlist = 4;
628
629   char *case_tlist[] = {"case","expression","then"};
630   int m_case_tlist = 1;
631   int n_case_tlist = 3;
632
633   /* for */
634   char *for_tlist[] = {"for","expression","statements"};
635   int m_for_tlist = 1;
636   int n_for_tlist = 3;
637   char **name;
638   int namelgth = 0;
639
640   int job1=1;
641   int index20,endindex2;
642   int codelgth;
643   int ncase = 0,icase = 0;
644   int TopSave = 0,TopSave_elseifsorcases=0;
645   int nbinstr = 0;
646   int nbelseifsorcases = 0;
647
648   int newinstr=0; /* Used to call GetInstruction with enough parameters */
649   
650   /* FOR */
651   if(data[*index2]==7)
652     {
653       /* Write list items */
654       str2sci(for_tlist,m_for_tlist,n_for_tlist);
655       (*index2)++;
656       codelgth = data[*index2];
657       endindex2 = *index2 + codelgth;
658       (*index2)++;
659
660       /* Get expression */
661       while(*index2<=endindex2)
662         {
663           GetInstruction(data,index2,nblines,&newinstr);
664           (*index2)++;
665         }
666      
667       codelgth = data[*index2];
668       (*index2)++;
669
670       /* Get loop variable */
671       /* Memory allocation */
672       if((name=CALLOC(1,sizeof(char)))==NULL)
673         {
674           Scierror(999,_("%s: No more memory.\n"),"GetControlInstruction");
675           return 0;
676         }
677       if((name[0]=(char *)CALLOC(1,sizeof(char)*(nlgh+1)))==NULL)
678         {
679           Scierror(999,_("%s: No more memory.\n"),"GetControlInstruction");
680           return 0;
681         }
682       (name[0])[nlgh]='\0';
683       
684       CvNameL(&data[*index2],name[0],&job1,&namelgth);
685       (name[0])[namelgth]='\0';
686       *index2 += nsiz;
687       /* Create a variable tlist with name */
688       CreateVariableTList(name);
689       
690       /* variable = expression */
691       CreateEqualTList("forexpr",data,index2);
692       endindex2 = *index2 + codelgth;
693     
694       /* Get all instructions */
695       TopSave = Top;
696       while(*index2<=endindex2)
697         {
698           /* Get all instructions */
699           GetInstruction(data,index2,nblines,&newinstr);
700           (*index2)++;
701         }
702       (*index2)--;
703       /* Make list of instructions */
704       nbinstr = Top - TopSave;
705       C2F(mklist)(&nbinstr);
706
707       /* Create FOR tlist */
708       C2F(mktlist)(&n_for_tlist);
709
710       /* Free memory */
711       FREE(name[0]);
712       name[0]=NULL;
713       FREE(name);
714       name=NULL;
715     }
716     /* TRYCATCH */
717   else if(data[*index2]==11)
718     {  
719       index20 = *index2;
720       
721       str2sci(trycatch_tlist,m_trycatch_tlist,n_trycatch_tlist);
722       
723       /* index2 now point to first code to use as an instruction code */
724       *index2 += 3;
725       
726       codelgth = data[index20+1];
727       endindex2 = *index2 + codelgth - 1;
728       
729       TopSave = Top;
730       /* Get try instructions */
731       while(*index2<=endindex2)
732         {
733           GetInstruction(data,index2,nblines,&newinstr);
734           (*index2)++;
735         }
736         
737       nbinstr = Top - TopSave;
738   
739       /* Create list of try instructions */
740       C2F(mklist)(&nbinstr);
741       last_eol_pos = -10; 
742       
743       codelgth = data[index20+2];
744       endindex2 = *index2 + codelgth - 1;
745       
746       TopSave = Top;
747       /* Get catch instructions */
748       while(*index2<=endindex2)
749         {
750           GetInstruction(data,index2,nblines,&newinstr);
751           (*index2)++;
752         }  
753       
754       nbinstr = Top - TopSave;
755   
756       /* Create list of catch instructions */
757       C2F(mklist)(&nbinstr);
758       
759      (*index2)--;
760       
761       /* Create trycatch tlist */
762       C2F(mktlist)(&n_trycatch_tlist);
763     }
764   /* IF - WHILE - SELECT */
765   else
766     {
767       index20 = *index2;
768       
769       /* if or while of Scilab version < 3 */
770       if( (data[*index2]==8 || data[*index2]==9) && data[*index2+1]>=0 )
771         {
772           /* This part will not be written */
773           /* No more used */
774           Scierror(999,_("%s: old version of if and while not yet implemented.\n"),"GetControlInstruction");
775           return 0;
776         }
777       else
778         {
779           ncase = data[index20+2]; /* Number of elseif + number of else = number of elseif + 1 */
780           
781           /* Write first tlist item (tlist fields) */
782           if(data[index20]==8)
783             {
784                str2sci(if_tlist,m_if_tlist,n_if_tlist);
785             }
786           else if(data[index20]==9)
787             {
788               str2sci(while_tlist,m_while_tlist,n_while_tlist);
789             }
790           else if(data[index20]==10)
791             {
792               str2sci(select_tlist,m_select_tlist,n_select_tlist);
793             }
794           
795           /* index2 now point to first code to use as an instruction code */
796           *index2 += 4;
797           
798           codelgth = data[index20+3];
799           endindex2 = *index2 + codelgth - 1;
800           
801           icase = ncase + 1;
802           
803           /* If control instruction is a select, I get expression */
804           if(data[index20]==10)
805             {
806               TopSave = Top;
807               while(*index2<=endindex2)
808                 {
809                   GetInstruction(data,index2,nblines,&newinstr);
810                   (*index2)++;
811                 }
812               /* Create a list for expression because can be expression+EOL */
813               nbinstr = Top - TopSave;
814               /* Create list of then instructions */
815               C2F(mklist)(&nbinstr);
816               last_eol_pos = -10; 
817             }
818           
819           
820           /* select: for all cases */
821           /* if: 1rst pass gives expression and then instructions */
822           /*     others passes give expression and then instructions for elseifs */
823           while(icase > 1)
824             {
825               icase = icase - 1;
826               
827               /* For a select: on first pass save position on stack to get the number of cases */
828               if(icase==ncase && data[index20]==10)
829                 TopSave_elseifsorcases = Top; /* Saved to know how many cases have been written */
830               
831               if(icase<ncase && data[index20]==8) /* For a if (if loop already executed one time): found a elseif */
832                 {
833                   /* Write tlist items */
834                   str2sci(elseif_tlist,m_elseif_tlist,n_elseif_tlist);
835                 }
836               
837               if(data[index20]==10) /* For a select: found a case */
838                 {
839                   /* Write tlist items */
840                   str2sci(case_tlist,m_case_tlist,n_case_tlist);
841                 }
842               
843               codelgth = data[*index2];
844               (*index2)++;
845               endindex2 = *index2 + codelgth - 1;
846               
847               /* Get expression */
848               while(*index2<=endindex2)
849                 {
850                   GetInstruction(data,index2,nblines,&newinstr);
851                   (*index2)++;
852                 }
853               last_eol_pos = -10;
854               codelgth = data[*index2];
855               (*index2)++;
856               endindex2 = *index2 + codelgth - 1;
857               
858               /* Get then instructions */
859               TopSave = Top; /* Position on stack saved to get the number of instructions */
860               while(*index2<=endindex2)
861                 {
862                   GetInstruction(data,index2,nblines,&newinstr);
863                   (*index2)++;
864                 }
865               nbinstr = Top - TopSave;
866               /* Create list of then instructions */
867               C2F(mklist)(&nbinstr);
868               
869               if(icase<ncase && data[index20]==8) /* IF: create elseif tlist */
870                 {
871                   /* Create elseif tlist */
872                   C2F(mktlist)(&n_elseif_tlist);
873                 }
874               
875               if(data[index20]==10) /* SELECT: create case tlist */
876                 {
877                   /* Create case tlist */
878                   C2F(mktlist)(&n_case_tlist);
879                 }
880               
881               /* IF: after first pass, save position on stack to get the number of elseifs */
882               if(icase==ncase && data[index20]==8)
883                 TopSave_elseifsorcases = Top; /* Saved to know how many elseifs have been written */
884             }
885           
886           nbelseifsorcases = Top - TopSave_elseifsorcases;
887           
888           /* IF: create list of elseifs */
889           /* SELECT: create list of cases */
890           if(data[index20]==8 || data[index20]==10)
891             C2F(mklist)(&nbelseifsorcases);
892           
893           /* else (if there is one) (not used for WHILE) */
894           (*index2)++;
895           codelgth = data[*index2];
896           (*index2)++;
897           
898           if(codelgth==0) /* When no else in IF or SELECT and when a WHILE */
899             (*index2)++;
900           
901           endindex2 = *index2 + codelgth - 1;
902           
903           /* Get else instructions */
904           TopSave = Top;
905           while(*index2<=endindex2)
906             {
907               GetInstruction(data,index2,nblines,&newinstr);
908               (*index2)++;
909             }
910           nbinstr = Top - TopSave;
911           /* Create list of else instructions */
912           if(data[index20]==8 || data[index20]==10)
913             C2F(mklist)(&nbinstr);
914           
915           (*index2)--; /* Index2 is decremented because is incremented when going back to intmacr2tree() */
916           
917           if(data[index20]==8)
918             {
919               /* Create if tlist */
920               C2F(mktlist)(&n_if_tlist);
921             }
922           else if(data[index20]==9)
923             {
924               /* Create while tlist */
925               C2F(mktlist)(&n_while_tlist);
926             }
927           else if(data[index20]==10)
928             {
929               /* Create select tlist */
930               C2F(mktlist)(&n_select_tlist);
931             }
932         }
933     }
934   return 0;
935 }
936
937 /****************************************************************
938  Function name: CreateCsteTList
939 ****************************************************************/
940 static int CreateCsteTList(char *type,int *data,int *index2)
941 {
942   char *cste_tlist[] = {"cste","value"};
943   int m_cste_tlist = 1;
944   int n_cste_tlist = 2;
945
946   /* Used to get endian */
947   int littlendian = 1;
948   char *endptr;
949
950   /* Used when type=="emptymatrix" */
951   double l_mat = 0;
952   int m_mat = 0;
953   int n_mat = 0;
954
955   /* Used when type=="string" */
956   char **str;
957   int *int_str;
958   int strlgth = 0;
959   int job1 = 1;
960   int one = 1;
961
962   /* Used when type=="number" */
963   double *value;
964   int *ivalue;
965   int i = 0; /* Loop index2 */
966
967   /* First item of returned list */
968   str2sci(cste_tlist,m_cste_tlist,n_cste_tlist);
969
970   /* Create data to write in field 'value' */
971   if(!strncmp(type,"emptymatrix",11))
972     {
973       C2F(dtosci)(&l_mat,&m_mat,&n_mat);
974     }
975   else if(!strncmp(type,"string",6))
976     {
977       (*index2)++;
978       strlgth = data[*index2];
979       
980       /* Memory allocation */
981       if((str=CALLOC(1,sizeof(char)))==NULL)
982         {
983           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
984           return 0;
985         }
986       if((str[0]=(char *)CALLOC(1,sizeof(char)*(strlgth+1)))==NULL)
987         {
988           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
989           return 0;
990         }
991       if((int_str=(int *)CALLOC(1,sizeof(int)*(strlgth+1)))==NULL)
992         {
993           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
994           return 0;
995         }
996       /* Fill int_str */
997       for(i=0;i<strlgth;i++)
998         {
999           *index2=*index2 + 1;
1000           int_str[i]=data[*index2];
1001         }
1002       CvStr(&strlgth,int_str,str[0],&job1,strlgth);
1003       (str[0])[strlgth]='\0';
1004       str2sci(str,one,one);
1005
1006       /* Free memory */
1007       FREE(str[0]);
1008       str[0]=NULL;
1009       FREE(str);
1010       str=NULL;
1011       FREE(int_str);
1012       int_str=NULL;
1013     }
1014
1015   else if(!strncmp(type,"code23",5))
1016     {
1017       strlgth=nlgh;
1018       /* Memory allocation */
1019       if((str=CALLOC(1,sizeof(char)))==NULL)
1020         {
1021           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
1022           return 0;
1023         }
1024       if((str[0]=(char *)CALLOC(1,sizeof(char)*(strlgth+1)))==NULL)
1025         {
1026           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
1027           return 0;
1028         }
1029
1030       /* Read name */
1031       CvNameL(&data[*index2+1],str[0],&job1,&strlgth);
1032       (str[0])[strlgth]='\0';
1033       *index2 += nsiz;
1034
1035       /* Write on stack */
1036       str2sci(str,one,one);
1037
1038       /* Free memory */
1039       FREE(str[0]);
1040       str[0]=NULL;
1041       FREE(str);
1042       str=NULL;
1043     }
1044   else if(!strncmp(type,"number",6))
1045     {
1046       /* Memory allocation */
1047       if((value=(double *)CALLOC(1,sizeof(double)))==NULL)
1048         {
1049           Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
1050           return 0;
1051         }
1052       ivalue = (int*) value;
1053       
1054       /* Get endian */
1055       endptr = (char *) &littlendian;
1056       littlendian = (int) *endptr;
1057
1058       /* Read values in data */
1059       if(littlendian==1)
1060         {
1061           *index2 = *index2 +1;
1062           *ivalue = data[*index2];
1063           *index2 = *index2 +1;
1064           *(ivalue+1) = data[*index2];
1065         }
1066       else
1067         {
1068           *index2 = *index2 + 1;
1069           *(ivalue+1) = data[*index2];
1070           *index2 = *index2 + 1;
1071           *ivalue = data[*index2];
1072         }
1073
1074       C2F(dtosci)(value,&one,&one);
1075       
1076       /* Free memory */
1077       FREE(value);
1078       value=NULL;
1079     }
1080   else /* Should never happen */
1081     {
1082           Scierror(999,_("%s: wrong type value.\n"),"CreateCsteTList");
1083       return 0;
1084     }
1085   
1086   /* Create returned list */
1087   C2F(mktlist)(&n_cste_tlist);
1088
1089   return 0;
1090 }
1091
1092 /****************************************************************
1093  Function name: CreateOperationTList
1094 ****************************************************************/
1095 static int CreateOperationTList(int *data,int *index2)
1096 {
1097   char *op_tlist[] = {"operation","operands","operator"};
1098   int m_op_tlist = 1;
1099   int n_op_tlist = 3;
1100
1101   /* Operators table */
1102   char *operators[]={"+","-","*",".*","*.",".*.","/","./","/.","./.",
1103                "\\",".\\","\\.",".\\.","^","==","<",">","<=",">=","~=",
1104                ":","rc","ins","ext","'","cc","|","&","~",".^",".'","cceol"};
1105   /* cceol: special operator for column concatenation followed by EOL (initialisation made on more than one line... */
1106
1107   char **operator;
1108   int max_op_lgth = 5; /* strlen("cceol") */
1109   
1110   int operators_num[32]={45,46,47,98,200,149,48,99,201,150,
1111                          49,100,202,151,62,50,59,60,109,110,119,
1112                          44,1,2,3,53,4,57,58,61,113,104};
1113
1114   int operator_num,operator_index2=-1,nb_operands,nb_lhs;
1115
1116   int k; /* Loop index2 */
1117
1118   int orig,dest; /* Used when copy objects */
1119
1120   int offset = 0;
1121
1122   int one = 1;
1123
1124   /* Memory allocation */
1125   if((operator=CALLOC(1,sizeof(char)))==NULL)
1126     {
1127           Scierror(999,_("%s: No more memory.\n"),"CreateOperationTList");
1128       return 0;
1129     }
1130   if((operator[0]=(char *)CALLOC(1,sizeof(char)*max_op_lgth+1))==NULL)
1131     {
1132       Scierror(999,_("%s: No more memory.\n"),"CreateOperationTList");
1133       return 0;
1134     }
1135   (operator[0])[max_op_lgth] = '\0';
1136
1137   /* Read useful data */
1138   (*index2)++; /* Pass index2 corresponding to 5 */
1139   operator_num = data[*index2];
1140   (*index2)++;
1141   nb_operands = data[*index2]; /* One or two */
1142   (*index2)++;
1143   nb_lhs = data[*index2]; /* Always one */
1144
1145   /* Write tlist items names */
1146   str2sci(op_tlist,m_op_tlist,n_op_tlist);
1147
1148   /* Search operator index2 */
1149   for(k=0;k<32;k++)
1150     {
1151     if(operators_num[k]==operator_num)                
1152         {
1153           operator_index2=k;
1154           break;
1155         }
1156     }
1157   if(operator_index2<0) {
1158           Scierror(999,_("%s: unknown operator %d.\n"),"CreateOperationTList",operator_num);
1159     return 0;
1160   }
1161
1162   /* Move all operands to next place in stack */
1163   /* Special case for column concatenation followed by a EOL */
1164   /*  Example: a=[1,2;
1165                   3,4] */
1166   if( (operator_index2==26) && (last_eol_pos==Top-2) )
1167     {
1168       /* Change operator */
1169       operator_index2 = 32;
1170       
1171       /* First operand is placed before EOL */
1172       orig = last_eol_pos - 1;
1173       dest = Top + 1;
1174       VCopyObj("CreateOperationTList",&orig,&dest,20L);
1175
1176       /* Second operand is placed after EOL */
1177       orig = last_eol_pos + 1;
1178       dest = Top + 1;
1179       VCopyObj("CreateOperationTList",&orig,&dest,20L);
1180       offset = 1;
1181     }
1182   else if(operator_index2==24) /* For extraction: variable is moved to be the first operand */
1183     {
1184       /* Move variable */
1185       orig = Top - 1;
1186       dest = Top + 1;
1187       VCopyObj("CreateOperationTList",&orig,&dest,20L);
1188
1189       /* Move all indices */
1190       for(k=nb_operands;k>1;k--)
1191         {
1192           orig = Top - nb_operands - 1;
1193           dest = Top + 1;
1194           VCopyObj("CreateOperationTList",&orig,&dest,20L);
1195         }
1196
1197     }
1198   else
1199     {
1200       for(k=nb_operands;k>0;k--)
1201         {
1202           orig = Top - nb_operands;
1203           dest = Top + 1;
1204           VCopyObj("CreateOperationTList",&orig,&dest,20L);
1205         }
1206     }
1207
1208   /* Create list of operands */
1209   C2F(mklist)(&nb_operands);
1210   
1211   /* Add operator to stack */
1212   strcpy(operator[0],operators[operator_index2]);
1213   (operator[0])[strlen(operators[operator_index2])]='\0';
1214   str2sci(operator,one,one);
1215
1216   /* Create operation tlist */
1217   C2F(mktlist)(&n_op_tlist);
1218
1219   /* Move resulting list to first free place in stack */
1220   orig = Top;
1221   dest = Top - nb_operands - offset;
1222   VCopyObj("CreateOperationTList",&orig,&dest,20L);
1223
1224   return 0;
1225 }
1226
1227 /****************************************************************
1228  Function name: CreateFuncallTList
1229 ****************************************************************/
1230 static int CreateFuncallTList(char *fromwhat,int *data,int *index2)
1231 {
1232   char *fun_tlist[] = {"funcall","rhs","name","lhsnb"};
1233   int m_fun_tlist = 1;
1234   int n_fun_tlist = 4;
1235
1236   /* Used when fromwhat=="funptr" */
1237   int interf_num,interf_index2,funptr;
1238   int job1 = 1,job2 = 2;
1239   int id[nsiz];
1240
1241   double nblhs = 0;
1242   int nbrhs = 0;
1243
1244   char **funname;
1245   int funnamelgth = 0;
1246
1247   int one = 1;
1248
1249   int orig,dest; /* Used when copy objects */
1250
1251   /* Used for empty matrix creation when rhsnb==0 (function called as a command) */
1252   double l_mat = 0;
1253   int m_mat = 0;
1254   int n_mat = 0;
1255
1256   /* Memory allocation */
1257   if((funname=CALLOC(1,sizeof(char)))==NULL)
1258     {
1259           Scierror(999,_("%s: No more memory.\n"),"CreateFuncallTList");
1260       return 0;
1261     }
1262   if((funname[0]=(char *)CALLOC(1,sizeof(char)*(nlgh+1)))==NULL)
1263     {
1264           Scierror(999,_("%s: No more memory.\n"),"CreateFuncallTList");
1265       return 0;
1266     }
1267   (funname[0])[nlgh]='\0';
1268
1269   if(!strncmp(fromwhat,"funptr",6))
1270     {
1271       interf_num = data[*index2];
1272       (*index2)++;
1273       nbrhs = data[*index2];
1274       (*index2)++;
1275       nblhs = data[*index2];
1276       (*index2)++;
1277       interf_index2 = data[*index2];
1278
1279       funptr = interf_num + interf_index2;
1280
1281       C2F(funtab)(id,&funptr,&job2,"NULL_NAME",0);
1282
1283       CvNameL(id,funname[0],&job1,&funnamelgth);
1284       (funname[0])[funnamelgth]='\0';
1285     }
1286   else if(!strncmp(fromwhat,"datacode",8))
1287     {
1288       if(data[*index2]==12)
1289         {
1290           strncpy(funname[0],"pause",5);
1291           funnamelgth = 5;
1292         }
1293       else if(data[*index2]==13)
1294         {
1295           strncpy(funname[0],"break",5);
1296           funnamelgth = 5;
1297         }
1298       else if(data[*index2]==14)
1299         {
1300           strncpy(funname[0],"abort",5);
1301           funnamelgth = 5;
1302         }
1303       else if(data[*index2]==17)
1304         {
1305           strncpy(funname[0],"quit",4);
1306           funnamelgth = 4;
1307         }
1308       else if(data[*index2]==20)
1309         {
1310           strncpy(funname[0],"exit",4);
1311           funnamelgth = 4;
1312         }
1313       else if(data[*index2]==28)
1314         {
1315           strncpy(funname[0],"continue",8);
1316           funnamelgth = 8;
1317         }
1318       else if(data[*index2]==99)
1319         {
1320           strncpy(funname[0],"return",6);
1321           funnamelgth = 6;
1322         }
1323     }
1324   else if(!strncmp(fromwhat,"macro",5))
1325     {
1326       CvNameL(&data[*index2-nsiz+1],funname[0],&job1,&funnamelgth);
1327       (funname[0])[funnamelgth]='\0';
1328
1329       (*index2)++;
1330       nbrhs = data[*index2];
1331       (*index2)++;
1332       nblhs = data[*index2];
1333     }
1334   else /* Should never happen */
1335     {
1336           Scierror(999,_("%s: wrong fromwhat value %s\n"),"CreateEqualTList",fromwhat);
1337       return 0;
1338     }
1339
1340   /* rhs==0 then function called as a command */
1341   /* In funcall tree, rhs=[] */
1342   if(nbrhs==0)
1343     {
1344       /* Create an empty matrix on stack */
1345       C2F(dtosci)(&l_mat,&m_mat,&n_mat);
1346     }
1347   else
1348     {
1349       /* rhs==-1 then function called with no rhs */
1350       /* In funcall tree, rhs=list() */
1351       if(nbrhs<0)
1352         nbrhs=0;
1353       /* Create rhs list */
1354       C2F(mklist)(&nbrhs);
1355    }
1356
1357   /* Add tlist items names to stack */
1358   str2sci(fun_tlist,m_fun_tlist,n_fun_tlist);
1359
1360   /* Copy rhs list */
1361   orig = Top - 1;
1362   dest = Top + 1;
1363   VCopyObj("CreateFuncallTList",&orig,&dest,18L);
1364
1365   /* Add funname to stack */
1366   str2sci(funname,one,one);
1367
1368   /* Add nblhs to stack */
1369   C2F(dtosci)(&nblhs,&one,&one);
1370
1371   /* Create 'funcall' tlist */
1372   C2F(mktlist)(&n_fun_tlist);
1373
1374   /* Copy tlist to first free place in stack */
1375   orig = Top;
1376   dest = Top - 1;
1377   VCopyObj("CreateFuncallTList",&orig,&dest,18L);
1378
1379   /* Free memory */
1380   FREE(funname[0]);
1381   funname[0]=NULL;
1382   FREE(funname);
1383   funname=NULL;
1384
1385   return 0;
1386 }
1387
1388 /****************************************************************
1389  Function name: CreateEqualTList
1390 ****************************************************************/
1391 static int CreateEqualTList(char *fromwhat,int *data,int *index2)
1392 {
1393   char *eq_tlist[] = {"equal","expression","lhs","endsymbol"};
1394   int m_eq_tlist = 1;
1395   int n_eq_tlist = 4;
1396
1397   int nblhs = 0,nbrhs = 0;
1398
1399   int k = 0,l = 0; /* Loop index2es */
1400
1401   int job1 = 1;
1402
1403   int orig,dest; /* Used when copy objects */
1404
1405   char **name;
1406   int namelgth = 0;
1407
1408   /* Used for lhs which are insertion operations */
1409   int index2es_pos;
1410   int nb_index2es = 0;
1411   char *op_tlist[] = {"operation","operands","operator"};
1412   int m_op_tlist = 1;
1413   int n_op_tlist = 3;
1414
1415   char **operator;
1416
1417   int one = 1;
1418
1419   char **endsymbol;
1420   int symbol = 0;
1421
1422   /* Memory allocation */
1423   if((name=CALLOC(1,sizeof(char)))==NULL)
1424     {
1425           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1426       return 0;
1427     }
1428   if((name[0]=(char *)CALLOC(1,sizeof(char)*(nlgh+1)))==NULL)
1429     {
1430           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1431       return 0;
1432     }
1433   (name[0])[nlgh] = '\0';
1434
1435   if((operator=CALLOC(1,sizeof(char)))==NULL)
1436     {
1437       Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1438       return 0;
1439     }
1440   if((operator[0]=(char *)CALLOC(1,sizeof(char)*4))==NULL)
1441     {
1442       Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1443       return 0;
1444     }
1445   strcpy(operator[0],"ins");
1446   (operator[0])[3] = '\0';
1447
1448   /* Add tlist items names to stack */
1449   str2sci(eq_tlist,m_eq_tlist,n_eq_tlist);
1450
1451   if(!strncmp(fromwhat,"code29",6))  /* A code 29 was found in data */
1452     {
1453       /* Copy expression */
1454       orig = Top - 1;
1455       dest = Top + 1;
1456       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1457
1458       index2es_pos = Top - 3;
1459       
1460       /* Create list of lhs */
1461       (*index2)++; /* Code 29 is passed */
1462       nblhs = data[*index2];
1463       (*index2)++;
1464       
1465       /* Symbol which ends the line: ; , or nothing */
1466       symbol=data[*index2];
1467       if(symbol==43) /* ; */
1468         {
1469           if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1470             {
1471               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1472               return 0;
1473             }
1474           if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*2))==NULL)
1475             {
1476               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1477               return 0;
1478             }
1479           strcpy(endsymbol[0],";");
1480           (endsymbol[0])[1] = '\0';
1481         }
1482       else if(symbol==52) /* , */
1483         {
1484           if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1485             {
1486               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1487               return 0;
1488             }
1489           if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*2))==NULL)
1490             {
1491               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1492               return 0;
1493             }
1494           strcpy(endsymbol[0],",");
1495           (endsymbol[0])[1] = '\0';
1496         }
1497       else /* Nothing */
1498         {
1499           if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1500             {
1501               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1502               return 0;
1503             }
1504           if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*1))==NULL)
1505             {
1506               Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1507               return 0;
1508             }
1509           (endsymbol[0])[0] = '\0';
1510         }
1511       for(k=0;k<nblhs;k++)
1512         {
1513           (*index2)++;
1514           CvNameL(&data[*index2],name[0],&job1,&namelgth);
1515           (name[0])[namelgth] = '\0';
1516           *index2 = *index2 + nsiz;
1517           nbrhs = data[*index2];
1518           nb_index2es = nbrhs + nb_index2es;
1519
1520           if(nbrhs==0) /* Variable affectation */
1521             {
1522               CreateVariableTList(name);
1523             }
1524           else /* Insertion */
1525             {
1526               /* Write tlist items names */
1527               str2sci(op_tlist,m_op_tlist,n_op_tlist);
1528               
1529               /* Name of variable where data will be inserted */
1530               CreateVariableTList(name);
1531               
1532               /* Index2es for insertion */
1533               for(l=0;l<nbrhs;l++)
1534                 {
1535                   orig = index2es_pos - nbrhs + l + 1;
1536                   dest = Top + 1;
1537                   VCopyObj("CreateEqualTList",&orig,&dest,16L);
1538                 }
1539               index2es_pos = index2es_pos - nbrhs;
1540               
1541               /* Create list of operands */
1542               nbrhs = nbrhs + 1;
1543               C2F(mklist)(&nbrhs);
1544               
1545               /* Add operator */
1546               str2sci(operator,one,one);
1547               
1548               /* Create operation tlist */
1549               C2F(mktlist)(&n_op_tlist);
1550             }
1551         }
1552       /* Reverse order of lhs */
1553       for(k=0;k<nblhs;k++)
1554         {
1555           orig = Top - 2 * k;
1556           dest = Top + 1;
1557           VCopyObj("CreateEqualTList",&orig,&dest,16L);
1558         }
1559       
1560       /* Create list of lhs */
1561       C2F(mklist)(&nblhs);
1562       
1563       /* Copy lhs list to first free place */
1564       orig = Top;
1565       dest = Top - nblhs;
1566       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1567
1568       /* Symbol */
1569       str2sci(endsymbol,one,one);
1570       
1571       /* Create equal tlist */
1572       C2F(mktlist)(&n_eq_tlist);
1573  
1574       /* Copy tlist to first free place */
1575       orig = Top;
1576       dest = Top - nb_index2es - 1;
1577       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1578     }
1579   else if(!strncmp(fromwhat,"code18",6)) /* A code 18 was found in data */
1580     {
1581       /* Copy expression */
1582       orig = Top - 1;
1583       dest = Top + 1;
1584       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1585
1586       (*index2)++;
1587       nblhs++;
1588       CvNameL(&data[*index2],name[0],&job1,&namelgth);
1589       (name[0])[namelgth]='\0';
1590       CreateVariableTList(name);
1591       *index2 = *index2 + nsiz;
1592       *index2 = *index2 - 1;
1593       
1594       /* Create list of lhs */
1595       C2F(mklist)(&nblhs);
1596
1597       /* Symbol */
1598       if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1599         {
1600           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1601           return 0;
1602         }
1603       if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*1))==NULL)
1604         {
1605           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1606           return 0;
1607         }
1608       (endsymbol[0])[0] = '\0';
1609       str2sci(endsymbol,one,one);
1610       
1611       /* Create equal tlist */
1612       C2F(mktlist)(&n_eq_tlist);
1613
1614       /* Copy equal tlist */
1615       orig = Top;
1616       dest = Top - 1;
1617       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1618    }
1619   else if(!strncmp(fromwhat,"code1",5)) /* A code 1 was found in data (should no more exist) */
1620     {
1621       /* Copy expression */
1622       orig = Top - 1;
1623       dest = Top + 1;
1624       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1625
1626       while(data[*index2]==1)
1627         {
1628           (*index2)++;
1629           nblhs++;
1630           CvNameL(&data[*index2],name[0],&job1,&namelgth);
1631           (name[0])[namelgth]='\0';
1632           CreateVariableTList(name);
1633           *index2 = *index2 + nsiz;
1634           (*index2)++; /* Code 22 (print mode) is ignored */
1635           (*index2)++; /* Code 99 is ignored */
1636         }
1637       /* Create list of lhs */
1638       C2F(mklist)(&nblhs);
1639
1640       /* Symbol */
1641       if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1642         {
1643           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1644           return 0;
1645         }
1646       if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*1))==NULL)
1647         {
1648           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1649           return 0;
1650         }
1651       (endsymbol[0])[0] = '\0';
1652       str2sci(endsymbol,one,one);
1653       
1654       /* Create equal tlist */
1655       C2F(mktlist)(&n_eq_tlist);
1656     }
1657   else if(!strncmp(fromwhat,"forexpr",7))
1658     {
1659       /* Copy expression */
1660       orig = Top - 2;
1661       dest = Top + 1;
1662       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1663
1664       /* Copy variable after tlist items */
1665       orig = Top - 2;
1666       dest = Top + 1;
1667       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1668
1669       nblhs = 1;
1670       /* Create list of lhs */
1671       C2F(mklist)(&nblhs);
1672
1673       /* Symbol */
1674       if((endsymbol=CALLOC(1,sizeof(char)))==NULL)
1675         {
1676           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1677           return 0;
1678         }
1679       if((endsymbol[0]=(char *)CALLOC(1,sizeof(char)*1))==NULL)
1680         {
1681           Scierror(999,_("%s: No more memory.\n"),"CreateEqualTList");
1682           return 0;
1683         }
1684       (endsymbol[0])[0] = '\0';
1685       str2sci(endsymbol,one,one);
1686       
1687       /* Create equal tlist */
1688       C2F(mktlist)(&n_eq_tlist);
1689
1690       /* Copy tlist to first free place */
1691       dest = Top - 2;
1692       orig = Top;
1693       VCopyObj("CreateEqualTList",&orig,&dest,16L);
1694     }
1695   else /* Should not happen */
1696     {
1697           Scierror(999,_("%s: wrong fromwhat value %s\n"),"CreateEqualTList",fromwhat);
1698       return 0;
1699     }
1700
1701   /* Free memory */
1702   FREE(name[0]);
1703   name[0]=NULL;
1704   FREE(name);
1705   name=NULL;
1706   FREE(operator[0]);
1707   operator[0]=NULL;
1708   FREE(operator);
1709   operator=NULL;
1710   FREE(endsymbol[0]);
1711   endsymbol[0]=NULL;
1712   FREE(endsymbol);
1713   endsymbol=0;
1714
1715   return 0;
1716 }
1717 /****************************************************************
1718  Function name: CreateCommentTList
1719 ****************************************************************/
1720 static int CreateCommentTList(int *data,int *index2)
1721 {
1722   char *fun_tlist[] = {"comment","text"};
1723   int m_fun_tlist = 1;
1724   int n_fun_tlist = 2;
1725
1726   int strlgth;
1727
1728   char *text=NULL;
1729   int job1 = 1;
1730
1731   int one = 1;
1732
1733    /* First item of returned list */
1734   str2sci(fun_tlist,m_fun_tlist,n_fun_tlist);
1735
1736   /* Create data to write in field 'text' */
1737   (*index2)++;
1738   strlgth = data[*index2];
1739   (*index2)++;   
1740   /* Memory allocation */
1741   if((text=(char *)CALLOC(1,sizeof(char)*(strlgth+1)))==NULL)
1742     {
1743       Scierror(999,_("%s: No more memory.\n"),"CreateCsteTList");
1744       return 0;
1745     }
1746   CvStr(&strlgth,&(data[*index2]),text,&job1,strlgth);
1747   text[strlgth]='\0';
1748   str2sci(&text,one,one);
1749   *index2 = *index2 + strlgth-1;
1750   /* Free memory */
1751   FREE(text);
1752   text=NULL;
1753
1754   C2F(mktlist)(&n_fun_tlist);
1755   return 0;
1756 }
1757
1758
1759
1760 /*
1761  * Function name: CreateRecursiveIndexList
1762  * Decription: 
1763  *  Create on Scilab stack a list for recursive insertion or extraction
1764  *  First list item is a matrix which contains number of row/column indexes
1765  * @param data pointer to compiled macro code
1766  * @param index index of current integer in data
1767  *
1768  * @return 0 if execution succeeds
1769  * @return not null if execution fails
1770  */
1771 static int CreateRecursiveIndex2List(int *data,int *index2)
1772 {
1773   int m,n;
1774
1775   /* Get infos in data */
1776   (*index2)++;
1777   n = data[*index2];
1778   (*index2)++;
1779   m = data[*index2];
1780
1781   if(m>1)
1782     {
1783       C2F(mklist)(&m);
1784     }
1785   if(n!=0)
1786     {
1787       C2F(mklist)(&n);
1788     }
1789
1790   return 0;
1791 }
1792
1793 /***********************************************************
1794  Copy an object in Scilab stack
1795
1796  fname: name of function from where VCopyObj was called
1797  orig: position of object to copy
1798  dest: position where object has to be copied
1799  fname_length: length of character string fname
1800 ***********************************************************/
1801 static int VCopyObj(char *fname,int *orig,int *dest,unsigned long fname_length)
1802 {
1803   C2F(vcopyobj)(fname,orig,dest,fname_length);
1804   Top = *dest;
1805   return 0;
1806 }
1807
1808 /****************************************************************
1809  Function name: complexity
1810 ****************************************************************/
1811 int complexity(int *data,int *index2,int *lgth)
1812 {
1813   int count = 0;
1814   
1815   int cur_ind = *index2+1;
1816
1817   int last_eol=0;
1818
1819   int nbop = 0; /* Number of value stored on stack */
1820
1821   while(cur_ind<=*lgth+*index2)
1822     {
1823       switch(data[cur_ind])
1824         {
1825         case 0: /* Deleted operation */
1826           cur_ind = cur_ind + data[cur_ind+1];
1827           break;
1828         case 1: /* Stack put (Obsolete) */
1829           cur_ind = cur_ind + nsiz + 1;
1830           count++;
1831           break;
1832         case 2: /* Stack get */
1833           cur_ind = cur_ind + nsiz + 3;
1834           nbop++;
1835           break;
1836         case 3: /* String */
1837           cur_ind = cur_ind + 2 + data[cur_ind+1];
1838           nbop++;
1839           break;
1840         case 4: /* Empty matrix */
1841           cur_ind++;
1842           nbop++;
1843           break;
1844         case 5: /* Operations */
1845           if( (data[cur_ind+1]==4) && (last_eol==nbop-2) ) /* rc with a EOL */
1846             {
1847               nbop--;
1848               count--;
1849             }
1850           nbop = nbop - data[cur_ind+2];
1851           cur_ind = cur_ind + 4;
1852           nbop++;
1853           break;
1854         case 6: /* Number */
1855           cur_ind = cur_ind + 3;
1856           nbop++;
1857           break;
1858         case 7: /* 'for' control instruction */
1859           cur_ind = cur_ind + data[cur_ind+1] + 2;
1860           cur_ind = cur_ind + 1 + nsiz + data[cur_ind];
1861           count++;
1862           break;
1863         case 8: /* 'if-then-else' control instruction */
1864           if(data[cur_ind+1]>0)
1865             {
1866               cur_ind = cur_ind + 2;
1867               cur_ind = cur_ind + 3 + data[cur_ind] + data[cur_ind+1] + data[cur_ind+2];
1868             }
1869           else
1870             {
1871               cur_ind = cur_ind - data[cur_ind+1];
1872             }
1873           count++;
1874           break;
1875         case 9: /* 'while' control instruction */
1876           if(data[cur_ind+1]>0)
1877             {
1878               cur_ind = cur_ind + 2;
1879               cur_ind = cur_ind + 3 + data[cur_ind] + data[cur_ind+1] + data[cur_ind+2];
1880             }
1881           else
1882             {
1883               cur_ind = cur_ind - data[cur_ind+1];
1884             }
1885           count++;
1886           break;
1887         case 10: /* 'select-case' control instruction */
1888           cur_ind = cur_ind + data[cur_ind+1];
1889           count++;
1890           break;
1891         case 11: /* 'try-catch' control instruction */
1892           cur_ind = cur_ind + data[cur_ind+1] + data[cur_ind+2] + 3;
1893           count++;
1894           break;
1895         case 12: /* pause */
1896           cur_ind++;
1897           count++;
1898           break;
1899         case 13: /* break */
1900           cur_ind++;
1901           count++;
1902           break;
1903         case 14: /* abort */
1904           cur_ind++;
1905           count++;
1906           break;
1907         case 15: /* EOL */
1908           cur_ind++;
1909           last_eol = nbop;
1910           nbop++;
1911           count++;
1912           break;
1913         case 16: /* Set line number */
1914           cur_ind = cur_ind + 2;
1915           break;
1916         case 17: /* quit (Should never append) */
1917           cur_ind++;
1918           count++;
1919           break;
1920         case 18: /* Mark named variable */
1921           cur_ind = cur_ind + 1 + nsiz;
1922           break;
1923         case 19: /* Form recursive index2 list */
1924           nbop = nbop - data[cur_ind+1] + 1;
1925           cur_ind = cur_ind + 3;
1926           break;
1927         case 20: /* exit */
1928           cur_ind++;
1929           count++;
1930           break;
1931         case 21: /* Beginning of rhs */
1932           cur_ind = cur_ind + 1;
1933           break;
1934         case 22: /* Set print mode (ignored ?) */
1935           cur_ind = cur_ind + 2;
1936           break;
1937         case 23: /* Create variable from name */
1938           cur_ind = cur_ind + 1 + nsiz;
1939           nbop++;
1940           break;
1941         case 24: /* Create an object with type 0 */
1942           cur_ind = cur_ind + 1;
1943           break;
1944         case 25: /* Compute profiling data */
1945           cur_ind = cur_ind + 3;
1946           break;
1947         case 26: /* Vector of strings */
1948           cur_ind = cur_ind + 5 + data[cur_ind+1]*data[cur_ind+2] + data[cur_ind+4+data[cur_ind+1]*data[cur_ind+2]] - 1;
1949           break;
1950         case 27: /* varfunptr ??? */
1951           cur_ind = cur_ind + 3 + nsiz;
1952           break;
1953         case 28: /* continue */
1954           cur_ind++;
1955           count++;
1956           break;
1957         case 29: /* Affectation */
1958           nbop = 0;
1959           cur_ind = cur_ind + 2 + (data[cur_ind+1])*(nsiz+1) + 1;
1960           count++;
1961           break;
1962         case 30: /* Expression evaluation short circuiting */
1963           /* This code is ignored */
1964           cur_ind = cur_ind + 3;
1965           break;
1966         case 31: /* comment */
1967           cur_ind = cur_ind + 2 + data[cur_ind+1];
1968           count++;
1969           break;
1970         case 99: /* return */
1971           cur_ind++;
1972           count++;
1973           break;
1974         default:
1975           if(data[cur_ind]/100*100==data[cur_ind])
1976             {
1977               cur_ind = cur_ind + 4;
1978             }
1979           else
1980             {
1981               sciprint(_("%s: wrong code %d.\n"),"Complexity",data[cur_ind]);
1982               return -1;
1983             }
1984           break;
1985         }
1986     }
1987   return count;
1988   
1989 }