Scilab [trunk]: scilab/modules/intersci/src/exe/check.c Source File

00001 #include <stdlib.h>
00002 
00003 #include "intersci-n.h"
00004 #include "check.h"
00005 
00006 
00007 
00008 CheckRhsTab CHECKTAB[] = {
00009   {DIMFOREXT,CheckDIMFOREXT},
00010   {COLUMN,CheckCOLUMN},
00011   {LIST,CheckLIST},
00012   {TLIST,CheckTLIST},
00013   {MATRIX,CheckMATRIX},
00014   {POLYNOM,CheckPOLYNOM},
00015   {ROW,CheckROW},
00016   {SCALAR,CheckSCALAR},
00017   {SEQUENCE,CheckSEQUENCE},
00018   {STRING,CheckSTRING},
00019   {WORK,CheckWORK},
00020   {EMPTY,CheckEMPTY},
00021   {ANY,CheckANY},
00022   {VECTOR,CheckVECTOR},
00023   {STRINGMAT,CheckSTRINGMAT},
00024   {SCIMPOINTER,CheckPOINTER},
00025   {IMATRIX,CheckIMATRIX},
00026   {SCISMPOINTER,CheckPOINTER},
00027   {SCILPOINTER,CheckPOINTER},
00028   {BMATRIX,CheckBMATRIX},
00029   {SCIBPOINTER,CheckPOINTER},
00030   {SCIOPOINTER,CheckPOINTER},
00031   {SPARSE,CheckSPARSE}
00032 };
00033 
00034 extern  int indent ; /* incremental counter for code indentation */
00035 extern  int pass;  /* flag for couting pass on code generation */
00036 
00037 static  char str1[MAXNAM];
00038 static  char str2[MAXNAM];
00039 
00040 /***********************************************
00041  * Matrix OK
00042  *   flag is used for optional variables 
00043  *   f(..... x=val) 
00044  ***********************************************/
00045 
00046 void CheckMATRIX(f,var,flag) 
00047      FILE *f;   VARPTR var ;int flag;
00048 {
00049   CheckCom(f,var,flag);
00051   CheckOptSquare(f,var,str1); 
00052   CheckOptDim(f,var,0);
00053   CheckOptDim(f,var,1);
00054 }
00055 
00058 void CheckCom(f,var,flag) 
00059      FILE *f;   VARPTR var ;int flag;
00060 {
00061   int i1 = var->stack_position - basfun->NewMaxOpt +1 ;
00062   if ( flag == 1 ) 
00063     sprintf(str2,"k");
00064   else
00065     sprintf(str2,"%d",i1);
00066   if (var->list_el ==0 )
00067     {
00069       sprintf(str1,"%d",i1);
00070     }
00071   else
00072     {
00073       sprintf(str1,"%de%d",i1,var->list_el);
00074     }
00075 }
00076 
00077 
00078 
00079 
00080 /***********************************************
00081  * STRING : OK
00082  ***********************************************/
00083   
00084 void CheckSTRING(f,var,flag) FILE *f;   VARPTR var ;int flag;
00085 {
00086   if (var->for_type != CHAR) 
00087     {
00088       printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
00089              SGetSciType(STRING),SGetForType(var->for_type),var->name);
00090       exit(1);
00091     }
00092 
00093   CheckCom(f,var,flag);
00094   CheckOptDim(f,var,0);
00095 }
00096 
00097 /***********************************************
00098  * Boolean matrix OK
00099  ***********************************************/
00100 
00101 
00102 void CheckBMATRIX(f,var,flag) 
00103      FILE *f;   VARPTR var ;int flag;
00104 {
00105   if (var->for_type != INT && var->for_type != BOOLEAN)
00106     {
00107       printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
00108              SGetSciType(var->type),SGetForType(var->for_type),var->name);
00109       exit(1);
00110     }
00111   var->for_type = BOOLEAN;
00112   CheckCom(f,var,flag);
00114   CheckOptSquare(f,var,str1); 
00115   CheckOptDim(f,var,0);
00116   CheckOptDim(f,var,1);
00117 }
00118 
00119 /***********************************************
00120  * Complex Matrix 
00121  ***********************************************/
00122 
00123 void CheckIMATRIX(f,var,flag) 
00124      FILE *f;   VARPTR var ;int flag;
00125 {
00126   int i1= var->stack_position;
00127   if ( flag == 1 ) 
00128     sprintf(str2,"k");
00129   else
00130     sprintf(str2,"%d",i1);
00131   if (var->list_el ==0 )
00132     sprintf(str1,"%d",i1);
00133   else
00134     sprintf(str1,"%de%d",i1,var->list_el);
00136   CheckOptSquare(f,var,str1); 
00137   CheckOptDim(f,var,0);
00138   CheckOptDim(f,var,1);
00139 }
00140 
00141 
00142 /***********************************************
00143  * Sparse Matrix 
00144  ***********************************************/
00145 
00146 void CheckSPARSE(f,var,flag) 
00147      FILE *f;   VARPTR var ;int flag;
00148 {
00149   int i1= var->stack_position;
00150   if ( flag == 1 ) 
00151     sprintf(str2,"k");
00152   else
00153     sprintf(str2,"%d",i1);
00154   if (var->list_el ==0 )
00155     {
00156       sprintf(str1,"%d",i1);
00157     }
00158   else
00159     {
00160       sprintf(str1,"%de%d",i1,var->list_el);
00161     }
00163   CheckOptSquare(f,var,str1); 
00164   CheckOptDim(f,var,0);
00165   CheckOptDim(f,var,1);
00166 }
00167 
00168 
00169 /***********************************************
00170  * Stringmat 
00171  ***********************************************/
00172 
00173 void CheckSTRINGMAT(f,var,flag) FILE *f;   VARPTR var ;int flag;
00174 {
00175   int i1= var->stack_position;
00176   if (var->list_el ==0 )
00177     {
00178       sprintf(str1,"%d",i1);
00179     }
00180   else
00181     {
00182       sprintf(str1,"%de%d",i1,var->list_el);
00183     }
00184   /* square matrix */
00185   CheckOptSquare(f,var,str1); 
00186   CheckOptDim(f,var,0);
00187   CheckOptDim(f,var,1);
00188 }
00189 
00190 /***********************************************
00191  * Row 
00192  ***********************************************/
00193 
00194 void CheckROW(f,var,flag) FILE *f;   VARPTR var ;int flag;
00195 {
00196   int i1= var->stack_position;
00197   CheckCom(f,var,flag);
00198   CheckOptDim(f,var,0);
00199   Fprintf(f,indent,"CheckRow(%d,m%d,n%d);\n",i1,i1,i1);
00200   Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
00201   AddDeclare1(DEC_INT,"mn%d",i1);
00202 }
00203 
00204 
00205 /***********************************************
00206  * Column 
00207  ***********************************************/
00208 
00209 void CheckCOLUMN(f,var,flag) FILE *f;   VARPTR var ;int flag;
00210 {
00211   int i1= var->stack_position;
00212   CheckCom(f,var,flag);
00213   CheckOptDim(f,var,0);
00214   Fprintf(f,indent,"CheckColumn(%d,m%d,n%d);\n",i1,i1,i1);
00215   Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
00216   AddDeclare1(DEC_INT,"mn%d",i1);
00217 }
00218 
00219 /***********************************************
00220  * Vector 
00221  ***********************************************/
00222 
00223 void CheckVECTOR(f,var,flag) FILE *f;   VARPTR var ;int flag;
00224 {
00225   int i1= var->stack_position;
00226   CheckCom(f,var,flag);
00227   CheckOptDim(f,var,0);
00228   Fprintf(f,indent,"CheckVector(%d,m%d,n%d);\n",i1,i1,i1);
00229   Fprintf(f,indent,"mn%d=m%d*n%d;\n",i1,i1,i1);
00230   AddDeclare1(DEC_INT,"mn%d",i1);
00231 }
00232 
00233 /***********************************************
00234  * Polynom 
00235  ***********************************************/
00236 
00237 void CheckPOLYNOM(f,var,flag) FILE *f;   VARPTR var ;int flag;
00238 {
00239   int i1= var->stack_position;
00240   if ( flag == 1 ) 
00241     sprintf(str2,"k");
00242   else
00243     sprintf(str2,"%d",i1);
00244   if (var->list_el ==0 )
00245     {
00246       sprintf(str1,"%d",i1);
00247     }
00248   else
00249     {
00250       sprintf(str1,"%de%d",i1,var->list_el);
00251     }
00252   CheckOptDim(f,var,0);
00253 }
00254 
00255 /***********************************************
00256  * Scalar 
00257  ***********************************************/
00258 
00259 void CheckSCALAR(f,var,flag) FILE *f;   VARPTR var ;int flag;
00260 {
00261   int i1= var->stack_position;
00262   CheckCom(f,var,flag);
00263   CheckOptDim(f,var,0);
00264   Fprintf(f,indent,"CheckScalar(%d,m%d,n%d);\n",i1,i1,i1);
00265 }
00266 
00267 /***********************************************
00268  * Pointers 
00269  ***********************************************/
00270 
00271 void CheckPOINTER(f,var,flag) 
00272      FILE *f;   VARPTR var ;int flag;
00273 {
00274   int i1= var->stack_position;
00275   if ( flag == 1 ) 
00276     sprintf(str2,"k");
00277   else
00278     sprintf(str2,"%d",i1);
00279   sprintf(str1,"%d",i1);
00280   if (var->list_el ==0 )
00281     {
00282       sprintf(str1,"%d",i1);
00283     }
00284   else
00285     {
00286       fprintf(stderr,"Wrong type opointer inside a list \n");
00287       exit(1);
00288     }
00289   AddDeclare1(DEC_INT,"lr%s",str1);
00290 }
00291 
00292 
00293 void CheckANY(f,var,flag) FILE *f;   VARPTR var ;int flag;{
00294   fprintf(stderr,"Wrong type in Check function \n");
00295   exit(1);
00296 }
00297 
00298 void CheckLIST(f,var,flag) FILE *f;   VARPTR var ;int flag;{
00299   fprintf(stderr,"Wrong type in Check function \n");
00300   exit(1);
00301 }
00302 
00303 void CheckTLIST(f,var,flag) FILE *f;   VARPTR var ;int flag;{
00304   fprintf(stderr,"Wrong type in Check function \n");
00305   exit(1);
00306 }
00307 
00308 void CheckSEQUENCE(f,var,flag) FILE *f;   VARPTR var ;int flag;
00309 {  
00310   fprintf(stderr,"Wrong type in Check function \n");
00311   exit(1);
00312 }
00313 
00314 void CheckEMPTY(f,var,flag)  FILE *f;   VARPTR var ;int flag;
00315 {  
00316   fprintf(stderr,"Wrong type in Check function \n");
00317   exit(1);
00318 }
00319 
00320 void CheckWORK(f,var,flag)  FILE *f;   VARPTR var ;int flag;
00321 {  
00322   fprintf(stderr,"Wrong type in Check function \n");
00323   exit(1);
00324 }
00325 
00326 
00327 void CheckDIMFOREXT(f,var,flag)  FILE *f;   VARPTR var ;int flag;
00328 {  
00329   fprintf(stderr,"Wrong type in Check function \n");
00330   exit(1);
00331 }
00332 
00333 
00334 void CheckOptDim(f,var,nel)
00335      FILE *f;
00336      int nel;
00337      VARPTR var;
00338 {
00339   if (var->el[nel]-1>=0) {
00340   VARPTR var1 = variables[var->el[nel]-1];
00341   if ( var1->nfor_name == 0) 
00342     {
00343       fprintf(stderr,"Pb with element number %d [%s] of variable %s\n",
00344               nel+1, var1->name, var->name);
00345       return;
00346     }
00347   if (isdigit(var1->name[0]) != 0) 
00348     {
00349       /* the dimension of the variable is a constant integer */
00350       if ( strcmp(var1->for_name[0],var1->name) != 0) 
00351         {
00352           Fprintf(f,indent,"CheckOneDim(opts[%d].position,%d,%s,%s);\n",
00353                   var->stack_position - basfun->NewMaxOpt +1 ,
00354                   nel+1,
00355                   var1->for_name[0],var1->name);
00356         }
00357     }
00358   }
00359 }
00360 
00361 
00362 
00363 void CheckOptSquare(FILE *f, VARPTR var, char *str1_)
00364 {
00365   /* XXXXX cas liste ? */
00366   if (var->el[0] == var->el[1]) 
00367     {
00368       Fprintf(f,indent,"CheckSquare(opts[%d].position,opts[%s].m,opts[%s].n);\n",
00369               var->stack_position - basfun->NewMaxOpt +1 ,
00370               str1_,str1_);
00371     }
00372 }
00373