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