scilab » modules » intersci » src » exe

intersci.c File Reference

#include "intersci.h"
#include <varargs.h>

Include dependency graph for intersci.c:

Go to the source code of this file.

Data Structures

struct  btype
struct  ftype
struct  Declare

Defines

#define MAXBUF   4096

Functions

char * getenv ()
int main (unsigned int argc, char **argv)
void ISCIReadFile (char *file)
void WriteMain (FILE *f, char *file)
void WriteAddInter (char *file)
void Copyright ()
int ReadFunction (FILE *f)
int ParseScilabLine (char *s, words)
int ParseLine (char *s, words)
void ReadListFile (char *listname, char *varlistname, IVAR ivar)
int ReadListElement (FILE *f, char *varlistname, IVAR iivar, int nel)
IVAR GetVar (char *name, int p)
IVAR GetExistVar (char *name)
int CreatePredefVar (char *name)
IVAR GetOutVar (char *name)
IVAR GetExistOutVar ()
void AddForName (IVAR ivar, char *name)
void AddForName1 (IVAR ivar, char *name)
void ForNameClean ()
void ChangeForName (IVAR ivar, char *name)
int GetBasType (char *sname)
char * SGetSciType (int type)
int GetForType (char *type)
char * SGetForType (int type)
void WriteMainHeader (FILE *f, char *fname)
void WriteHeader (FILE *f, char *fname0, char *fname)
void WriteFunctionCode (FILE *f)
void WriteInfoCode (FILE *f)
void WriteArgCheck (FILE *f, int i)
void OptvarGetSize (char *optvar, char *size, char *data)
void Check (FILE *f, char *str, VARPTR var, int i1, int nel)
void WriteCrossCheck (FILE *f)
void WriteEqualCheck (FILE *f)
void WriteFortranCall (FILE *f)
void WriteCallConvertion (FILE *f, IVAR ivar, char *farg, char *barg, char *call)
void WriteCallRest (FILE *f, IVAR ivar, int farg, char *call)
void WriteCallRestCheck (FILE *f, var, int farg, char *name, int iel, int flag)
void WriteOutput (FILE *f)
void WriteVariableOutput (FILE *f, VARPTR var, int barg, int farg, int convert, int insidelist, int nel)
void WriteExternalVariableOutput (FILE *f, VARPTR var, int farg, int insidelist, int nel)
void WriteListAnalysis (FILE *f, int i)
void WriteVariable (FILE *f, VARPTR var, IVAR ivar, int insidelist, nel)
int GetNumberInScilabCall (int ivar)
int GetNumberInFortranCall (int ivar)
char * Forname2Int (char *str)
void GenFundef (char *file, int interf)
void InitDeclare ()
void ResetDeclare ()
int CheckDeclare (int type, char *declaration)
void AddDeclare (int type, char *declaration)
void WriteDeclaration (FILE *f)
void Fprintf (va_alist)
void white (FILE *f, int ind)
void FCprintf (va_alist)

Variables

static char buf [1024]
static int icre = 1
static int indent = 0
static int pass = 0
static struct btype SType []
static struct ftype FType []
char unknown [] = "ukn"
static struct Declare Init []
char sbuf [MAXBUF]

Define Documentation

#define MAXBUF   4096

Definition at line 3303 of file intersci.c.

Function Documentation

void AddDeclare ( int  type,
char *  declaration 
)

Definition at line 3237 of file intersci.c.

References CheckDeclare(), Declare::decls, Init, j, malloc(), Declare::ndecls, and realloc().

03240 {
03241   int j = 0;
03242   if ( CheckDeclare(type,declaration)== 1) return ;
03243   while ( Init[j].type != -1) 
03244     {
03245       if ( Init[j].type == type ) 
03246         {
03247           if ( Init[j].decls != (char **) 0) 
03248             {
03249               (Init[j].ndecls)++;
03250               Init[j].decls =  (char **) realloc((char *) Init[j].decls, (unsigned) (Init[j].ndecls ) *sizeof(char *));
03251             }
03252           else 
03253             {
03254               (Init[j].ndecls)++;
03255               Init[j].decls = (char **) malloc ( (unsigned) (Init[j].ndecls ) *sizeof(char *));
03256             }
03257           if ( Init[j].decls == ( char **) 0) 
03258             {
03259               fprintf(stderr,"No more space\n");
03260               exit(1);
03261             }
03262           Init[j].decls[Init[j].ndecls-1]=(char*) malloc((unsigned) (strlen(declaration)+1)*sizeof(char));
03263           if (    Init[j].decls[Init[j].ndecls-1] == ( char *) 0) 
03264             {
03265               fprintf(stderr,"No more space\n");
03266               exit(1);
03267             }
03268           strcpy(   Init[j].decls[Init[j].ndecls-1], declaration );
03269         }
03270       j++;
03271     }
03272 }

Here is the call graph for this function:

void AddForName ( IVAR  ivar,
char*  name 
)

Definition at line 991 of file intersci.c.

References l, malloc(), MAXARG, var, and variables.

Referenced by ReadFunction(), ReadListElement(), and WriteArgCheck().

00994 {
00995   VARPTR var;
00996   int l;
00997   var = variables[ivar-1];
00998   l = var->nfor_name;
00999   if (l == MAXARG) {
01000     printf("too many \"for_name\" for variable \"%s\"\n",var->name);
01001     printf("  augment constant \"MAXARG\" and recompile intersci\n");
01002     exit(1);
01003   }
01004   var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
01005   strcpy(var->for_name[l],name);
01006   var->nfor_name = l + 1;
01007 }

Here is the call graph for this function:

Here is the caller graph for this function:

void AddForName1 ( IVAR  ivar,
char*  name 
)

Definition at line 1009 of file intersci.c.

References l, malloc(), MAXARG, pass, var, and variables.

Referenced by Check(), CreSTRINGMAT(), ForCOLUMN(), ForIMATRIX(), ForMATRIX(), ForPOLYNOM(), ForROW(), ForSCALAR(), ForSPARSE(), ForSTRING(), ForVECTOR(), WriteArgCheck(), WriteCallRest(), WriteCallRestCheck(), and WriteListAnalysis().

01012 {
01013   VARPTR var;
01014   int l;
01015   var = variables[ivar-1];
01016   l = var->nfor_name;
01017   if ( pass == 0 && var->kp_state == -1 ) 
01018     {
01019       var->kp_state = var->nfor_name ;
01020     }
01021   if (l == MAXARG) {
01022     printf("too many \"for_name\" for variable \"%s\"\n",var->name);
01023     printf("  augment constant \"MAXARG\" and recompile intersci\n");
01024     exit(1);
01025   }
01026   var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
01027   strcpy(var->for_name[l],name);
01028   var->nfor_name = l + 1;
01029 }

Here is the call graph for this function:

Here is the caller graph for this function:

void ChangeForName ( IVAR  ivar,
char*  name 
)

Definition at line 1044 of file intersci.c.

References l, malloc(), var, and variables.

Referenced by WriteCallConvertion().

01047 {
01048   VARPTR var;
01049   int l;
01050   var = variables[ivar-1];
01051   l = var->nfor_name;
01052   var->for_name[0] = (char *)malloc((unsigned)(strlen(name) + 1));
01053   strcpy(var->for_name[0],name);
01054   /* useful ??? */
01055   if (l == 0) var->nfor_name = 1;
01056 }

Here is the call graph for this function:

Here is the caller graph for this function:

void Check ( FILE *  f,
char *  str,
VARPTR  var,
int  i1,
int  nel 
)

Definition at line 1609 of file intersci.c.

References AddDeclare(), AddForName1(), Check, DEC_LOGICAL, Fprintf(), indent, MAXNAM, var::name, str1, var, and variables.

01614 {
01615   char str1[MAXNAM];
01616   strcpy(str1,variables[var->el[nel]-1]->name);
01617   if (isdigit(str1[0]) != 0) 
01618     {
01619       /* the dimension of the variable is a constant integer */
01620       if ( strcmp(str,str1) != 0) 
01621         {
01622           AddDeclare(DEC_LOGICAL,"checkval");
01623           Fprintf(f,indent,"if(.not.checkval(fname,%s,%s)) return\n",str,str1);
01624         }
01625     }
01626   AddForName1(var->el[nel],str);
01627 }

Here is the call graph for this function:

int CheckDeclare ( int  type,
char *  declaration 
)

Definition at line 3215 of file intersci.c.

References i, Init, j, and Declare::ndecls.

03218 {
03219   int j = 0;
03220   while ( Init[j].type != -1) 
03221     {
03222       if ( Init[j].type == type ) 
03223         {
03224           int i;
03225           for ( i = 0 ; i < Init[j].ndecls ; i++ ) 
03226             {
03227               if ( strcmp(declaration,Init[j].decls[i])==0) 
03228                 return(1);
03229             }
03230           return(0);
03231         }
03232       j++;
03233     }
03234   return(0);
03235 }

void Copyright (  ) 

Definition at line 162 of file intersci.c.

References DATE, and VERSION.

00163 {
00164   printf("\nINTERSCI Version %s (%s)\n",VERSION,DATE);
00165   printf("    Copyright (C) INRIA All rights reserved\n\n");
00166 }

int CreatePredefVar ( char *  name  ) 

Definition at line 915 of file intersci.c.

References GetVar(), num, PREDEF, var, and variables.

00917 {
00918   VARPTR var;
00919   if (strcmp(name,"err")  == 0 
00920       || strcmp(name,"rhs") == 0 
00921       || strcmp(name,"lhs") == 0 
00922       || strcmp(name,"fname") == 0)
00923     {
00924       int num ;
00925       num=GetVar(name,1);
00926       var = variables[num-1];
00927       var->for_type = PREDEF;
00928       return(num);
00929     }
00930   return(-1);
00931 }

Here is the call graph for this function:

void FCprintf ( va_alist   ) 

Definition at line 3357 of file intersci.c.

03359 {
03360   va_list ap;
03361 #ifdef __STDC__
03362   va_start(ap,format);
03363 #else
03364   FILE *f;
03365   char *format;
03366   va_start(ap);
03367   f = va_arg(ap, FILE *);
03368   format = va_arg(ap, char *);
03369 #endif
03370   vfprintf(f,format,ap);
03371   va_end(ap);
03372 }

char* Forname2Int ( char *  str  ) 

Definition at line 3118 of file intersci.c.

References l, malloc(), and p.

03120 {
03121   int l;
03122   char *p;
03123   if (str == (char *) 0) 
03124     {
03125       printf("Error in Forname2Int  \n");
03126       printf("Maybe an internal variable has a dimension\n");
03127       printf("which can't be evaluated\n");
03128       abort();
03129       return(unknown);
03130     }
03131   if (strncmp(str,"stk",3) == 0) {
03132     l = strlen(str);
03133     p = (char *)malloc((unsigned)(l + 6));
03134     sprintf(p,"int(%s)",str);
03135     return p;
03136   }
03137   else return str;
03138 }

Here is the call graph for this function:

void ForNameClean (  ) 

Definition at line 1031 of file intersci.c.

References i, nVariable, var, and variables.

Referenced by Generate(), and ISCIReadFile().

01032 {
01033   VARPTR var;
01034   int i;
01035   for (i = 0; i < nVariable; i++) {
01036     var = variables[i];
01037     if ( var->kp_state != -1 ) 
01038       {
01039         var->nfor_name = var->kp_state ;
01040       }
01041   }
01042 }

Here is the caller graph for this function:

void Fprintf ( va_alist   ) 

Definition at line 3310 of file intersci.c.

References count, i, int, and white().

03312 {
03313   int i; 
03314   static int count=0;
03315   va_list ap;
03316 #ifdef __STDC__
03317   va_start(ap,format);
03318 #else
03319   FILE *f;
03320   int indent;
03321   char *format;
03322   va_start(ap);
03323   f = va_arg(ap, FILE *);
03324   indent= va_arg(ap, int );
03325   format = va_arg(ap, char *);
03326 #endif
03327   vsprintf(sbuf,format,ap);
03328   for ( i = 0 ; i < (int) strlen(sbuf); i++) 
03329     {
03330       if ( count == 0)  
03331         {
03332           white(f,7+indent);
03333           count = 7+indent;
03334         }
03335       if ( count == 72 && sbuf[i] != '\n' ) { fprintf(f,"\n     $ ");count=7;}
03336       if ( sbuf[i] == '\n') count = -1 ;
03337       fprintf(f,"%c",sbuf[i]);
03338       count++;
03339     }
03340   va_end(ap);
03341 }

Here is the call graph for this function:

void GenFundef ( char *  file,
int  interf 
)

Definition at line 3142 of file intersci.c.

References funNames, i, int, j, MAXNAM, and nFun.

03145 {
03146   FILE *fout;
03147   char filout[MAXNAM];
03148   int i,j;
03149   if (interf != 0 ) 
03150     {
03151       strcpy(filout,file);
03152       strcat(filout,".fundef");
03153       fout = fopen(filout,"w");
03154       fprintf(fout,"#define IN_%s %.2d\n",file,interf);
03155       for (i = 0; i < nFun; i++) {
03156         fprintf(fout,"{\"%s\",",funNames[i]);
03157         for (j = 0; j < 25 - (int)strlen(funNames[i]); j++) fprintf(fout," ");
03158         fprintf(fout,"\t\tIN_%s,\t%d,\t3},\n",file,i+1);
03159       }
03160       printf("\nfile \"%s\" has been created\n",filout);
03161       fclose(fout);
03162     }
03163 }

int GetBasType ( char *  sname  ) 

Definition at line 1096 of file intersci.c.

References code, i, j, NULL, and SType.

Referenced by ReadFunction(), and ReadListElement().

01098 { 
01099   int i=0;
01100   while ( SType[i].sname != (char *) NULL)
01101      {
01102        int j ;
01103        j = strcmp(sname,SType[i].sname);
01104        if ( j == 0 ) 
01105          { 
01106            return(SType[i].code);
01107          }
01108        else 
01109          { 
01110            if ( j <= 0) 
01111              break;
01112            else i++;
01113          }
01114      }
01115   printf("the type of variable \"%s\" is unknown\n",sname);
01116   exit(1);
01117 }

Here is the caller graph for this function:

char* getenv (  ) 

IVAR GetExistOutVar (  ) 

Definition at line 973 of file intersci.c.

References i, nVariable, str, and variables.

Referenced by OutCommon(), OutExtCommon(), OutExtIMATRIX(), OutExtSPARSE(), OutExtSTRING(), OutIMATRIX(), OutSPARSE(), OutSTRINGMAT(), WriteInfoCode(), and WriteOutput().

00974 {
00975   int i;
00976   char str[4];
00977   strcpy(str,"out");
00978   for (i = 0; i < nVariable; i++) {
00979     if (strcmp(variables[i]->name,str) == 0)
00980       return(i+1);
00981   }
00982   printf("variable \"out\" must exist\n");
00983   exit(1);
00984 }

Here is the caller graph for this function:

IVAR GetExistVar ( char *  name  ) 

Definition at line 886 of file intersci.c.

References i, nVariable, var, and variables.

Referenced by ReadFunction(), WriteFortranCall(), and WriteVariableOutput().

00888 {
00889   int i;
00890   VARPTR var;
00891   if (strcmp(name,"out") == 0) {
00892     printf("the name of a variable which is not the output variable\n");
00893     printf("  of SCILAB function cannot be \"out\"\n");
00894     exit(1);
00895   }
00896   for (i = 0; i < nVariable; i++) {
00897     var = variables[i];
00898     if (strcmp(var->name,name) == 0) {
00899       /* always present */
00900       var->present = 1;
00901       return(i+1);
00902     }
00903   }
00904   i=CreatePredefVar(name);
00905   if ( i != -1) return(i);
00906   printf("variable \"%s\" must exist\n",name);
00907   exit(1);
00908 }

Here is the caller graph for this function:

int GetForType ( char *  type  ) 

Definition at line 1158 of file intersci.c.

References code, EXTERNAL, fname, FType, i, j, and NULL.

Referenced by ReadFunction().

01160 {
01161   int i=0;
01162   while ( FType[i].fname != (char *) NULL)
01163      {
01164        int j;
01165        j = strcmp(type,FType[i].fname);
01166        if ( j == 0 ) 
01167          { 
01168            return(FType[i].code);
01169          }
01170        else 
01171          { 
01172            if ( j <= 0) 
01173              break;
01174            else i++;
01175          }
01176      }
01177   return(EXTERNAL);
01178 }

Here is the caller graph for this function:

int GetNumberInFortranCall ( int  ivar  ) 

Definition at line 3101 of file intersci.c.

References j.

03103 {
03104   int j;
03105   for (j = 0; j < forsub->narg; j++) 
03106     {
03107       if (ivar == forsub->arg[j]) 
03108         {
03109           return( j + 1);
03110           break;
03111         }
03112     }
03113   return(0);
03114 }

int GetNumberInScilabCall ( int  ivar  ) 

Definition at line 3087 of file intersci.c.

References j.

03089 {
03090   int j;
03091   for (j = 0; j < basfun->nin; j++) 
03092     {
03093       if (ivar == basfun->in[j]) {
03094         return(j+1);
03095         break;
03096       }
03097     }
03098   return(0);
03099 }

IVAR GetOutVar ( char *  name  ) 

Definition at line 936 of file intersci.c.

References malloc(), MAXVAR, nVariable, var, VarAlloc(), and variables.

Referenced by ReadFunction().

00938 {
00939   VARPTR var;
00940   if (strcmp(name,"out") != 0) {
00941     printf("the name of output variable of SCILAB function\n");
00942     printf("  must be \"out\"\n");
00943     exit(1);
00944   }
00945   if (nVariable == MAXVAR) {
00946     printf("too many variables\n");
00947     printf("  augmente constant \"MAXVAR\" and recompile intersci\n");
00948     exit(1);
00949   }
00950   var = VarAlloc();
00951   if (var == 0) {
00952     printf("Running out of memory\n");
00953     exit(1);
00954   }
00955   var->name = (char *)malloc((unsigned)(strlen(name) + 1));
00956   strcpy(var->name,name);
00957   var->type = 0;
00958   var->length = 0;
00959   var->for_type = 0;
00960   var->equal = 0;
00961   var->nfor_name = 0;
00962   var->kp_state = -1;
00963   var->list_el = 0;
00964   var->opt_type = 0;
00965   var->present = 0;
00966   variables[nVariable++] = var;
00967   return(nVariable);
00968 }

Here is the call graph for this function:

Here is the caller graph for this function:

IVAR GetVar ( char *  name,
int  p 
)

Definition at line 841 of file intersci.c.

References i, nVariable, var, and variables.

Referenced by CreatePredefVar(), ReadFunction(), and ReadListElement().

00844 {
00845   int i;
00846   VARPTR var;
00847   if (strcmp(name,"out") == 0) {
00848     printf("the name of a variable which is not the output variable\n");
00849     printf("  of SCILAB function cannot be \"out\"\n");
00850     exit(1);
00851   }
00852   for (i = 0; i < nVariable; i++) {
00853     var = variables[i];
00854     if (strcmp(var->name,name) == 0) {
00855       var->present = var->present || p;
00856       return(i+1);
00857     }
00858   }
00859   if (nVariable == MAXVAR) {
00860     printf("too many variables\n");
00861     printf("  augment constant \"MAXVAR\" and recompile intersci\n");
00862     exit(1);
00863   }
00864   var = VarAlloc();
00865   if (var == 0) {
00866     printf("Running out of memory\n");
00867     exit(1);
00868   }
00869   var->name = (char *)malloc((unsigned)(strlen(name) + 1));
00870   strcpy(var->name,name);
00871   var->type = 0;
00872   var->length = 0;
00873   var->for_type = 0;
00874   var->equal = 0;
00875   var->nfor_name = 0;
00876   var->kp_state = -1;
00877   var->list_el = 0;
00878   var->opt_type = 0;
00879   var->present = p;
00880   variables[nVariable++] = var;
00881   return(nVariable);
00882 }

Here is the caller graph for this function:

void InitDeclare (  ) 

Definition at line 3186 of file intersci.c.

References Declare::decls, i, Init, Declare::ndecls, and type.

03187 { 
03188   int i = 0;
03189   while ( Init[i].type != -1) 
03190     {
03191       Init[i].decls = (char **) 0;
03192       Init[i].ndecls =0 ;
03193       i++;
03194     }
03195 }

void ISCIReadFile ( char *  file  ) 

Definition at line 64 of file intersci.c.

References Copyright(), fin, ForNameClean(), InitDeclare(), MAXFUN, MAXNAM, nFun, pass, ReadFunction(), ResetDeclare(), WriteAddInter(), WriteFunctionCode(), and WriteMain().

Referenced by main().

00066 {
00067   FILE *fin, *fout, *foutv;
00068   char filout[MAXNAM];
00069   char filin[MAXNAM];
00070   sprintf(filin,"%s.desc",file);
00071   fin = fopen(filin,"r");
00072   if (fin == 0) {
00073     printf("interface file \"%s\" does not exist\n",filin);
00074     exit(1);
00075   }
00076   Copyright();
00077   strcpy(filout,file);
00078   strcat(filout,".f");
00079   fout = fopen(filout,"w");
00080   strcpy(filout,file);
00081   strcat(filout,".tmp");
00082   foutv = fopen(filout,"w");
00083   InitDeclare();
00084   nFun = 0;
00085   while(ReadFunction(fin)) {
00086     nFun++;
00087     if (nFun > MAXFUN) {
00088       printf("Too many SCILAB functions. The maximum is %d\n",MAXFUN);
00089       exit(1);
00090     }
00091     ResetDeclare();
00092     /* first pass to collect declarations */
00093     pass=0;
00094     WriteFunctionCode(foutv);
00095     /* cleaning added Fornames before pass 2 */
00096     ForNameClean();
00097     /* scond pass to produce code */
00098     pass=1;
00099     WriteFunctionCode(fout);
00101   }
00102   WriteMain(fout,file);
00103   printf("FORTRAN file \"%s.f\" has been created\n",file);
00104   WriteAddInter(file) ;
00105   printf("Scilab file \"%s.sce\" has been created\n",file);
00106   fclose(fout);
00107   fclose(fin);
00108 }

Here is the call graph for this function:

Here is the caller graph for this function:

int main ( unsigned int  argc,
char **  argv 
)

Definition at line 31 of file intersci.c.

References BasfunAlloc(), ForsubAlloc(), GenFundef(), ISCIReadFile(), and SciEnv().

00034 { 
00035   int InterFace = 0 ;
00036 #ifdef _MSC_VER
00037   SciEnv();
00038 #endif 
00039   switch (argc) {
00040   case 2:
00041     InterFace = 0; break;
00042   case 3:
00043     InterFace = atoi(argv[2]);break;
00044   default:
00045     printf("usage:  intersci <interface file> <interface number>\n");
00046     exit(1);
00047     break;
00048   }
00049   basfun = BasfunAlloc();
00050   if (basfun == 0) {
00051     printf("Running out of memory\n");
00052     exit(1);
00053   }
00054   forsub = ForsubAlloc();
00055   if (forsub == 0) {
00056     printf("Running out of memory\n");
00057     exit(1);
00058   }
00059   ISCIReadFile(argv[1]);
00060   GenFundef(argv[1],InterFace);
00061   return 0;
00062 }

Here is the call graph for this function:

void OptvarGetSize ( char *  optvar,
char*  size,
char*  data 
)

Definition at line 1588 of file intersci.c.

References i, int, j, and ok.

Referenced by WriteArgCheck(), WriteOptArg(), and WriteOptArgPhase2().

01590 {
01591   int i,j=0,ok=0;
01592   for ( i = 0 ; i < (int) strlen(optvar) ; i++ ) 
01593        {
01594          if ( optvar[i] == ')' ) 
01595            { 
01596              size[j++] = '\0'; break;
01597            }
01598          if ( ok ==1 ) size[j++]= optvar[i];
01599          if ( optvar[i] == '(' ) ok =1 ;
01600        }
01601   if ( i < (int) strlen(optvar)) strcpy(data,optvar+i+1);
01602 }

Here is the caller graph for this function:

int ParseLine ( char *  s,
words   
)

Definition at line 581 of file intersci.c.

References i, malloc(), MAXNAM, and w.

Referenced by ReadFunction(), and ReadListElement().

00583 {
00584   char w[MAXNAM];
00585   int nwords = 0;
00586   int inword = 1;
00587   int i = 0;
00588   if(*s == ' ' || *s == '\t') inword = 0;
00589   while (*s) {
00590     if (inword) {
00591       w[i++] = *s++;
00592       if (*s == ' ' || *s == '\t' || *s == '\n') {
00593         w[i] = '\0';
00594         words[nwords] = (char *)malloc((unsigned)(i+1));
00595         strcpy(words[nwords],w);
00596         nwords++;
00597         inword = 0;
00598       }
00599     }
00600     else {
00601       s++; /* *s++; */
00602       if (*s != ' ' && *s != '\t') {
00603         i = 0;
00604         inword = 1;
00605       }
00606     }
00607   }
00608   return(nwords);
00609 }

Here is the call graph for this function:

Here is the caller graph for this function:

int ParseScilabLine ( char *  s,
words   
)

Definition at line 510 of file intersci.c.

References i, malloc(), MAXNAM, and w.

Referenced by ReadFunction().

00512 {
00513   char w[MAXNAM];
00514   int nwords = 0;
00515   int inword = 1;
00516   int inopt1 = 0; /* {  } */
00517   int inopt2 = 0; /* [  ] */
00518   int i = 0;
00519   if (*s == ' ' || *s == '\t') inword = 0;
00520   if (*s == '{') inopt1 = 1;
00521   if (*s == '[') inopt2 = 1;
00522   while (*s) {
00523     if (inopt1) {
00524       w[i++] = *s++;
00525       if (*s == '{' || *s == '[' || *s == ']' || *s == '\n') {
00526         printf("Bad syntax for optional argument. No matching \"}\"\n");
00527         exit(1);
00528       }
00529       else if (*s == '}') {
00530         w[i++] = '\n';
00531         w[i] = '\0';
00532         words[nwords] = (char *)malloc((unsigned)(i+1));
00533         strcpy(words[nwords],w);
00534         nwords++;
00535         inopt1 = 0;
00536         inword = 0;
00537       }
00538     }
00539     else if (inopt2) {
00540       w[i++] = *s++;
00541       if (*s == '[' || *s == '{' || *s == '}' || *s == '\n') {
00542         printf("Bad syntax for optional argument. No matching \"]\"\n");
00543         exit(1);
00544       }
00545       else if (*s == ']') {
00546         w[i++] = '\n';
00547         w[i] = '\0';
00548         words[nwords] = (char *)malloc((unsigned)(i+1));
00549         strcpy(words[nwords],w);
00550         nwords++;
00551         inopt2 = 0;
00552         inword = 0;
00553       }
00554     }
00555     else if (inword) {
00556       w[i++] = *s++;
00557       if (*s == ' ' || *s == '\t' || *s == '\n') {
00558         w[i] = '\0';
00559         words[nwords] = (char *)malloc((unsigned)(i+1));
00560         strcpy(words[nwords],w);
00561         nwords++;
00562         inword = 0;
00563       }
00564     }
00565     else {
00566       s++; /* *s++; */
00567       if (*s != ' ' && *s != '\t') {
00568         /* beginning of a word */
00569         i = 0;
00570         inword = 1;
00571         if (*s == '{') inopt1 = 1;
00572         if (*s == '[') inopt2 = 1;
00573       }
00574     }
00575   }
00576   return(nwords);
00577 }

Here is the call graph for this function:

Here is the caller graph for this function:

int ReadFunction ( FILE *  f  ) 

Definition at line 172 of file intersci.c.

References AddForName(), ANY, BMATRIX, COLUMN, var::el, EMPTY, var::equal, EXTERNAL, var::for_type, funNames, GetBasType(), GetExistVar(), GetForType(), GetOutVar(), GetVar(), i, IMATRIX, j, l, var::length, LIST, malloc(), MATRIX, MAXARG, MAXEL, MAXLINE, MAXNAM, maxOpt, name, NAME, nFun, nVariable, var::opt_name, var::opt_type, ParseLine(), ParseScilabLine(), POLYNOM, ReadListFile(), ROW, s, SCALAR, SCIBPOINTER, SCILPOINTER, SCIMPOINTER, SCIOPOINTER, SCISMPOINTER, SEQUENCE, SGetSciType(), SPARSE, str, STRING, STRINGMAT, TLIST, var::type, type, VALUE, variables, VECTOR, and WORK.

Referenced by Generate(), and ISCIReadFile().

00174 {
00175   int i, j, l, type, ftype;
00176   char s[MAXLINE];
00177   char str[MAXNAM];
00178   char *words[MAXLINE];
00179   char *optwords[MAXLINE];
00180   IVAR ivar;
00181   int nwords, line1, inbas, fline1, infor, nopt, out1;
00182   
00183   nVariable = 0;
00184   maxOpt = 0;
00185   line1 = 1;
00186   inbas = 0;
00187   fline1 = 0;
00188   infor = 0;
00189   out1 = 0;
00190   while (fgets(s,MAXLINE,f)) 
00191     {
00192       /* analysis of one line */
00193       if (line1 != 1) nwords = ParseLine(s,words);
00194       else nwords = ParseScilabLine(s,words);
00195       /* end of description */
00196       if (words[0][0] == '*') return(1);
00197       if (line1 == 1) 
00198         {
00199           /* SCILAB function description */
00200           if ((int)strlen(words[0]) > 24) 
00201             {
00202               printf("SCILAB function name too long: \"%s\"\n",words[0]);
00203               exit(1);
00204             }
00205           basfun->name = (char *)malloc((unsigned)(strlen(words[0])+1));
00206           strcpy(basfun->name,words[0]);
00207           printf("**************************\n");
00208           printf("processing SCILAB function \"%s\"\n",words[0]);
00209           funNames[nFun] = basfun->name;
00210           i = nwords - 1;
00211           if (i > MAXARG) 
00212             {
00213               printf("too may input arguments for SCILAB function\"%s\"\n",
00214                      words[0]);
00215               printf("  augment constant \"MAXARG\" and recompile intersci\n");
00216               exit(1);
00217             }
00218           basfun->nin = i;
00219           for (i = 0; i < nwords - 1; i++) 
00220             {
00221               if (words[i+1][0] == '{') 
00222                 {
00223                   maxOpt++;
00224                   nopt = ParseLine(words[i+1]+1,optwords);
00225                   if (nopt != 2) {
00226                     printf("Bad syntax for optional argument. Two variables needed\n");
00227                     exit(1);
00228                   }
00229                   ivar = GetVar(optwords[0],1);
00230                   basfun->in[i] = ivar;
00231                   variables[ivar-1]->opt_type = NAME;
00232                   variables[ivar-1]->opt_name =
00233                     (char *)malloc((unsigned)(strlen(optwords[1])+1));
00234                   strcpy(variables[ivar-1]->opt_name,optwords[1]);
00235                 }
00236               else if (words[i+1][0] == '[') 
00237                 {
00238                   maxOpt++;
00239                   nopt = ParseLine(words[i+1]+1,optwords);
00240                   if (nopt != 2) 
00241                     {
00242                       printf("Bad syntax for optional argument. Two variables needed\n");
00243                       exit(1);
00244                     }
00245                   ivar = GetVar(optwords[0],1);
00246                   basfun->in[i] = ivar;
00247                   variables[ivar-1]->opt_type = VALUE;
00248                   variables[ivar-1]->opt_name =
00249                     (char *)malloc((unsigned)(strlen(optwords[1])+1));
00250                   strcpy(variables[ivar-1]->opt_name,optwords[1]);
00251                 }
00252               else basfun->in[i] = GetVar(words[i+1],1);
00253             }
00254           line1 = 0;
00255           inbas = 1;
00256         } 
00257       else if (inbas == 1) 
00258         {
00259           if (nwords == 0) 
00260             {
00261               /* end of SCILAB variable description */
00262               inbas = 0;
00263               fline1 = 1;
00264             } 
00265           else 
00266             {
00267               /* SCILAB variable description */
00268               ivar = GetVar(words[0],1);
00269               i = ivar - 1;
00270               if (nwords == 1) 
00271                 {
00272                   printf("type missing for variable \"%s\"\n",words[0]);
00273                   exit(1);
00274                 }
00275               type = GetBasType(words[1]);
00276               variables[i]->type = type;
00277               switch (type) 
00278                 {
00279                 case SCALAR:
00280                 case ANY:
00281                 case SCIMPOINTER:
00282                 case SCISMPOINTER:
00283                 case SCILPOINTER:
00284                 case SCIBPOINTER:
00285                 case SCIOPOINTER:
00286                   break;
00287                 case COLUMN:
00288                 case ROW:
00289                 case STRING:
00290                 case WORK:
00291                 case VECTOR:
00292                   if (nwords != 3) 
00293                     {
00294                       printf("bad type specification for variable \"%s\" \n", words[0]);
00295                       printf("only %d argument given and %d are expected\n", nwords,3);
00296                       exit(1);
00297                     }
00298                   variables[i]->el[0] = GetVar(words[2],1);
00299                   break;
00300                 case LIST:
00301                 case TLIST:
00302                   if (nwords != 3) 
00303                     {
00304                       printf("bad type specification for variable \"%s\"\n", words[0]);
00305                       printf("only %d argument given and %d are expected\n", nwords,3);
00306                       exit(1);
00307                     }
00308                   ReadListFile(words[2],words[0],i);
00309                   break;
00310                 case POLYNOM:
00311                 case MATRIX:
00312                 case BMATRIX:
00313                 case STRINGMAT:
00314                   if (nwords != 4) 
00315                     {
00316                       printf("bad type specification for variable \"%s\"\n",words[0]);
00317                       printf("%d argument given and %d are expected\n", nwords,4);
00318                       exit(1);
00319                     }     
00320                   variables[i]->el[0] = GetVar(words[2],1);
00321                   variables[i]->el[1] = GetVar(words[3],1);
00322                   break;
00323                 case IMATRIX:
00324                   if (nwords != 5) 
00325                     {
00326                       printf("bad type specification for variable \"%s\"\n",words[0]);
00327                       printf("%d argument given and %d are expected\n", nwords,5);
00328                       exit(1);
00329                     }     
00330                   variables[i]->el[0] = GetVar(words[2],1);
00331                   variables[i]->el[1] = GetVar(words[3],1);
00332                   variables[i]->el[2] = GetVar(words[4],1);
00333                   break;
00334                 case SPARSE:
00335                   if (nwords != 6)
00336                     {
00337                       printf("bad type specification for variable \"%s\"\n",words[0]);
00338                       printf("%d argument given and %d are expected\n", nwords,6);
00339                       printf("name sparse m n nel it\n");
00340                       exit(1);
00341                     }     
00342                   variables[i]->el[0] = GetVar(words[2],1);
00343                   variables[i]->el[1] = GetVar(words[3],1);
00344                   variables[i]->el[2] = GetVar(words[4],1);
00345                   variables[i]->el[3] = GetVar(words[5],1);
00346                   break;
00347                 case SEQUENCE:
00348                   printf("variable \"%s\" cannot have type \"SEQUENCE\"\n",
00349                          words[0]);
00350                   exit(1);
00351                   break;
00352                 case EMPTY:
00353                   printf("variable \"%s\" cannot have type \"EMPTY\"\n",
00354                          words[0]);
00355                   exit(1);
00356                   break;
00357                 }
00358             }
00359         } 
00360       else if (fline1 == 1) 
00361         {
00362           /* FORTRAN subroutine description */
00363           forsub->name = (char *)malloc((unsigned)(strlen(words[0])+1));
00364           strcpy(forsub->name,words[0]);
00365           i = nwords - 1;
00366           if (i > MAXARG) 
00367             {
00368               printf("too many argument for FORTRAN subroutine \"%s\"\n",
00369                      words[0]);
00370               printf("  augment constant \"MAXARG\" and recompile intersci\n");
00371               exit(1);
00372             }
00373           forsub->narg = i;
00374           for (i = 0; i < nwords - 1; i++) 
00375             {
00376               forsub->arg[i] = GetExistVar(words[i+1]);
00377             }
00378           fline1 = 0;
00379           infor = 1;
00380         } 
00381       else if (infor == 1) 
00382         {
00383           if (nwords == 0) 
00384             {
00385               /* end of FORTRAN subroutine description */
00386               infor = 0;
00387               out1 = 1;
00388             }
00389           else 
00390             {
00391               /* FORTRAN variable description */
00392               if (nwords == 1) 
00393                 {
00394                   printf("type missing for FORTRAN argument \"%s\"\n",
00395                          words[0]);
00396                   exit(1);
00397                 }
00398               ivar = GetExistVar(words[0]);
00399               ftype = GetForType(words[1]);
00400               variables[ivar-1]->for_type = ftype;
00401               if (ftype == EXTERNAL) 
00402                 {
00403                   strcpy((char *)(variables[ivar-1]->fexternal),words[1]);
00404                   switch (variables[ivar-1]->type) 
00405                     {
00406                     case COLUMN:
00407                     case POLYNOM:
00408                     case ROW:
00409                     case STRING:
00410                     case VECTOR:
00411                       sprintf(str,"ne%d",ivar);
00412                       AddForName(variables[ivar-1]->el[0],str);
00413                       break;
00414                     case SPARSE:
00415                       sprintf(str,"me%d",ivar);
00416                       AddForName(variables[ivar-1]->el[0],str);
00417                       sprintf(str,"ne%d",ivar);
00418                       AddForName(variables[ivar-1]->el[1],str);
00419                       sprintf(str,"nel%d",ivar);
00420                       AddForName(variables[ivar-1]->el[2],str);
00421                       sprintf(str,"it%d",ivar);
00422                       AddForName(variables[ivar-1]->el[3],str);
00423                       break;
00424                     case IMATRIX:
00425                       sprintf(str,"me%d",ivar);
00426                       AddForName(variables[ivar-1]->el[0],str);
00427                       sprintf(str,"ne%d",ivar);
00428                       AddForName(variables[ivar-1]->el[1],str);
00429                       sprintf(str,"it%d",ivar);
00430                       AddForName(variables[ivar-1]->el[2],str);
00431                       break;
00432                     case MATRIX:
00433                     case BMATRIX:
00434                     case STRINGMAT:
00435                       sprintf(str,"me%d",ivar);
00436                       AddForName(variables[ivar-1]->el[0],str);
00437                       sprintf(str,"ne%d",ivar);
00438                       AddForName(variables[ivar-1]->el[1],str);
00439                       break;
00440                     default:
00441                       printf("FORTRAN argument \"%s\" with external type \"%s\"\n",
00442                              variables[ivar-1]->name,words[1]);
00443                       printf("  cannot have a variable type of \"%s\" \n",SGetSciType(variables[ivar-1]->type));
00444                       exit(1);
00445                       break;
00446                     }
00447                 }
00448             }
00449         } 
00450       else if (out1 == 1) 
00451         {
00452           /* output variable description */
00453           i = ivar - 1;
00454           if (nwords == 1) 
00455             {
00456               printf("type missing for output variable \"out\"\n");
00457               exit(1);
00458             }
00459           ivar = GetOutVar(words[0]);
00460           basfun->out = ivar;
00461           i = ivar - 1;
00462           type = GetBasType(words[1]);
00463           variables[i]->type = type;
00464           switch (type) 
00465             {
00466             case LIST:
00467             case TLIST:
00468             case SEQUENCE:
00469               l = nwords - 2;
00470               if (l > MAXEL) 
00471                 {
00472                   printf("list or sequence too long for output variable \"out\"\n");
00473                   printf("  augment constant \"MAXEL\" and recompile intersci\n");
00474                   exit(1);
00475                 }
00476               for (j = 0; j < l; j++) 
00477                 variables[i]->el[j] = GetExistVar(words[j+2]);
00478               variables[i]->length = l;
00479               break;
00480             case EMPTY:
00481               break;
00482             default:
00483               printf("output variable \"out\" of SCILAB function\n");
00484               printf("  must have type \"LIST\", \"TLIST\", \"SEQUENCE\" or\n");
00485               printf("  \"EMPTY\"\n");
00486               exit(1);
00487               break;
00488             }
00489           out1 = 0;
00490         }
00491       else 
00492         {
00493           /* possibly equal variables */
00494           ivar = GetExistVar(words[0]);
00495           i = ivar -1 ;
00496           variables[i]->equal = GetExistVar(words[1]);
00497         }
00498     }
00499   /* end of description file */
00500   return(0);
00501 }

Here is the call graph for this function:

Here is the caller graph for this function:

int ReadListElement ( FILE *  f,
char *  varlistname,
IVAR  iivar,
int  nel 
)

Definition at line 641 of file intersci.c.

References AddForName(), ANY, BMATRIX, COLUMN, var::el, EMPTY, GetBasType(), GetVar(), i, IMATRIX, LIST, var::list_el, var::list_name, malloc(), MATRIX, MAXLINE, MAXNAM, NULL, ParseLine(), POLYNOM, ROW, s, SCALAR, SEQUENCE, SGetSciType(), SPARSE, str, STRING, STRINGMAT, TLIST, var::type, type, variables, VECTOR, and WORK.

Referenced by ReadListFile().

00646 {
00647   char s[MAXLINE];
00648   char *words[MAXLINE];
00649   int i, nline, nwords, type;
00650   IVAR ivar;
00651   char str[MAXNAM];
00652   nline = 0;
00653   while (fgets(s,MAXLINE,f) != NULL) 
00654     {
00655       /* analyse of one line */
00656       nline++;
00657       switch (nline) 
00658         {
00659         case 1:
00660           break;
00661         case 2:
00662           /* SCILAB variable description */
00663           nwords = ParseLine(s,words);
00664           sprintf(str,"%s(%s)",words[0],varlistname);
00665           ivar = GetVar(str,0);
00666           i = ivar - 1;
00667           if (nwords == 1) 
00668             {
00669               printf("type missing for variable \"%s\"\n",words[0]);
00670               exit(1);
00671             }
00672           type = GetBasType(words[1]);
00673           variables[i]->type = type;
00674           variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1));
00675           strcpy(variables[i]->list_name,varlistname);
00676           variables[i]->list_el = nel+1;
00677           sprintf(str,"stk(l%de%d)",iivar+1,nel+1);
00678           AddForName(ivar,str);     
00679           switch (type) 
00680             {
00681             case SCALAR:
00682             case ANY:
00683               break;
00684             case COLUMN:
00685             case ROW:
00686             case STRING:
00687             case VECTOR:
00688               if (nwords != 3) 
00689                 {
00690                   printf("bad type for variable \"%s\"\n",
00691                          words[0]);
00692                   exit(1);
00693                 }
00694               if (isdigit(words[2][0]))
00695                 {
00696                   variables[i]->el[0] = GetVar(words[2],0);
00697                 }
00698               else 
00699                 {
00700                   sprintf(str,"%s(%s)",words[2],varlistname);
00701                   variables[i]->el[0] = GetVar(str,0);
00702                 }
00703               break;
00704             case POLYNOM:
00705             case MATRIX:
00706             case BMATRIX:
00707             case STRINGMAT:
00708               if (nwords != 4) 
00709                 {
00710                   printf("bad type for variable \"%s\"\n",
00711                          words[0]);
00712                   exit(1);
00713                 }         
00714               if (isdigit(words[2][0]))
00715                 {
00716                   variables[i]->el[0] = GetVar(words[2],0);
00717                 } 
00718               else
00719                 {
00720                   sprintf(str,"%s(%s)",words[2],varlistname);   
00721                   variables[i]->el[0] = GetVar(str,0);
00722                 }
00723               if (isdigit(words[3][0]))
00724                 {
00725                   variables[i]->el[1] = GetVar(words[3],0); 
00726                 }
00727               else 
00728                 {
00729                   sprintf(str,"%s(%s)",words[3],varlistname);   
00730                   variables[i]->el[1] = GetVar(str,0);
00731                 }
00732               break;
00733             case IMATRIX:
00734               if (nwords != 6) 
00735                 {
00736                   printf("bad type for variable \"%s\"\n",
00737                          words[0]);
00738                   exit(1);
00739                 }         
00740               if (isdigit(words[2][0]))
00741                 {
00742                   variables[i]->el[0] = GetVar(words[2],0);
00743                 } 
00744               else
00745                 {
00746                   sprintf(str,"%s(%s)",words[2],varlistname);   
00747                   variables[i]->el[0] = GetVar(str,0);
00748                 }
00749               if (isdigit(words[3][0]))
00750                 {
00751                   variables[i]->el[1] = GetVar(words[3],0); 
00752                 }
00753               else 
00754                 {
00755                   sprintf(str,"%s(%s)",words[3],varlistname);   
00756                   variables[i]->el[1] = GetVar(str,0);
00757                 }
00758               sprintf(str,"%s(%s)",words[4],varlistname);       
00759               variables[i]->el[2] = GetVar(str,0);
00760               break;
00761             case SPARSE:
00762               if (nwords != 6) 
00763                 {
00764                   printf("bad type for variable \"%s\"\n",
00765                          words[0]);
00766                   exit(1);
00767                 }         
00768               if (isdigit(words[2][0]))
00769                 {
00770                   variables[i]->el[0] = GetVar(words[2],0);
00771                 } 
00772               else
00773                 {
00774                   sprintf(str,"%s(%s)",words[2],varlistname);   
00775                   variables[i]->el[0] = GetVar(str,0);
00776                 }
00777               if (isdigit(words[3][0]))
00778                 {
00779                   variables[i]->el[1] = GetVar(words[3],0); 
00780                 }
00781               else 
00782                 {
00783                   sprintf(str,"%s(%s)",words[3],varlistname);   
00784                   variables[i]->el[1] = GetVar(str,0);
00785                 }
00786               if (isdigit(words[4][0]))
00787                 {
00788                   variables[i]->el[2] = GetVar(words[4],0); 
00789                 }
00790               else 
00791                 {
00792                   sprintf(str,"%s(%s)",words[4],varlistname);   
00793                   variables[i]->el[2] = GetVar(str,0);
00794                 }
00795               sprintf(str,"%s(%s)",words[5],varlistname);       
00796               variables[i]->el[3] = GetVar(str,0);
00797               break;
00798             case WORK:
00799             case SEQUENCE:
00800             case EMPTY:
00801             case LIST:
00802             case TLIST:
00803               printf("variable \"%s\" cannot have type \"%s\"\n",
00804                      words[0],SGetSciType(type));
00805               exit(1);
00806             default:
00807               printf("variable \"%s\" has unknown type \"%s\"\n",
00808                      words[0],SGetSciType(type));
00809             }
00810           break;
00811         default:
00812           /* end of description */
00813           if (s[0] == '*') 
00814             {
00815               return(1);
00816             }
00817           else
00818             {
00819               printf("bad description file for list or tlist \"%s\"\n",
00820                      varlistname);
00821               exit(1);
00822             }
00823           break;
00824         }
00825     }
00826   return(0);
00827 }

Here is the call graph for this function:

Here is the caller graph for this function:

void ReadListFile ( char *  listname,
char *  varlistname,
IVAR  ivar 
)

Definition at line 613 of file intersci.c.

References fin, MAXNAM, nel, and ReadListElement().

Referenced by ReadFunction().

00617 {
00618   FILE *fin;
00619   char filin[MAXNAM];
00620   int nel;
00621   
00622   sprintf(filin,"%s.list",listname);
00623   fin = fopen(filin,"r");
00624   if (fin == 0) 
00625     {
00626       printf("description file for list or tlist \"%s\" does not exist\n",
00627              filin);
00628       exit(1);
00629     }
00630   printf("reading description file for list or tlist \"%s\"\n", listname);
00631   
00632   nel = 0;
00633   while(ReadListElement(fin,varlistname,ivar,nel)) 
00634     {
00635       nel++;
00636     }
00637   
00638   fclose(fin);
00639 }

Here is the call graph for this function:

Here is the caller graph for this function:

void ResetDeclare (  ) 

Definition at line 3197 of file intersci.c.

References Declare::decls, free(), i, Init, j, Declare::ndecls, and type.

03198 {
03199   int j = 0;
03200   while ( Init[j].type != -1) 
03201     {
03202       if ( Init[j].decls != (char **) 0) 
03203         {
03204           int i;
03205           for ( i = 0 ; i < Init[j].ndecls ; i++ ) 
03206             free((char *) Init[j].decls[i]);
03207           free (( char *) Init[j].decls );
03208         }
03209       Init[j].decls=(char **) 0;
03210       Init[j].ndecls=0;
03211       j++;
03212     }
03213 }

Here is the call graph for this function:

char* SGetForType ( int  type  ) 

Definition at line 1182 of file intersci.c.

References code, fname, FType, and i.

Referenced by CheckBMATRIX(), CheckSTRING(), CreBMATRIX(), CreDIMFOREXT(), CreSTRING(), GetBMATRIX(), GetSTRING(), GetSTRINGMAT(), ShowVariables(), WriteCallConvertion(), and WriteCallRest().

01184 {
01185   int i=0;
01186   while ( FType[i].code  != -1 ) 
01187      {
01188        if ( FType[i].code == type ) 
01189          return(FType[i].fname);
01190        else 
01191          i++;
01192      }
01193   return("External");
01194 }

Here is the caller graph for this function:

char* SGetSciType ( int  type  ) 

Definition at line 1121 of file intersci.c.

References code, i, and SType.

Referenced by CheckBMATRIX(), CheckSTRING(), CreBMATRIX(), CreSTRING(), GetBMATRIX(), GetSTRING(), GetSTRINGMAT(), OutExtPOINTER(), OutPOINTER(), ReadFunction(), ReadListElement(), ShowVariables(), WriteArgCheck(), WriteCallConvertion(), WriteCallRest(), WriteInfoCode(), WriteOutput(), and WriteVariableOutput().

01123 {
01124   int i=0;
01125   while ( SType[i].code  != -1 ) 
01126      {
01127        if ( SType[i].code == type ) 
01128          return(SType[i].sname);
01129        else 
01130          i++;
01131      }
01132   return("unknown");
01133 }

Here is the caller graph for this function:

void white ( FILE *  f,
int  ind 
)

Definition at line 3343 of file intersci.c.

References i.

03346 {
03347   int i ;
03348   for (i =0 ; i < ind ; i++) fprintf(f," ");
03349 }

void WriteAddInter ( char *  file  ) 

Definition at line 130 of file intersci.c.

References funNames, i, MAXNAM, and nFun.

00132 {
00133   FILE *fout;
00134   int i;
00135   char filout[MAXNAM];
00136   strcpy(filout,file);
00137   strcat(filout,".sce");
00138   fout = fopen(filout,"w");
00139   if ( fout != (FILE*) 0) 
00140     {
00141  fprintf(fout,"// Addinter for file %s\n",file);
00142  fprintf(fout,"// for hppa/sun-solaris/linux/dec\n");
00143  fprintf(fout,"//--------------------------------\n");
00144  fprintf(fout,"//Scilab functions \n");
00145  fprintf(fout,"%s_funs=[...\n",file);
00146  for (i = 0; i < nFun -1; i++) 
00147       fprintf(fout,"  '%s';\n",funNames[i]);
00148       fprintf(fout,"  '%s']\n",funNames[nFun-1]);
00149  fprintf(fout,"// interface file to link: ifile='%s.o' \n",file);
00150  fprintf(fout,"// user's files to link: ufiles=['file1.o','file2.o',....] \n");
00151  fprintf(fout,"// files = [ifile,ufiles] \n");
00152  fprintf(fout,"addinter(files,'%s',%s_funs);\n",file,file);
00153  fclose(fout);
00154     }
00155   else
00156     fprintf(stderr,"Can't open file %s\n",file);
00157 }

void WriteArgCheck ( FILE *  f,
int  i 
)

Definition at line 1379 of file intersci.c.

References AddDeclare(), AddForName(), AddForName1(), ANY, BMATRIX, buf, Check, COLUMN, data, DEC_CHAR, DEC_DATA, DEC_DOUBLE, DEC_LOGICAL, FCprintf(), Fprintf(), i1, IMATRIX, indent, LIST, MATRIX, MAXNAM, var::name, NAME, OptvarGetSize(), POLYNOM, ROW, SCALAR, SCIBPOINTER, SCILPOINTER, SCIMPOINTER, SCIOPOINTER, SCISMPOINTER, SGetSciType(), size, SPARSE, str, str1, STRING, STRINGMAT, TLIST, VALUE, var, variables, and VECTOR.

01382 {
01383   int i1;
01384   char str[MAXNAM];
01385   char str1[MAXNAM];
01386   char size[MAXNAM];
01387   char data[MAXNAM];
01388 
01389   VARPTR var = variables[basfun->in[i]-1];
01390   i1 = i + 1;
01391   
01392   FCprintf(f,"c       checking variable %s (number %d)\n",var->name,i1);
01393   FCprintf(f,"c       \n");
01394 
01395   /* Optional Argument consideration */
01396   if (var->opt_type != 0) 
01397     {
01403       Fprintf(f,indent++,"if(rhs .le. %d) then\n", i1-1 );
01404       switch (var->opt_type) {
01405       case NAME:
01406         AddDeclare(DEC_LOGICAL,"optvarget");
01407         Fprintf(f,indent,"if (.not.optvarget(fname,topk,%d,'%s       ')) return\n",i1,var->opt_name);
01408         break;
01409       case VALUE:
01410         switch (var->type) {
01411         case SCALAR:
01412           AddDeclare(DEC_LOGICAL,"cremat");
01413           Fprintf(f,indent,"top = top+1\n");
01414           Fprintf(f,indent,"rhs = rhs+1\n");
01415           Fprintf(f,indent,"if(.not.cremat(fname,top,0,1,1,lr%d,lc%d)) return\n",i1,i1);
01416           Fprintf(f,indent,"stk(lr%d)= %s\n",i1,var->opt_name);
01417           break;
01418         case SCISMPOINTER:
01419         case SCILPOINTER:
01420         case SCIBPOINTER:
01421         case SCIOPOINTER:
01422         case SCIMPOINTER:
01423           sprintf(buf,"cre%s", SGetSciType(var->type));
01424           AddDeclare(DEC_LOGICAL,buf);
01425           Fprintf(f,indent,"top = top+1\n");
01426           Fprintf(f,indent,"rhs = rhs+1\n");
01427           Fprintf(f,indent,"if(.not.cre%s(fname,top,lwv)) return\n", SGetSciType(var->type));
01428           break;
01429         case MATRIX:
01430           OptvarGetSize(var->opt_name,size,data);
01431           AddDeclare(DEC_LOGICAL,"cremat");
01432           Fprintf(f,indent,"top = top+1\n");
01433           Fprintf(f,indent,"rhs = rhs+1\n");
01434           sprintf(str,"dat%d %s",i1,data);
01435           AddDeclare(DEC_DATA,str);
01436           sprintf(str,"dat%d(%s)",i1,size);
01437           AddDeclare(DEC_DOUBLE,str);
01438           Fprintf(f,indent,"m%d = 1\n",i1);
01439           Fprintf(f,indent,"n%d = %s\n",i1,size);
01440           Fprintf(f,indent,"if(.not.cremat(fname,top,0,m%d,n%d,lr%d,lc%d)) return\n",i1,i1,i1,i1);
01441           Fprintf(f,indent,"call dcopy(%s,dat%d,1,stk(lr%d),1)\n",size,i1,i1);
01442           break;
01443         case STRING:
01444           AddDeclare(DEC_LOGICAL,"cresmat2");
01445           Fprintf(f,indent,"top = top+1\n");
01446           Fprintf(f,indent,"rhs = rhs+1\n");
01447           Fprintf(f,indent,"nlr%d = %d\n",i1,strlen(var->opt_name));
01448           Fprintf(f,indent,"if(.not.cresmat2(fname,top,nlr%d,lr%d)) return\n",i1,i1,i1);
01449           Fprintf(f,indent,"call cvstr(nlr%d,istk(lr%d),'%s',0)\n",i1,i1,var->opt_name);
01450           break;
01451         default:
01452           printf("Optional variable with value must be \"SCALAR\" or \"STRING\"\n");
01453           exit(1);
01454           break;
01455         }
01456         break;
01457       }
01458       Fprintf(f,--indent,"endif\n");
01459     }
01460 
01461   /* size checking */
01462   switch(var->type) 
01463     {
01464     case BMATRIX:
01465       AddDeclare(DEC_LOGICAL,"getbmat");
01466       Fprintf(f,indent,"if(.not.getbmat(fname,top,top-rhs+%d,m%d,n%d,lr%d)) return\n",i1,i1,i1,i1);
01467       /* square matrix */
01468       if (var->el[0] == var->el[1]) {
01469         /* square matrix */ 
01470         AddDeclare(DEC_LOGICAL,"checkval");
01471         Fprintf(f,indent,"if(.not.checkval(fname,m%d,n%d)) return\n",i1,i1);
01472       }
01473       sprintf(str,"m%d",i1);
01474       Check(f,str,var,i1,0);
01475       sprintf(str,"n%d",i1);
01476       Check(f,str,var,i1,1);
01477       break;
01478     case MATRIX:
01479     case IMATRIX:
01480       AddDeclare(DEC_LOGICAL,"getmat");
01481       Fprintf(f,indent,"if(.not.getmat(fname,top,top-rhs+%d,it%d,m%d,n%d,lr%d,lc%d)) return\n",i1,i1,i1,i1,i1,i1);
01482       /* square matrix */
01483       if (var->el[0] == var->el[1]) {
01484         /* square matrix */ 
01485         AddDeclare(DEC_LOGICAL,"checkval");
01486         Fprintf(f,indent,"if(.not.checkval(fname,m%d,n%d)) return\n",i1,i1);
01487       }
01488       sprintf(str,"m%d",i1);
01489       Check(f,str,var,i1,0);
01490       sprintf(str,"n%d",i1);
01491       Check(f,str,var,i1,1);
01492       sprintf(str,"it%d",i1);
01493       if (var->type == IMATRIX ) AddForName1(var->el[2],str);
01494       break;
01495     case SPARSE:
01496       AddDeclare(DEC_LOGICAL,"getsparse");
01497       Fprintf(f,indent,"if(.not.getsparse(fname,top,top-rhs+%d,it%d,m%d,n%d,nel%d,mnel%d,icol%d,lr%d,lc%d)) return\n",i1,i1,i1,i1,i1,i1,i1,i1,i1);
01498       /* square matrix */
01499       if (var->el[0] == var->el[1]) {
01500         /* square matrix */ 
01501         AddDeclare(DEC_LOGICAL,"checkval");
01502         Fprintf(f,indent,"if(.not.checkval(fname,m%d,n%d)) return\n",i1,i1);
01503       }
01504       sprintf(str,"m%d",i1);
01505       Check(f,str,var,i1,0);
01506       sprintf(str,"n%d",i1);
01507       Check(f,str,var,i1,1);
01508       sprintf(str,"nel%d",i1);
01509       AddForName1(var->el[2],str);
01510       sprintf(str,"it%d",i1);
01511       AddForName1(var->el[3],str);
01512       break;
01513     case STRINGMAT:
01514       AddDeclare(DEC_LOGICAL,"getsmat");
01515       Fprintf(f,indent,"if(.not.getsmat(fname,top,top-rhs+%d,m%d,n%d,1,1,lr%d,nlr%d)) return\n",
01516               i1,i1,i1,i1,i1);
01517       /* square matrix */
01518       if (var->el[0] == var->el[1]) {
01519         /* square matrix */ 
01520         AddDeclare(DEC_LOGICAL,"checkval");
01521         Fprintf(f,indent,"if(.not.checkval(fname,m%d,n%d)) return\n",i1,i1);
01522       }
01523       sprintf(str,"m%d",i1);
01524       Check(f,str,var,i1,0);
01525       strcpy(str1,variables[var->el[0]-1]->name);
01526       sprintf(str,"n%d",i1);
01527       Check(f,str,var,i1,1);
01528       break;
01529     case ROW:
01530       AddDeclare(DEC_LOGICAL,"getvectrow");
01531       Fprintf(f,indent,"if(.not.getvectrow(fname,top,top-rhs+%d,it%d,m%d,n%d,lr%d,lc%d)) return\n",i1,i1,i1,i1,i1,i1);
01532       sprintf(str,"n%d",i1);
01533       Check(f,str,var,i1,0);
01534       break;
01535     case COLUMN:
01536       AddDeclare(DEC_LOGICAL,"getvectcol");
01537       Fprintf(f,indent,"if(.not.getvectcol(fname,top,top-rhs+%d,it%d,m%d,n%d,lr%d,lc%d)) return\n",i1,i1,i1,i1,i1,i1);
01538       sprintf(str,"m%d",i1);
01539       Check(f,str,var,i1,0);
01540       break;
01541     case VECTOR:
01542       AddDeclare(DEC_LOGICAL,"getvect");
01543       Fprintf(f,indent,"if(.not.getvect(fname,top,top-rhs+%d,it%d,m%d,n%d,lr%d,lc%d)) return\n",i1,i1,i1,i1,i1,i1);
01544       sprintf(str,"n%d*m%d",i1,i1);
01545       Check(f,str,var,i1,0);
01546       AddForName1(var->el[0],str);
01547       break;
01548     case POLYNOM:
01549       AddDeclare(DEC_LOGICAL,"getonepoly");
01550       sprintf(str,"namelr%d*4",i1);
01551       AddDeclare(DEC_CHAR,str);
01552       Fprintf(f,indent,"if(.not.getonepoly(fname,top,top-rhs+%d,it%d,m%d,namelr%d,namellr%d,lr%d,lc%d)\n",i1,i1,i1,i1,i1,i1,i1);
01553       AddDeclare(DEC_LOGICAL,"checkval");
01554       sprintf(str,"m%d",i1);
01555       Check(f,str,var,i1,0);
01556       AddForName(var->el[0],str);
01557       break;
01558     case SCALAR:
01559       AddDeclare(DEC_LOGICAL,"getscalar");
01560       Fprintf(f,indent,"if(.not.getscalar(fname,top,top-rhs+%d,lr%d)) return\n",i1,i1);
01561       break;
01562     case SCIMPOINTER:
01563     case SCISMPOINTER:
01564     case SCILPOINTER:
01565     case SCIBPOINTER:
01566     case SCIOPOINTER:
01567       sprintf(buf,"get%s", SGetSciType(var->type));
01568       AddDeclare(DEC_LOGICAL,buf);
01569       Fprintf(f,indent,"if(.not.get%s(fname,top,top-rhs+%d,lr%d)) return\n", SGetSciType(var->type),i1,i1);
01570       break;
01571     case STRING:
01572       AddDeclare(DEC_LOGICAL,"getsmat");
01573       Fprintf(f,indent,"if(.not.getsmat(fname,top,top-rhs+%d,m%d,n%d,1,1,lr%d,nlr%d)) return\n",i1,i1,i1,i1,i1,i1,11);
01574       AddDeclare(DEC_LOGICAL,"checkval");
01575       Fprintf(f,indent,"if(.not.checkval(fname,m%d*n%d,1)) return\n",i1,i1);
01576       sprintf(str,"nlr%d",i1);
01577       Check(f,str,var,i1,0);
01578       break;
01579     case ANY:
01580     case LIST:
01581     case TLIST:
01582       break;
01583     default:
01584       printf("unknown variable type %d\n",var->type);
01585     }
01586 }

Here is the call graph for this function:

void WriteCallConvertion ( FILE *  f,
IVAR  ivar,
char *  farg,
char *  barg,
char *  call 
)

Definition at line 1751 of file intersci.c.

References AddDeclare(), ANY, BMATRIX, BPOINTER, ChangeForName(), CHAR, COLUMN, CSTRINGV, DEC_LOGICAL, DOUBLE, Fprintf(), icre, IMATRIX, indent, INT, LIST, LPOINTER, MATRIX, MAXNAM, MPOINTER, OPOINTER, POLYNOM, REAL, ROW, SCALAR, SCIBPOINTER, SCILPOINTER, SCIMPOINTER, SCIOPOINTER, SCISMPOINTER, SEQUENCE, SGetForType(), SGetSciType(), SMPOINTER, SPARSE, str, str1, STRING, STRINGMAT, TLIST, var, variables, and VECTOR.

Referenced by WriteFortranCall().

01757 {
01758   VARPTR var = variables[ivar-1];
01759   char str[MAXNAM];
01760   char str1[MAXNAM];
01761   switch (var->type) 
01762     { 
01763     case POLYNOM:
01764     case ROW:
01765     case VECTOR:
01766     case SCALAR:
01767     case COLUMN:
01768     case IMATRIX:
01769     case MATRIX:
01770     case SPARSE:
01771       switch ( var->type )
01772         {
01773         case POLYNOM: sprintf(str1,"n%s",barg); break;
01774         case COLUMN: sprintf(str1,"m%s",barg); break ;
01775         case VECTOR:  sprintf(str1,"m%s*n%s",barg,barg); break ;
01776         case SCALAR:  sprintf(str1,"1"); break ;
01777         case ROW:  sprintf(str1,"n%s",barg); break;
01778         case SPARSE: sprintf(str1,"nel%s",barg);break;
01779         case IMATRIX:
01780         case MATRIX:  sprintf(str1,"n%s*m%s",barg,barg); break;
01781         }
01782       switch (var->for_type) 
01783         {
01784         case CHAR:
01785         case CSTRINGV:
01786           printf("incompatibility between the variable type and the FORTRAN type for variable \"%s\"\n",var->name);
01787           exit(1);
01788         case INT:
01789           Fprintf(f,indent,"call entier(%s,stk(lr%s),istk(iadr(lr%s)))\n",str1,barg,barg);
01790           if (var->type == IMATRIX || var->type == SPARSE) 
01791             {
01792               Fprintf(f,indent++,"if (it%s.eq.1) then \n",barg);
01793               Fprintf(f,indent,"call entier(%s,stk(lc%s),istk(iadr(lc%s)))\n",str1,barg,barg);
01794               Fprintf(f,--indent,"endif\n");
01795               if ( var->type == SPARSE) 
01796                 sprintf(str,"it%s,m%s,n%s,nel%s,istk(mnel%s),istk(icol%s),istk(iadr(lr%s)),istk(iadr(lc%s))"
01797                         ,barg,barg,barg,barg,barg,barg,barg,barg);
01798               else 
01799                 sprintf(str,"istk(iadr(lr%s)),istk(iadr(lc%s)),it%s",barg,barg,barg);
01800               ChangeForName(ivar,str);
01801               strcat(call,str);
01802               strcat(call,",");
01803             }
01804           else 
01805             {
01806               sprintf(str,"istk(iadr(lr%s))",barg);
01807               ChangeForName(ivar,str);
01808               strcat(call,str);
01809               strcat(call,",");
01810             }
01811           break;
01812         case REAL:
01813           Fprintf(f,indent,"call simple(%s,stk(lr%s),stk(lr%s))\n",str1,barg,barg,barg);
01814           if (var->type == IMATRIX || var->type == SPARSE)
01815             {
01816               Fprintf(f,indent++,"if (it%s.eq.1) then \n",barg);
01817               Fprintf(f,indent,"call simple(%s,stk(lc%s),stk(lc%s))\n",str1,barg,barg);
01818               Fprintf(f,--indent,"endif\n");
01819               if ( var->type == SPARSE) 
01820                 sprintf(str,"it%s,m%s,n%s,nel%s,istk(mnel%s),istk(icol%s),stk(lr%s),stk(lc%s),"
01821                         ,barg,barg,barg,barg,barg,barg,barg,barg);
01822               else 
01823                 sprintf(str,"stk(lr%s),stk(lc%s),it%s,",barg,barg,barg);
01824               strcat(call,str);
01825             }
01826           else 
01827             {
01828               sprintf(str,"stk(lr%s),",barg);
01829               strcat(call,str);
01830             }
01831           break;
01832         case DOUBLE:
01833           if (var->type == IMATRIX) 
01834             {
01835               sprintf(str,"stk(lr%s),stk(lc%s),it%s,",barg,barg,barg);
01836               strcat(call,str);
01837             }
01838           else if (var->type == SPARSE) 
01839             {
01840               sprintf(str,"it%s,m%s,n%s,nel%s,istk(mnel%s),istk(icol%s),stk(lr%s),stk(lc%s),"
01841                       ,barg,barg,barg,barg,barg,barg,barg,barg);
01842               strcat(call,str);
01843             }
01844           else 
01845             {
01846               sprintf(str,"stk(lr%s),",barg);
01847               strcat(call,str);
01848             }
01849           break;
01850         }    
01851       break;
01852     case BMATRIX:
01853       sprintf(str1,"n%s*m%s",barg,barg);
01854       if (var->for_type != INT) 
01855         {
01856           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01857                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01858           exit(1);
01859         }
01860       sprintf(str,"istk(lr%s)",barg);
01861       ChangeForName(ivar,str);
01862       strcat(call,str);
01863       strcat(call,",");
01864       break;
01865     case SCIMPOINTER:
01866       if (var->for_type != MPOINTER) 
01867         {
01868           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01869                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01870           exit(1);
01871         }
01872       sprintf(str,"stk(lr%s),",barg);
01873       strcat(call,str);
01874       break;
01875     case SCISMPOINTER:
01876       if (var->for_type != SMPOINTER) 
01877         {
01878           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01879                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01880           exit(1);
01881         }
01882       sprintf(str,"stk(lr%s),",barg);
01883       strcat(call,str);
01884       break;
01885     case SCILPOINTER:
01886       if (var->for_type != LPOINTER) 
01887         {
01888           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01889                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01890           exit(1);
01891         }
01892       sprintf(str,"stk(lr%s),",barg);
01893       strcat(call,str);
01894       break;
01895     case SCIBPOINTER:
01896       if (var->for_type != BPOINTER) 
01897         {
01898           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01899                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01900           exit(1);
01901         }
01902       sprintf(str,"stk(lr%s),",barg);
01903       strcat(call,str);
01904       break;
01905     case SCIOPOINTER:
01906       if (var->for_type != OPOINTER) 
01907         {
01908           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01909                  SGetSciType(var->type),SGetForType(var->for_type),var->name);
01910           exit(1);
01911         }
01912       sprintf(str,"stk(lr%s),",barg);
01913       strcat(call,str);
01914       break;
01915     case STRINGMAT:
01916       if (var->for_type != CSTRINGV) 
01917         {
01918           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01919                  SGetSciType(STRINGMAT),SGetForType(var->for_type),var->name);
01920           exit(1);
01921         }
01922       AddDeclare(DEC_LOGICAL,"crestringv");
01923       Fprintf(f,indent,"if(.not.crestringv(fname,top+%d,lr%s-5-m%s*n%s,lw%s)) return\n",icre++,barg,barg,barg,farg);
01924       sprintf(str,"stk(lw%s),",farg);
01925       strcat(call,str);
01926       break;
01927     case LIST:
01928     case TLIST:
01929     case SEQUENCE:
01930       printf("a FORTRAN argument cannot have a variable type of \"LIST\"\n");
01931       printf("  \"TLIST\" or \"SEQUENCE\"\n");
01932       exit(1);
01933       break;
01934     case STRING:
01935       if (var->for_type != CHAR) 
01936         {
01937           printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
01938                  SGetSciType(STRING),SGetForType(var->for_type),var->name);
01939           exit(1);
01940         }
01941       AddDeclare(DEC_LOGICAL,"bufstore");
01942       Fprintf(f,indent,"if(.not.bufstore(fname,lbuf,lbufi%s,lbuff%s,lr%s,nlr%s)) return\n",farg,farg,barg,barg);
01943       sprintf(str,"buf(lbufi%s:lbuff%s),",farg,farg);
01944       strcat(call,str);
01945       break;
01946     case ANY:
01947       sprintf(str,"istk(il%s),",barg);
01948       strcat(call,str);
01949       break;
01950     }
01951 }

Here is the call graph for this function:

Here is the caller graph for this function:

void WriteCallRest ( FILE *  f,
IVAR  ivar,
int  farg,
char *  call 
)

Definition at line 1959 of file intersci.c.

References AddDeclare(), AddForName1(), ANY, BMATRIX, buf, CHAR, COLUMN, CSTRINGV, DEC_DOUBLE, DEC_INT, DEC_LOGICAL, DEC_REAL, DOUBLE, EXTERNAL, var::for_name, Forname2Int(), Fprintf(), icre, IMATRIX, indent, INT, LIST, MATRIX, MAXNAM, POLYNOM, PREDEF, REAL, ROW, SCALAR, SCIBPOINTER, SCILPOINTER, SCIMPOINTER, SCIOPOINTER, SCISMPOINTER, SEQUENCE, SGetForType(), SGetSciType(), SPARSE, str, str1, str2, str3, str4, STRING, STRINGMAT, TLIST, var, variables, VECTOR, WORK, and WriteCallRestCheck().

01964 {
01965   VARPTR var = variables[ivar-1];
01966   char str[MAXNAM];
01967   char str1[MAXNAM];
01968   char str2[MAXNAM];
01969   char str3[MAXNAM];
01970   char str4[MAXNAM];
01971   switch (var->type) 
01972     {
01973     case 0:
01974       /* FORTRAN argument is the dimension of an output variable with EXTERNAL type */
01975       if (var->nfor_name == 0 && var->for_type != PREDEF) 
01976         {
01977           printf("dimension variable \"%s\" is not defined\n",var->name);
01978           exit(1);
01979         }
01980       switch (var->for_type) 
01981         {
01982         case PREDEF:
01983           if ( strcmp(var->name,"rhs") == 0) 
01984             sprintf(str,"rhsk");
01985           else 
01986             sprintf(str,"%s",var->name);
01987           strcat(call,str);
01988           strcat(call,",");
01989           break;
01990         case 0:
01991         case INT:
01992           sprintf(str,"%s",var->for_name[0]);
01993           if ( ~isdigit(str[0])) 
01994             {
01995               strcat(call,str);
01996               strcat(call,",");
01997             }
01998           else 
01999             {
02000               Fprintf(f,indent,"locd%d= int(%s)\n",farg,var->for_name[0]);
02001               sprintf(str,"locd%d,",farg);
02002               strcat(call,str);
02003               sprintf(str,"locd%d",farg);
02004               AddDeclare(DEC_INT,str);
02005             }
02006           break;
02007         case DOUBLE:
02008           Fprintf(f,indent,"locd%d= dble(%s)\n",farg,var->for_name[0]);
02009           sprintf(str,"locd%d,",farg);
02010           strcat(call,str);
02011           sprintf(str,"locd%d",farg);
02012           AddDeclare(DEC_DOUBLE,str);
02013           break;
02014         case REAL:
02015           Fprintf(f,indent,"locr%d=real(%s)\n",farg,var->for_name[0]);
02016           sprintf(str,"locr%d,",farg);
02017           strcat(call,str);
02018           sprintf(str,"locr%d",farg);
02019           AddDeclare(DEC_REAL,str);
02020           break;
02021         case CHAR:
02022         case CSTRINGV:
02023           printf("a dimension variable cannot have FORTRAN type \"%s\"\n",SGetForType(var->for_type));
02024           exit(1);
02025           break;
02026         }
02027       break;
02028     /* working or output argument (always double reservation!) */
02029     case COLUMN:
02030     case ROW:
02031     case WORK:
02032     case POLYNOM:
02033     case VECTOR:
02034       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02035       if (var->for_type == EXTERNAL) 
02036         strcpy(str1,"1");
02037       else 
02038         strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02039       AddDeclare(DEC_LOGICAL,"cremat");
02040       Fprintf(f,indent,"if(.not.cremat(fname,top+%d,0,%s,1,lw%d,loc%d)) return\n",icre++,str1,farg,farg);
02041       sprintf(str,"stk(lw%d),",farg);
02042       strcat(call,str);
02043       break;
02044     case SPARSE :
02045       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02046       WriteCallRestCheck(f,var,farg,"mm",1,0) ;
02047       if (var->for_type == EXTERNAL) 
02048         {
02049           strcpy(str1,"1");
02050           strcpy(str2,"1");
02051           Fprintf(f,indent,"if(.not.cremat(fname,top+%d,0,%s,%s,lw%d,lwc%d)) return\n",icre++,str1,str2,farg,farg);
02052           AddDeclare(DEC_LOGICAL,"cremat");
02053           sprintf(str,"stk(lw%d),",farg);
02054           strcat(call,str);
02055         } 
02056       else 
02057         {
02058           sprintf(str1,"%s",Forname2Int(variables[var->el[0]-1]->for_name[0]));
02059           sprintf(str2,"%s",Forname2Int(variables[var->el[1]-1]->for_name[0]));
02060           sprintf(str3,"%s",Forname2Int(variables[var->el[2]-1]->for_name[0]));
02061           sprintf(str4,"%s",Forname2Int(variables[var->el[3]-1]->for_name[0]));
02062           AddDeclare(DEC_LOGICAL,"cresparse");
02063           Fprintf(f,indent,"if(.not.cresparse(fname,top+%d,%s,%s,%s,%s,mnel%d,icol%d,lw%d,lwc%d)) return\n",icre++,str4,str1,str2,str3,farg,farg,farg,farg);
02064           sprintf(str,"%s,%s,%s,%s,istk(mnel%d),istk(icol%d),stk(lw%d),stk(lwc%d),",
02065                   str4,str1,str2,str3,farg,farg,farg,farg);
02066           strcat(call,str);
02067         }
02068       break;
02069     case IMATRIX:
02070       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02071       WriteCallRestCheck(f,var,farg,"mm",1,0) ;
02072       if (var->for_type == EXTERNAL) 
02073         {
02074           strcpy(str1,"1");
02075           strcpy(str2,"1");
02076           strcpy(str3,"1");
02077         } 
02078       else 
02079         {
02080           sprintf(str1,"%s",Forname2Int(variables[var->el[0]-1]->for_name[0]));
02081           sprintf(str2,"%s",Forname2Int(variables[var->el[1]-1]->for_name[0]));
02082           sprintf(str3,"%s",Forname2Int(variables[var->el[2]-1]->for_name[0]));
02083         };
02084       AddDeclare(DEC_LOGICAL,"cremat");
02085       Fprintf(f,indent,"if(.not.cremat(fname,top+%d,%s,%s,%s,lw%d,lwc%d)) return\n",icre++,str3,str1,str2,farg,farg);
02086       sprintf(str3,"%s",Forname2Int(variables[var->el[2]-1]->for_name[0]));
02087       sprintf(str,"stk(lw%d),stk(lwc%d),%s,",farg,farg,str3);
02088       strcat(call,str);
02089       break;
02090     case MATRIX:
02091       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02092       WriteCallRestCheck(f,var,farg,"mm",1,0) ;
02093       if (var->for_type == EXTERNAL) 
02094         {
02095           strcpy(str1,"1");
02096           strcpy(str2,"1");
02097         } 
02098       else 
02099         {
02100           sprintf(str1,"%s",Forname2Int(variables[var->el[0]-1]->for_name[0]));
02101           sprintf(str2,"%s",Forname2Int(variables[var->el[1]-1]->for_name[0]));
02102         };
02103       AddDeclare(DEC_LOGICAL,"cremat");
02104       Fprintf(f,indent,"if(.not.cremat(fname,top+%d,0,%s,%s,lw%d,lwc%d)) return\n",icre++,str1,str2,farg,farg);
02105       sprintf(str,"stk(lw%d),",farg);
02106       strcat(call,str);
02107       break;
02108     case BMATRIX:
02109       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02110       WriteCallRestCheck(f,var,farg,"mm",1,0) ;
02111       if (var->for_type == EXTERNAL) 
02112         {
02113           strcpy(str1,"1");
02114           strcpy(str2,"1");
02115         } 
02116       else 
02117         {
02118           sprintf(str1,"%s",Forname2Int(variables[var->el[0]-1]->for_name[0]));
02119           sprintf(str2,"%s",Forname2Int(variables[var->el[1]-1]->for_name[0]));
02120         };
02121       AddDeclare(DEC_LOGICAL,"crebmat");
02122       Fprintf(f,indent,"if(.not.crebmat(fname,top+%d,%s,%s,lw%d)) return\n",icre++,str1,str2,farg);
02123       sprintf(str,"istk(lw%d),",farg);
02124       strcat(call,str);
02125       break;
02126     case SCIMPOINTER:
02127     case SCISMPOINTER:
02128     case SCILPOINTER:
02129     case SCIBPOINTER:
02130     case SCIOPOINTER:
02131       sprintf(buf,"cre%s", SGetSciType(var->type));
02132       AddDeclare(DEC_LOGICAL,buf);
02133       Fprintf(f,indent,"if(.not.cre%s(fname,top+%d,lw%d)) return\n", SGetSciType(var->type),icre++,farg);
02134       sprintf(str,"stk(lw%d),",farg);
02135       strcat(call,str);
02136       break;
02137     case STRINGMAT:
02138       if (var->for_type == EXTERNAL || var->for_type == CSTRINGV )
02139         {
02140           /* for external or cstringv parameters, unknown formal dimensions 
02141              can be used */
02142           WriteCallRestCheck(f,var,farg,"mm",0,1) ;
02143           WriteCallRestCheck(f,var,farg,"nn",1,1) ;
02144           sprintf(str,"mm%d",farg);
02145           AddForName1(var->el[0],str);
02146           sprintf(str,"nn%d",farg);
02147           AddForName1(var->el[1],str);
02148           AddDeclare(DEC_LOGICAL,"crepointer");
02149           Fprintf(f,indent,"if(.not.crepointer(fname,top+%d,lw%d)) return\n",icre++,farg);
02150           sprintf(str,"stk(lw%d),",farg);
02151           strcat(call,str);
02152         }
02153       else 
02154         {
02156           fprintf(stderr,"WARNING : your code contains a specification \n");
02157           fprintf(stderr," not fully implemented in intersci \n");
02158           WriteCallRestCheck(f,var,farg,"mm",0,0) ;
02159           WriteCallRestCheck(f,var,farg,"nn",1,0) ;
02160           AddDeclare(DEC_LOGICAL,"cresmatafaire");
02161           Fprintf(f,indent,"if(.not.cresmatafaire(fname,top+%d,lw%d)) return\n",icre++,farg);
02162           sprintf(str,"stk(lw%d),",farg);
02163           strcat(call,str);
02164         }
02165       break;
02166     case SCALAR:
02167       AddDeclare(DEC_LOGICAL,"cremat");
02168       Fprintf(f,indent,"if(.not.cremat(fname,top+%d,0,1,1,lw%d,loc%d)) return\n",icre++,farg,farg);
02169       sprintf(str,"stk(lw%d),",farg);
02170       strcat(call,str);
02171       break;
02172     case STRING:
02173       WriteCallRestCheck(f,var,farg,"nn",0,0) ;
02174       if (var->for_type == EXTERNAL) 
02175         {
02176           AddDeclare(DEC_LOGICAL,"crepointer");
02177           Fprintf(f,indent,"if(.not.crepointer(fname,top+%d,lw%d)) return\n",icre++,farg);
02178           sprintf(str,"stk(lw%d),",farg);
02179           strcat(call,str);
02180         }
02181       else 
02182         {
02183           strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02184           AddDeclare(DEC_LOGICAL,"cresmat2");
02185           Fprintf(f,indent,"if(.not.cresmat2(fname,top+%d,%s,lr%d)) return\n",icre++,str1,farg);
02186           AddDeclare(DEC_LOGICAL,"bufstore");
02187           Fprintf(f,indent,"if(.not.bufstore(fname,lbuf,lbufi%d,lbuff%d,lr%d,%s)) return\n",farg,farg,farg,str1);
02188           sprintf(str,"buf(lbufi%d:lbuff%d),",farg,farg);
02189           strcat(call,str);
02190         }
02191       break;
02192     case LIST:
02193     case TLIST:
02194     case SEQUENCE:
02195     case ANY:
02196       printf("work or output FORTRAN argument cannot have\n");
02197       printf("  type \"ANY\", \"LIST\", \"TLIST\" or \"SEQUENCE\"\n");
02198       exit(1);
02199       break;
02200     }
02201 }

Here is the call graph for this function:

void WriteCallRestCheck ( FILE *  f,
var  ,
int  farg,
char *  name,
int  iel,
int  flag 
)

Definition at line 2210 of file intersci.c.

References AddForName1(), Fprintf(), ind, indent, j, MAXNAM, var::name, var::nfor_name, str, and variables.

02215 {
02216   char sdim[MAXNAM]; 
02217   char str[MAXNAM];
02218   int ind,j;
02219   if (variables[var->el[iel]-1]->nfor_name == 0) 
02220     {
02221       strcpy(str,variables[var->el[iel]-1]->name);
02222       if (isdigit(str[0]) == 0) 
02223         {
02224           ind = 0;
02225           for (j = 0; j < basfun->nin; j++) 
02226             {
02227               if (strcmp(variables[var->el[iel]-1]->name,
02228                          variables[basfun->in[j]-1]->name) == 0) 
02229                 {
02230                   /* dimension of FORTRAN argument is a SCILAB argument */
02231                   sprintf(sdim,"%s%d",name,farg);
02232                   Fprintf(f,indent,"%s= int(stk(lr%d))\n",sdim,j+1);
02233                   AddForName1(var->el[iel],sdim);
02234                   ind = 1;
02235                   break;
02236                 }
02237             }
02238           if (ind == 0 && flag != 1 ) 
02239             {
02245             }
02246         } 
02247       else 
02248         {
02249           sprintf(sdim,"%s%d",name,farg);
02250           Fprintf(f,indent,"%s=%s\n",sdim,str);
02251           AddForName1(var->el[iel],sdim);
02252         }
02253     }
02254 }

Here is the call graph for this function:

void WriteCrossCheck ( FILE *  f  ) 

Definition at line 1630 of file intersci.c.

References AddDeclare(), DEC_LOGICAL, FCprintf(), Forname2Int(), Fprintf(), i, indent, j, n1, n2, nVariable, var, and variables.

01632 {
01633   int i, j;
01634   char *n1, *n2;
01635   VARPTR var;
01636   FCprintf(f,"c     \n");        
01637   FCprintf(f,"c       cross variable size checking\n"); 
01638   FCprintf(f,"c     \n");               
01639   for (i = 0; i < nVariable; i++) {
01640     var = variables[i];
01641     /* does not check list elements */
01642     if (var->nfor_name != 0 && var->list_el == 0) {
01643       if (strncmp(var->for_name[0],"ne",2) != 0 &&
01644           strncmp(var->for_name[0],"me",2) != 0) {
01645         n1 = Forname2Int(var->for_name[0]);
01646         for (j = 1; j < var->nfor_name; j++) {
01647           n2 = Forname2Int(var->for_name[j]);
01648           if ( strcmp(n1,n2) != 0) 
01649             {
01650               AddDeclare(DEC_LOGICAL,"checkval");
01651               Fprintf(f,indent,"if(.not.checkval(fname,%s,%s)) return\n",n1,n2);
01652             }
01653         }
01654       }
01655     }
01656   }
01657   /*  FCprintf(f,"c     \n");        
01658   FCprintf(f,"c       cross formal parameter checking\n");
01659   FCprintf(f,"c       not implemented yet\n");  */
01660 }

Here is the call graph for this function:

void WriteDeclaration ( FILE *  f  ) 

Definition at line 3274 of file intersci.c.

References Fprintf(), i, indent, Init, j, Declare::ndecls, and type.

03276 {
03277   int j = 0;
03278   int i;
03279   while ( Init[j].type != -1) 
03280     {
03281       if ( Init[j].ndecls != 0) 
03282         Fprintf(f,indent,"%s ",Init[j].name);
03283       for (i= 0 ; i < Init[j].ndecls ; i++) 
03284         {
03285           Fprintf(f,indent,"%s",Init[j].decls[i]);
03286           if ( i != Init[j].ndecls -1 ) Fprintf(f,indent,",");
03287           else Fprintf(f,indent,"\n");
03288         }
03289       j++;
03290     }
03291 }

Here is the call graph for this function:

void WriteEqualCheck ( FILE *  f  ) 

Definition at line 1662 of file intersci.c.

01664 {
01665   /* FCprintf(f,"c     \n");        
01666   FCprintf(f,"c       cross equal output variable checking\n");
01667   FCprintf(f,"c       not implemented yet\n"); */
01668 }

void WriteExternalVariableOutput ( FILE *  f,
VARPTR  var,
int  farg,
int  insidelist,
int  nel 
)

Definition at line 2659 of file intersci.c.

References AddDeclare(), BMATRIX, COLUMN, DEC_LOGICAL, var::for_name, Forname2Int(), Fprintf(), IMATRIX, indent, MATRIX, MAXNAM, var::name, POLYNOM, ROW, SCALAR, SPARSE, str, str1, str2, str3, str4, STRING, STRINGMAT, var, variables, and VECTOR.

Referenced by WriteVariable().

02664 {
02665   char str[MAXNAM];
02666   char str1[MAXNAM];
02667   char str2[MAXNAM];
02668   char str3[MAXNAM];
02669   char str4[MAXNAM];
02670   switch (var->type) {
02671   case COLUMN:
02672   case ROW:
02673   case VECTOR:
02674   case MATRIX:
02675   case SCALAR:
02676     switch ( var->type  ) 
02677       {
02678       case COLUMN:
02679         strcpy(str2,"1");
02680         strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02681         break;
02682       case ROW:
02683       case VECTOR:
02684         strcpy(str1,"1");
02685         strcpy(str2,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02686         break;
02687       case MATRIX:
02688         strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02689         strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02690         break;
02691       case SCALAR:
02692         strcpy(str1,"1");
02693         strcpy(str2,"1");
02694         break;
02695       }
02696     if ( insidelist != 0)
02697       {
02698         AddDeclare(DEC_LOGICAL,"listcremat");
02699         Fprintf(f,indent,"if(.not.listcremat(fname,top,%d,lw,0,%s,%s,lrs,lcs)) return\n",nel,
02700                 str1,str2);
02701       }
02702     else 
02703       {
02704         AddDeclare(DEC_LOGICAL,"cremat");
02705         Fprintf(f,indent,"if(.not.cremat(fname,top,0,%s,%s,lrs,lcs)) return\n",str1,str2);
02706       }
02707     sprintf(str,"lw%d",farg);
02708     Fprintf(f,indent,"call %s(%s*%s,stk(%s),stk(lrs))\n",  var->fexternal,str1,str2,str);
02709     break;
02710   case IMATRIX:
02711     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02712     strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02713     strcpy(str3,Forname2Int(variables[var->el[2]-1]->for_name[0]));
02714     if ( insidelist != 0)
02715       {
02716         AddDeclare(DEC_LOGICAL,"listcremat");
02717         Fprintf(f,indent,"if(.not.listcremat(fname,top,%d,lw,%s,%s,%s,lrs,lcs)) return\n",
02718                 nel,str3,str1,str2);
02719       }
02720     else 
02721       {
02722         AddDeclare(DEC_LOGICAL,"cremat");
02723         Fprintf(f,indent,"if(.not.cremat(fname,top,%s,%s,%s,lrs,lcs)) return\n",str3,str1,str2);
02724       }
02725     sprintf(str,"lw%d",farg);
02726     Fprintf(f,indent,"call %s(%s*%s,stk(%s),stk(lrs))\n",  var->fexternal,str1,str2,str);
02727     sprintf(str,"lwc%d",farg);
02728     Fprintf(f,indent++,"if  (%s.eq.1) then \n",str3);
02729     Fprintf(f,indent,"call %s(%s*%s,stk(%s),stk(lcs))\n",  var->fexternal,str1,str2,str);
02730     Fprintf(f,--indent,"endif\n");
02731     break;
02732   case SPARSE:
02733     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02734     strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02735     strcpy(str3,Forname2Int(variables[var->el[2]-1]->for_name[0]));
02736     strcpy(str4,Forname2Int(variables[var->el[3]-1]->for_name[0]));
02737     if ( insidelist != 0)
02738       {
02739         AddDeclare(DEC_LOGICAL,"listcresparse");
02740         Fprintf(f,indent,"if(.not.listcresparse(fname,top,%d,lw,%s,%s,%s,%s,mnels,icols,lrs,lcs)) return\n"
02741                 ,nel,str4,str1,str2,str3);
02742       }
02743     else 
02744       {
02745         AddDeclare(DEC_LOGICAL,"cresparse");
02746         Fprintf(f,indent,"if(.not.cresparse(fname,top,%s,%s,%s,%s,mnels,icols,lrs,lcs)) return\n"
02747                 ,str4,str1,str2,str3);
02748       }
02749     sprintf(str,"lw%d",farg);
02750     Fprintf(f,indent,"call %s(stk(%s),istk(mnels),istk(icols),stk(lrs),stk(lcs))\n",var->fexternal,str);
02751     break;
02752   case BMATRIX:
02753     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02754     strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02755     if ( insidelist != 0)
02756       {
02757         AddDeclare(DEC_LOGICAL,"listcrebmat");
02758         Fprintf(f,indent,"if(.not.listcrebmat(fname,top,%d,lw,%s,%s,lrs)) return\n",
02759                 nel,str1,str2);
02760       }
02761     else 
02762       {
02763         AddDeclare(DEC_LOGICAL,"crebmat");
02764         Fprintf(f,indent,"if(.not.crebmat(fname,top,%s,%s,lrs)) return\n",str1,str2);
02765       }
02766     sprintf(str,"lw%d",farg);
02767     Fprintf(f,indent,"call %s(%s*%s,istk(%s),istk(lrs))\n",var->fexternal,str1,str2,str);
02768     break;
02769   case POLYNOM:
02770     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02771     strcpy(str2,variables[var->el[1]-1]->name);
02772     Fprintf(f,indent,"err=sadr(ilw+10)+%s-lstk(bot)\n",str1);
02773     Fprintf(f,indent,"if(err .gt. 0) then\n");
02774     Fprintf(f,indent,"call error(17)\n");
02775     Fprintf(f,indent,"return\n");
02776     Fprintf(f,indent,"endif\n");
02777     Fprintf(f,indent,"istk(ilw)=1\n");
02778     Fprintf(f,indent,"istk(ilw+1)=1\n");                    
02779     Fprintf(f,indent,"istk(ilw+2)=1\n");
02780     Fprintf(f,indent,"istk(ilw+3)=0\n");
02781     Fprintf(f,indent,"call cvstr(4,'%s    ',istk(ilw+4),0)\n",str2);
02782     /* str2 comes from SCILAB input ??? */
02783     Fprintf(f,indent,"istk(ilw+8)=1\n");
02784     Fprintf(f,indent,"istk(ilw+9)=1+%s\n",str1);
02785     sprintf(str,"lw%d",farg);
02786     Fprintf(f,indent,"lw=sadr(ilw+10)\n");
02787     Fprintf(f,indent,"call %s(%s,stk(%s),stk(lw))\n",
02788             var->fexternal,str1,str);
02789     Fprintf(f,indent,"lw=lw+%s\n",str1);
02790     break;
02791   case STRING:
02792     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02793     if ( insidelist != 0)
02794       {
02795         AddDeclare(DEC_LOGICAL,"listcrestring");
02796         Fprintf(f,indent,"if(.not.listcrestring(fname,top,%d,lw,%s,ilrs)) return\n",nel,str1,str2);
02797       }
02798     else 
02799       {
02800         AddDeclare(DEC_LOGICAL,"crestring");
02801         Fprintf(f,indent,"if(.not.crestring(fname,top,%s,ilrs)) return\n",str1);
02802       }
02803     sprintf(str,"lw%d",farg);   
02804     Fprintf(f,indent,"call %s(%s,stk(%s),istk(ilrs))\n", var->fexternal,str1,str);
02805     break;
02806   case STRINGMAT:
02807     strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02808     strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02809     sprintf(str,"lw%d",farg);
02810     Fprintf(f,indent,"call %s(stk(%s),istk(ilw),%s,%s,lstk(bot)-sadr(ilw),ierr)\n",
02811             var->fexternal,str,str1,str2);
02812     Fprintf(f,indent,"if(ierr .gt. 0) then\n");
02813     Fprintf(f,indent,"buf='not enough memory'\n");
02814     Fprintf(f,indent,"call error(1000)\n");
02815     Fprintf(f,indent,"return\n");
02816     Fprintf(f,indent,"endif\n");
02817     sprintf(str,"istk(ilw+4+%s*%s)-1",str1,str2);
02818     Fprintf(f,indent,"lw=sadr(ilw+5+%s*%s+%s)\n",str1,str2,str);
02819     break;
02820   }
02821 }

Here is the call graph for this function:

Here is the caller graph for this function:

void WriteFortranCall ( FILE *  f  ) 

Definition at line 1670 of file intersci.c.

References GetExistVar(), i, ind, j, MAXCALL, str1, str2, variables, and WriteCallConvertion().

01672 {
01673   int i, j, ind;
01674   IVAR ivar, iivar;
01675   char call[MAXCALL];
01676   char str1[8],str2[8];
01677   sprintf(call,"call %s(",forsub->name);
01678   /* loop on FORTRAN arguments */
01679   for (i = 0; i < forsub->narg; i++) 
01680     {
01681       ivar = forsub->arg[i];
01682       ind = 0;
01683       if (variables[ivar-1]->list_el != 0) 
01684         {
01685           /* FORTRAN argument is a list element */
01686           iivar = GetExistVar(variables[ivar-1]->list_name);
01687           for (j = 0; j < basfun->nin; j++) 
01688             {
01689               if (iivar == basfun->in[j]) 
01690                 {
01691                   /* it must be a SCILAB argument */
01692                   sprintf(str1,"%de%d",iivar,variables[ivar-1]->list_el);
01693                   sprintf(str2,"%de%d",iivar,variables[ivar-1]->list_el);
01694                   WriteCallConvertion(f,ivar,str2,str1,call);
01695                   ind = 1;
01696                   break;
01697                 }
01698             }
01699           if (ind == 0) 
01700             {
01701               printf("list or tlist \"%s\" must be an argument of SCILAB function\n",
01702                      variables[ivar-1]->list_name);
01703               exit(1);
01704             }
01705         }
01706       else 
01707         {
01708           for (j = 0; j < basfun->nin; j++) 
01709             {
01710               if (ivar == basfun->in[j]) 
01711                 {
01712                   /* FORTRAN argument is a SCILAB argument */
01713                   sprintf(str1,"%d",j+1);
01714                   sprintf(str2,"%d",i+1);
01715                   WriteCallConvertion(f,ivar,str2,str1,call);
01716                   ind = 1;
01717                   break;
01718                 }
01719             }
01720         }
01721       if (ind == 0) 
01722         {
01723           /* FORTRAN argument is not a SCILAB argument */
01724           WriteCallRest(f,ivar,i+1,call);
01725         }
01726     }
01727   if  (forsub->narg == 0) 
01728     strcat(call,")");
01729   else 
01730     call[strlen(call)-1] = ')';
01731   Fprintf(f,indent,call);
01732   Fprintf(f,indent,"\n");
01733   /*    
01734       Fprintf(f,indent++,"if(err .gt. 0) then \n");  
01735       Fprintf(f,indent,"buf = fname // ' Internal Error' \n");  
01736       Fprintf(f,indent,"call error(999)\n");
01737       Fprintf(f,indent,"return\n");
01738       Fprintf(f,--indent,"endif\n");
01739   */
01740   Fprintf(f,indent,"if(err .gt. 0 .or. err1 .gt. 0) return \n");  
01741 
01742   FCprintf(f,"c\n");
01743 }

Here is the call graph for this function:

void WriteFunctionCode ( FILE*  f  ) 

Definition at line 1239 of file intersci.c.

References CHAR, FCprintf(), var::for_type, Fprintf(), i, icre, indent, nFun, pass, variables, and WriteHeader().

01241 {
01242   int i;
01243   IVAR ivar;
01244   icre=1;
01245   if ( pass == 1) 
01246     {
01247       printf("  generating  code for SCILAB function\"%s\"\n",
01248              basfun->name);
01249       printf("    and FORTRAN subroutine\"%s\"\n",forsub->name);
01250     }
01251   FCprintf(f,"c SCILAB function : %s, fin = %d\n",basfun->name,nFun);
01252   WriteHeader(f,"ints",basfun->name);
01253   
01254   /* possibly init for string flag */
01255   for (i = 0; i < forsub->narg; i++) 
01256     {
01257       if (variables[forsub->arg[i]-1]->for_type == CHAR) 
01258         {
01259           Fprintf(f,indent,"lbuf = 1\n");
01260           break;
01261         }
01262     }
01263   
01264   /* init for work space */
01265   
01266   AddDeclare(DEC_INT,"topk");
01267   AddDeclare(DEC_INT,"rhsk");
01268   Fprintf(f,indent,"topk = top \n");
01269   Fprintf(f,indent,"rhsk = rhs \n");
01270   
01271   /* rhs argument number checking */
01272   AddDeclare(DEC_LOGICAL,"checkrhs");
01273   Fprintf(f,indent,"if(.not.checkrhs(fname,%d,%d)) return\n",basfun->nin - maxOpt,basfun->nin);
01274   
01275   /* lhs argument number checking */
01276   ivar = basfun->out;
01277   if ((variables[ivar-1]->length == 0) || (variables[ivar-1]->type == LIST)
01278       || (variables[ivar-1]->type == TLIST))
01279     {
01280       AddDeclare(DEC_LOGICAL,"checklhs");
01281       Fprintf(f,indent,"if(.not.checklhs(fname,1,1)) return\n");
01282     }
01283   else 
01284     {
01285       AddDeclare(DEC_LOGICAL,"checklhs");
01286       Fprintf(f,indent,"if(.not.checklhs(fname,1,%d)) return\n",variables[ivar-1]->length);
01287     }
01288   
01289   /* SCILAB argument checking */
01290   for (i = 0; i < basfun->nin; i++)
01291     {
01292       switch ( variables[i]->type ) 
01293         {
01294         case LIST : 
01295         case TLIST:
01296           WriteListAnalysis(f,i);
01297           break;
01298         default:
01299           WriteArgCheck(f,i);
01300           break;
01301         }
01302     }
01303 
01304   /* SCILAB cross checking */
01305 
01306   WriteCrossCheck(f);
01307   
01308   /* SCILAB equal output variable checking */
01309   WriteEqualCheck(f);
01310   
01311   /* FORTRAN call */
01312   WriteFortranCall(f);
01313   
01314   /* FORTRAN output to SCILAB */
01315   WriteOutput(f);
01316 }

Here is the call graph for this function:

void WriteHeader ( FILE *  f,
char*  fname0,
char*  fname 
)

Definition at line 1217 of file intersci.c.

References FCprintf(), Fprintf(), getenv(), indent, NULL, and WriteDeclaration().

01220 {
01221   char *scidir;
01222   Fprintf(f,indent,"subroutine %s%s(fname)\n",fname0,fname);
01223   FCprintf(f,"c\n"); 
01224   Fprintf(f,indent,"character*(*) fname\n");
01225   scidir = getenv("SCI");
01226   if ( scidir != NULL) 
01227     Fprintf(f,indent,"include '%s/routines/stack.h'\n",scidir);
01228   else 
01229     Fprintf(f,indent,"include 'SCIDIR/routines/stack.h'\n");
01230   FCprintf(f,"c\n");
01231   Fprintf(f,indent,"integer iadr, sadr\n");
01232   WriteDeclaration(f);
01233   Fprintf(f,indent,"iadr(l)=l+l-1\n");
01234   Fprintf(f,indent,"sadr(l)=(l/2)+1\n");
01235   Fprintf(f,indent,"rhs = max(0,rhs)\n");
01236   FCprintf(f,"c\n");
01237 }

Here is the call graph for this function:

void WriteInfoCode ( FILE*  f  ) 

Definition at line 1319 of file intersci.c.

References var::el, EMPTY, GetExistOutVar(), i, var::length, LIST, SEQUENCE, SGetSciType(), TLIST, type, var::type, var, and variables.

01321 {
01322   int i,iout;
01323   IVAR ivar;
01324   VARPTR var,vout;
01325 
01326   iout = GetExistOutVar();
01327   vout = variables[iout -1];
01328 
01329   switch (vout->type) {
01330   case LIST:
01331   case TLIST:
01332     /* loop on output variables */
01333     printf("list(");
01334     for (i = 0; i < vout->length; i++) 
01335       {
01336         ivar = vout->el[i];
01337         var = variables[ivar-1];
01338         printf("%s",var->name);
01339         if ( i != vout->length -1 ) 
01340           printf(",");
01341         else
01342           printf(")");
01343       }
01344     break ;
01345   case SEQUENCE:
01346     /* loop on output variables */
01347     printf("[");
01348     for (i = 0; i < vout->length; i++) 
01349       {
01350         ivar = vout->el[i];
01351         var = variables[ivar-1];
01352         printf("%s",var->name);
01353         if ( i != vout->length -1 ) 
01354           printf(",");
01355         else
01356           printf("]");
01357       }
01358     break;
01359   case EMPTY:
01360     printf("[]\n");
01361     break;
01362   }
01363 
01364   printf("=%s(",basfun->name);
01365   for (i = 0; i < basfun->nin; i++)
01366     {
01367       printf("%s(%s)",variables[i]->name,SGetSciType(variables[i]->type));
01368       if ( i != basfun->nin -1 ) 
01369         printf(",");
01370     }
01371   printf(")\n");
01372 
01373 }

Here is the call graph for this function:

void WriteListAnalysis ( FILE *  f,
int  i 
)

Definition at line 2823 of file intersci.c.

References AddDeclare(), AddForName1(), ANY, BMATRIX, COLUMN, DEC_LOGICAL, FCprintf(), Fprintf(), i1, iel, IMATRIX, indent, MATRIX, MAXNAM, var::name, nVariable, POLYNOM, ROW, SCALAR, SPARSE, str, str1, STRING, STRINGMAT, var, variables, and VECTOR.

02827 {
02828   int k,i1,iel;
02829   char str1[MAXNAM],str[MAXNAM];
02830   VARPTR var;
02831   i1=i+1;
02832   AddDeclare(DEC_LOGICAL,"getilist");
02833   Fprintf(f,indent,"if(.not.getilist(fname,topk,top-rhs+%d,n%d,1,il%d)) return\n",i1,i1,i1);
02834   for (k = 0; k < nVariable ; k++) 
02835     {
02836       var = variables[k];
02837       if ((var->list_el != 0) &&
02838           (strcmp(var->list_name,variables[i]->name) == 0) &&
02839           var->present)
02840         {
02841           iel=var->list_el;
02842           FCprintf(f,"c      \n");
02843           FCprintf(f,"c       --   list element number %d %s --\n",iel,var->name);
02844           sprintf(str1,"%de%d",i1,iel);
02845           AddDeclare(DEC_LOGICAL,"getilist");
02846           switch (var->type) 
02847             {
02848             case SPARSE:
02849               AddDeclare(DEC_LOGICAL,"getlistsparse");
02850               Fprintf(f,indent,"if(.not.getlistsparse(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,nel%s,mnel%s,icol%s,lr%s,lc%s)) return\n",
02851                       i1,iel,str1,str1,str1,str1,str1,str1,str1,str1);
02852               if (var->el[0] == var->el[1]) {
02853                 /* square matrix */ 
02854                 AddDeclare(DEC_LOGICAL,"checkval");
02855                 Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02856               }
02857               sprintf(str,"m%s",str1);
02858               AddForName1(var->el[0],str);
02859               sprintf(str,"n%s",str1);
02860               AddForName1(var->el[1],str);
02861               sprintf(str,"nel%s",str1);
02862               AddForName1(var->el[2],str);
02863               sprintf(str,"it%s",str1);
02864               AddForName1(var->el[3],str);
02865               break;
02866             case IMATRIX:
02867               AddDeclare(DEC_LOGICAL,"getlistmat");
02868               Fprintf(f,indent,"if(.not.getlistmat(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,lr%s,lc%s)) return\n",
02869                       i1,iel,str1,str1,str1,str1,str1);
02870               if (var->el[0] == var->el[1]) {
02871                 /* square matrix */ 
02872                 AddDeclare(DEC_LOGICAL,"checkval");
02873                 Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02874               }
02875               sprintf(str,"m%s",str1);
02876               AddForName1(var->el[0],str);
02877               sprintf(str,"n%s",str1);
02878               AddForName1(var->el[1],str);
02879               sprintf(str,"it%s",str1);
02880               AddForName1(var->el[2],str);
02881               break;
02882             case MATRIX:
02883               AddDeclare(DEC_LOGICAL,"getlistmat");
02884               Fprintf(f,indent,"if(.not.getlistmat(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,lr%s,lc%s)) return\n",
02885                       i1,iel,str1,str1,str1,str1,str1);
02886               if (var->el[0] == var->el[1]) {
02887                 /* square matrix */ 
02888                 AddDeclare(DEC_LOGICAL,"checkval");
02889                 Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02890               }
02891               sprintf(str,"m%s",str1);
02892               AddForName1(var->el[0],str);
02893               sprintf(str,"n%s",str1);
02894               AddForName1(var->el[1],str);
02895               break;
02896             case BMATRIX:
02897               AddDeclare(DEC_LOGICAL,"getlistbmat");
02898               Fprintf(f,indent,"if(.not.getlistbmat(fname,topk,top-rhs+%d,%d,m%s,n%s,lr%s)) return\n",
02899                       i1,iel,str1,str1,str1,str1,str1);
02900               if (var->el[0] == var->el[1]) {
02901                 /* square matrix */ 
02902                 AddDeclare(DEC_LOGICAL,"checkval");
02903                 Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02904               }
02905               sprintf(str,"m%s",str1);
02906               AddForName1(var->el[0],str);
02907               sprintf(str,"n%s",str1);
02908               AddForName1(var->el[1],str);
02909               break;
02910             case STRINGMAT:
02911               AddDeclare(DEC_LOGICAL,"getlistsimat");
02912               Fprintf(f,indent,"if(.not.getlistsimat(fname,topk,top-rhs+%d,%d,m%s,n%s,1,1,lr%s,nlr%s)) return\n",
02913                       i1,iel,str1,str1,str1,str1);
02914               /* square matrix */
02915               if (var->el[0] == var->el[1]) {
02916                 /* square matrix */ 
02917                 AddDeclare(DEC_LOGICAL,"checkval");
02918                 Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02919               }
02920               sprintf(str,"m%s",str1);
02921               AddForName1(var->el[0],str);
02922               sprintf(str,"n%s",str1);
02923               AddForName1(var->el[1],str);
02924               break;
02925             case ROW:
02926               AddDeclare(DEC_LOGICAL,"getlistvectrow");
02927               Fprintf(f,indent,"if(.not.getlistvectrow(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,lr%s,lc%s)) return\n",
02928                       i1,iel,str1,str1,str1,str1,str1);
02929               sprintf(str,"n%s",str1);
02930               AddForName1(var->el[0],str);
02931               break;
02932             case COLUMN :
02933               AddDeclare(DEC_LOGICAL,"getlistvectcol");
02934               Fprintf(f,indent,"if(.not.getlistvectcol(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,lr%s,lc%s)) return\n",
02935                       i1,iel,str1,str1,str1,str1,str1);
02936               sprintf(str,"n%s",str1);
02937               AddForName1(var->el[0],str);
02938               break;
02939             case VECTOR:
02940               AddDeclare(DEC_LOGICAL,"getlistvect");
02941               Fprintf(f,indent,"if(.not.getlistvect(fname,top,top-rhs+%d,%d,it%s,m%s,n%s,lr%s,lc%s)) return\n",
02942                       i1,iel,str1,str1,str1,str1,str1);
02943               sprintf(str,"n%s*m%s",str1,str1);
02944               AddForName1(var->el[0],str);
02945               break;
02946             case POLYNOM:
02947               AddDeclare(DEC_LOGICAL,"getlistpoly");
02948               Fprintf(f,indent,"if(.not.getlistpoly(fname,topk,top-rhs+%d,%d,it%s,m%s,n%s,name%s,\n",
02949                       i1,iel,str1,str1,str1,str1);
02950               Fprintf(f,indent,"$     namel%s,ilp%s,lr%s,lc%s)\n",str1,str1,str1,str1);
02951               AddDeclare(DEC_LOGICAL,"checkval");
02952               Fprintf(f,indent,"if(.not.checkval(fname,m%s,n%s)) return\n",str1,str1);
02953               break;
02954             case SCALAR:
02955               AddDeclare(DEC_LOGICAL,"getlistscalar");
02956               Fprintf(f,indent,"if(.not.getlistscalar(fname,topk,top-rhs+%d,%d,lr%s)) return\n",i1,iel,str1);
02957               break;
02958             case STRING:
02959               AddDeclare(DEC_LOGICAL,"getlistsmat");
02960               Fprintf(f,indent,"if(.not.getlistsmat(fname,topk,top-rhs+%d,%d,m%s,n%s,1,1,lr%s,nlr%s)) return\n",
02961                       i1,iel,str1,str1,str1,str1);
02962               AddDeclare(DEC_LOGICAL,"checkval");
02963               Fprintf(f,indent,"if(.not.checkval(fname,m%s*n%s,1)) return\n",str1,str1);
02964               sprintf(str,"n%s",str1);
02965               strcpy(str1,variables[var->el[0]-1]->name);
02966               AddForName1(var->el[0],str);
02967               break;
02968             case ANY:
02969               break;
02970             }
02971         }
02972     }
02973 }

Here is the call graph for this function:

void WriteMain ( FILE *  f,
char*  file 
)

Definition at line 110 of file intersci.c.

References FCprintf(), Fprintf(), funNames, i, indent, nFun, and WriteMainHeader().

00113 {
00114   int i;
00115   FCprintf(f,"\nc  interface function \n");
00116   FCprintf(f,"c   ********************\n");
00117   WriteMainHeader(f,file);
00118   Fprintf(f,indent,"goto (");
00119   for (i = 1; i < nFun ; i++) {
00120     Fprintf(f,indent,"%d,",i);
00121   }
00122   Fprintf(f,indent,"%d) fin\nreturn\n",nFun);
00123   for (i = 0; i < nFun; i++) {
00124     FCprintf(f,"%d      call ints%s('%s')\n",i+1,funNames[i],funNames[i]);
00125     Fprintf(f,indent,"return\n");
00126   }
00127   Fprintf(f,indent,"end\n");
00128 }

Here is the call graph for this function:

void WriteMainHeader ( FILE *  f,
char*  fname 
)

Definition at line 1201 of file intersci.c.

References FCprintf(), Fprintf(), getenv(), indent, and NULL.

Referenced by WriteMain().

01204 {
01205   char *scidir;
01206   Fprintf(f,indent,"subroutine %s\n",fname);
01207   scidir = getenv("SCI");
01208   if ( scidir != NULL) 
01209     Fprintf(f,indent,"include '%s/routines/stack.h'\n",scidir);
01210   else 
01211     Fprintf(f,indent,"include 'SCIDIR/routines/stack.h'\n");
01212   Fprintf(f,indent,"rhs = max(0,rhs)\n");
01213   FCprintf(f,"c\n");
01214 }

Here is the call graph for this function:

Here is the caller graph for this function:

void WriteOutput ( FILE *  f  ) 

Definition at line 2256 of file intersci.c.

References AddDeclare(), DEC_INT, var::el, EMPTY, FCprintf(), Fprintf(), GetExistOutVar(), i, icre, indent, var::length, LIST, SEQUENCE, SGetSciType(), TLIST, var::type, var, variables, and WriteVariable().

02258 {
02259   IVAR iout,ivar;
02260   VARPTR var,vout;
02261   int i;
02262   
02263   Fprintf(f,indent,"topk=top-rhs\n");
02264   AddDeclare(DEC_INT,"topl");
02265   Fprintf(f,indent,"topl=top+%d\n",icre-1);
02266   
02267   iout = GetExistOutVar();
02268   vout = variables[iout -1];
02269   
02270   switch (vout->type) {
02271   case LIST:
02272   case TLIST:
02273     FCprintf(f,"c       Creation of output %s\n",SGetSciType(vout->type));
02274     Fprintf(f,indent,"top=topl+1\n");
02275     Fprintf(f,indent,"call cre%s(top,%d,lw)\n",SGetSciType(vout->type),vout->length);
02276     /* loop on output variables */
02277     for (i = 0; i < vout->length; i++) 
02278       {
02279         ivar = vout->el[i];
02280         var = variables[ivar-1];
02281         FCprintf(f,"c     \n");        
02282         FCprintf(f,"c       Element %d: %s\n",i+1,var->name);
02283         WriteVariable(f,var,ivar,1,i+1);
02284       }
02285     FCprintf(f,"c     \n");        
02286     FCprintf(f,"c     Putting in order the stack\n");
02287     Fprintf(f,indent,"call copyobj(fname,topl+1,topk+1)\n");
02288     Fprintf(f,indent,"top=topk+1\n");
02289     Fprintf(f,indent,"return\n");
02290     break;
02291   case SEQUENCE:
02292     /* loop on output variables */
02293     for (i = 0; i < vout->length; i++) 
02294       {
02295         ivar = vout->el[i];
02296         var = variables[ivar-1];
02297         FCprintf(f,"c     \n");        
02298         Fprintf(f,indent++,"if(lhs .ge. %d) then\n",i+1);
02299         FCprintf(f,"c       --------------output variable: %s\n",var->name);
02300         Fprintf(f,indent,"top=topl+%d\n",i+1);
02301         WriteVariable(f,var,ivar,0,0);
02302         Fprintf(f,--indent,"endif\n");
02303       }
02304     FCprintf(f,"c     Putting in order the stack\n");
02305     for (i = 0; i < vout->length; i++) 
02306       {
02307         Fprintf(f,indent++,"if(lhs .ge. %d) then\n",i+1);
02308         Fprintf(f,indent,"call copyobj(fname,topl+%d,topk+%d)\n",i+1,i+1);
02309         Fprintf(f,--indent,"endif\n");
02310       }
02311     Fprintf(f,indent,"top=topk+lhs\n");
02312     Fprintf(f,indent,"return\n");
02313     break;
02314   case EMPTY:
02315     FCprintf(f,"c       no output variable\n");
02316     Fprintf(f,indent,"top=topk+1\n");
02317     Fprintf(f,indent,"call objvide(fname,top)\n");
02318     Fprintf(f,indent,"return\n");
02319     break;
02320   }
02321   Fprintf(f,indent,"end\n");
02322   FCprintf(f,"c\n"); 
02323 }

Here is the call graph for this function:

void WriteVariable ( FILE *  f,
VARPTR  var,
IVAR  ivar,
int  insidelist,
nel   
)

Definition at line 2982 of file intersci.c.

References EXTERNAL, var::for_type, GetNumberInFortranCall(), GetNumberInScilabCall(), j, nel, var, variables, WriteExternalVariableOutput(), and WriteVariableOutput().

02987 {
02988   IVAR ivar2, barg, farg;
02989   VARPTR var2;
02990   int j;
02991 
02992   /* get number of variable in SCILAB calling list */
02993 
02994   barg = GetNumberInScilabCall(ivar);
02995 
02996   /* get number of variable in FORTRAN calling list */
02997 
02998   farg = GetNumberInFortranCall(ivar);
02999   
03000   if (var->for_type == EXTERNAL) 
03001     {
03002       /* external type */
03003       if (barg != 0) 
03004         {
03005           printf("output variable with external type \"%s\" \n",var->name);
03006           printf("  cannot be an input argument of SCILAB function\n");
03007           exit(1);
03008         }
03009       if (var->equal != 0) 
03010         {
03011           printf("output variable with external type \"%s\"\n", var->name);
03012           printf("  cannot have a convertion\n");
03013           exit(1);
03014         }
03015     if (farg == 0) 
03016       {
03017         printf("output variable with external type \"%s\" must be\n", var->name);
03018         printf("  an argument of FORTRAN subroutine");
03019         exit(1);
03020       }
03021       WriteExternalVariableOutput(f,var,farg,insidelist,nel);
03022     }
03023   else 
03024     {
03025       if (var->equal != 0) 
03026         {
03027           /* SCILAB type convertion */
03028           if (barg !=0 || farg!= 0) 
03029             {
03030               printf("output variable with convertion \"%s\" must not be\n",var->name);
03031               printf("  an input variable of SCILAB function or an argument\n");
03032               printf("  of FORTRAN subroutine\n");
03033               exit(1);
03034             }
03035           ivar2 = var->equal;
03036           var2 = variables[ivar2-1];
03037           /* get number of equal variable in SCILAB calling list */
03038           barg = 0;
03039           for (j = 0; j < basfun->nin; j++) 
03040             {
03041               if (ivar2 == basfun->in[j]) 
03042                 {
03043                   barg = j + 1;
03044                   break;
03045                 }
03046             }
03047           if (barg == 0) 
03048             {
03049               printf("output variable with convertion \"%s\" must be\n",
03050                      var->name);
03051               printf("  an input variable of SCILAB function\n");
03052               exit(1);
03053             }
03054           /* get number of equal variable in FORTRAN calling list */
03055           farg = 0;
03056           for (j = 0; j < forsub->narg; j++) {
03057             if (ivar2 == forsub->arg[j]) {
03058               farg = j + 1;
03059               break;
03060             }
03061           }
03062           if (farg == 0) 
03063             {
03064               printf("output variable with convertion \"%s\" must be\n",
03065                      var->name);
03066               printf("  an argument FORTRAN subroutine");
03067               exit(1);
03068             }
03069           var->for_type = var2->for_type;
03070           WriteVariableOutput(f,var,barg,farg,1,insidelist,nel);
03071         }
03072       else 
03073         {
03074           /* no SCILAB type convertion */
03075           if (farg == 0) {
03076             printf("variable without convertion \"%s\" must be an argument\n",
03077                    var->name);
03078             printf("  of FORTRAN subroutine\n");
03079             exit(1);
03080           }
03081           WriteVariableOutput(f,var,barg,farg,0,insidelist,nel);
03082         }
03083     }
03084 }

Here is the call graph for this function:

void WriteVariableOutput ( FILE *  f,
VARPTR  var,
int  barg,
int  farg,
int  convert,
int  insidelist,
int  nel 
)

Definition at line 2325 of file intersci.c.

References AddDeclare(), ANY, BMATRIX, buf, COLUMN, DEC_LOGICAL, DOUBLE, var::for_name, Forname2Int(), Fprintf(), GetExistVar(), GetNumberInFortranCall(), GetNumberInScilabCall(), IMATRIX, indent, INT, LIST, MATRIX, MAXNAM, POLYNOM, REAL, ROW, SCALAR, SCIBPOINTER, SCILPOINTER, SCIMPOINTER, SCIOPOINTER, SCISMPOINTER, SEQUENCE, SGetSciType(), SPARSE, str, str1, str2, str3, str4, strc, STRING, STRINGMAT, strit, strR, TLIST, var, variables, VECTOR, and WORK.

Referenced by WriteVariable().

02329 {
02330   char strR[MAXNAM];
02331   char str[MAXNAM];
02332   char strc[MAXNAM];
02333   char strit[MAXNAM];
02334   char str1[MAXNAM];
02335   char str2[MAXNAM];
02336   char str3[MAXNAM];
02337   char str4[MAXNAM];
02338   if (convert == 1) {
02339     /* seams to give a bug with ex13fi.desc 
02340     barg = 0;
02341     */
02342   }
02343   /* farg and barg depends on the list or not list case */
02344 
02345   /* if ( insidelist != 0 && var->list_name != (char *) 0 ) */
02346   /* jpc sept 1997 : was the var inside a list or not */
02347 
02348   if ( var->list_name != (char *) 0 ) 
02349     {
02350       int ivart,fargt,bargt,nel1;
02351       ivart=GetExistVar(var->list_name);
02352       bargt=GetNumberInScilabCall(ivart);
02353       fargt=GetNumberInFortranCall(ivart);
02354       nel1= var->list_el;
02355       if (convert == 1)
02356         {
02357           /* tricky, isn'it ? */
02358           bargt = 0; 
02359         }     
02360       if (bargt == 0) 
02361         {
02362           sprintf(strR,"%de%d",fargt,nel1);
02363           sprintf(str,"lw%de%d",fargt,nel1);
02364           sprintf(strc,"lwc%de%d",fargt,nel1);
02365           sprintf(strit,"itr%de%d",fargt,nel1);
02366         }
02367       else
02368         {
02369           sprintf(strR,"%de%d",bargt,nel1);
02370           sprintf(str,"lr%de%d",bargt,nel1);
02371           sprintf(strc,"lc%de%d",bargt,nel1);
02372           sprintf(strit,"it%de%d",bargt,nel1); 
02373         }      
02374     }
02375   else 
02376     {
02377       if (barg == 0) 
02378         {
02379           sprintf(strR,"%d",farg);
02380           sprintf(str,"lw%d",farg);
02381           sprintf(strc,"lwc%d",farg);
02382           sprintf(strit,"itr%d",farg);
02383         }
02384       else
02385         {
02386           sprintf(strR,"%d",barg);
02387           sprintf(str,"lr%d",barg);
02388           sprintf(strc,"lc%d",barg);
02389           sprintf(strit,"it%d",farg); 
02390         }
02391     }
02392   switch (var->type) 
02393     {
02394     case COLUMN:
02395     case ROW:
02396     case VECTOR:
02397     case MATRIX:
02398     case SCALAR:
02399       switch ( var->type  ) 
02400         {
02401         case COLUMN:
02402           strcpy(str2,"1");
02403           strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02404           break;
02405         case ROW:
02406         case VECTOR:
02407           strcpy(str1,"1");
02408           strcpy(str2,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02409           break;
02410         case MATRIX:
02411           strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02412           strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02413           break;
02414         case SCALAR:
02415           strcpy(str1,"1");
02416           strcpy(str2,"1");
02417           break;
02418         }
02419       if ( insidelist != 0)
02420         {
02421           AddDeclare(DEC_LOGICAL,"listcremat");
02422           Fprintf(f,indent,"if(.not.listcremat(fname,top,%d,lw,0,%s,%s,lrs,lcs)) return\n",nel,str1,str2);
02423         }
02424       else 
02425         {
02426           AddDeclare(DEC_LOGICAL,"cremat");
02427           Fprintf(f,indent,"if(.not.cremat(fname,top,0,%s,%s,lrs,lcs)) return\n",str1,str2);
02428         }
02429       if (barg != 0 &&  var->type != SCALAR) 
02430         {
02431           sprintf(str1,"n%d",barg);
02432           sprintf(str2,"m%d",barg);
02433         }
02434       switch (var->for_type) 
02435         {
02436         case INT:
02437            Fprintf(f,indent,"call int2db(%s*%s,istk(iadr(%s)),-1,stk(lrs),-1)\n", str1,str2,str);
02438           break;
02439         case DOUBLE:
02440           Fprintf(f,indent,"call dcopy(%s*%s,stk(%s),1,stk(lrs),1)\n", str1,str2,str);
02441           break;
02442         case REAL:
02443           Fprintf(f,indent,"call rea2db(%s*%s,stk(%s),-1,stk(lrs),-1)\n", str1,str2,str);
02444           break;
02445         }  
02446       break;
02447     case BMATRIX:
02448       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02449       strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02450       if ( insidelist != 0)
02451         {
02452           AddDeclare(DEC_LOGICAL,"listcrebmat");
02453           Fprintf(f,indent,"if(.not.listcrebmat(fname,top,%d,lw,%s,%s,lrs)) return\n",nel,str1,str2);
02454         }
02455       else 
02456         {
02457           AddDeclare(DEC_LOGICAL,"crebmat");
02458           Fprintf(f,indent,"if(.not.crebmat(fname,top,%s,%s,lrs)) return\n",str1,str2);
02459         }
02460       if (barg != 0 &&  var->type != SCALAR) 
02461         {
02462           sprintf(str1,"n%d",barg);
02463           sprintf(str2,"m%d",barg);
02464         }
02465       Fprintf(f,indent,"call icopy(%s*%s,istk(%s),1,istk(lrs),1)\n", str1,str2,str);
02466       break;
02467     case SPARSE:
02468       /* Sparse matrix */
02469       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02470       strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02471       strcpy(str3,Forname2Int(variables[var->el[2]-1]->for_name[0]));
02472       strcpy(str4,Forname2Int(variables[var->el[3]-1]->for_name[0]));
02473       if ( insidelist != 0)
02474         {
02475           AddDeclare(DEC_LOGICAL,"listcresparse");
02476           Fprintf(f,indent,"if(.not.listcresparse(fname,top,%d,lw,%s,%s,%s,%s,mnels,icols,lrs,lcs)) return\n"
02477                   ,nel,str4,str1,str2,str3);
02478         }
02479       else
02480         {
02481           AddDeclare(DEC_LOGICAL,"cresparse");
02482           Fprintf(f,indent,"if(.not.cresparse(fname,top,%s,%s,%s,%s,mnels,icols,lrs,lcs)) return\n"
02483                   ,str4,str1,str2,str3);
02484         }
02485       if (barg != 0 &&  var->type != SCALAR) 
02486         {
02487           sprintf(str1,"m%d",barg);
02488           sprintf(str2,"n%d",barg);
02489           sprintf(str3,"nel%d",barg);
02490           sprintf(str4,"it%d",barg);
02491         }
02492 
02493       Fprintf(f,indent,"call icopy(%s,istk(mnel%s),1,istk(mnels),1)\n",
02494               str1,strR);
02495       Fprintf(f,indent,"call icopy(%s,istk(icol%s),1,istk(icols),1)\n",
02496               str3,strR);
02497       switch (var->for_type) 
02498         {
02499         case INT:
02500           Fprintf(f,indent,"call int2db(%s,istk(iadr(%s)),-1,stk(lrs),-1)\n", str3,str);
02501           Fprintf(f,indent++,"if (%s.eq.1) then\n",str4);
02502           Fprintf(f,indent,"call int2db(%s,istk(iadr(%s)),-1,stk(lcs),-1)\n", str3,strc);
02503           Fprintf(f,indent--,"endif\n");
02504           break;
02505         case DOUBLE:
02506           Fprintf(f,indent,"call dcopy(%s,stk(%s),1,stk(lrs),1)\n", str3,str);
02507           Fprintf(f,indent++,"if (%s.eq.1) then\n",str4);
02508           Fprintf(f,indent,"call dcopy(%s,stk(%s),1,stk(lcs),1)\n", str3,strc);
02509           Fprintf(f,indent--,"endif\n");
02510           break;
02511         case REAL:
02512           Fprintf(f,indent,"call rea2db(%s,stk(%s),-1,stk(lrs),-1)\n", str3,str);
02513           Fprintf(f,indent++,"if (%s.eq.1) then\n",str4);
02514           Fprintf(f,indent,"call rea2db(%s,stk(%s),-1,stk(lcs),-1)\n", str3,strc);
02515           Fprintf(f,indent--,"endif\n");
02516           break;
02517         }  
02518       break ;
02519     case IMATRIX: 
02520       /* Imaginary matrix */
02521       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02522       strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02523       strcpy(str3,Forname2Int(variables[var->el[2]-1]->for_name[0]));
02524       if ( insidelist != 0)
02525         {
02526           AddDeclare(DEC_LOGICAL,"listcremat");
02527           Fprintf(f,indent,"if(.not.listcremat(fname,top,%d,lw,%s,%s,%s,lrs,lcs)) return\n"
02528                   ,nel,str3,str1,str2);
02529         }
02530       else 
02531         {
02532           AddDeclare(DEC_LOGICAL,"cremat");
02533           Fprintf(f,indent,"if(.not.cremat(fname,top,%s,%s,%s,lrs,lcs)) return\n",
02534                   str3,str1,str2);
02535         }
02536       if (barg != 0 &&  var->type != SCALAR) 
02537         {
02538           sprintf(str1,"m%d",barg);
02539           sprintf(str2,"n%d",barg);
02540           sprintf(str3,"it%d",barg);
02541         }
02542       switch (var->for_type) 
02543         {
02544         case INT:
02545           Fprintf(f,indent,"call int2db(%s*%s,istk(iadr(%s)),-1,stk(lrs),-1)\n", str1,str2,str);
02546           Fprintf(f,indent++,"if (%s.eq.1) then\n",str3);
02547           Fprintf(f,indent,"call int2db(%s*%s,istk(iadr(%s)),-1,stk(lcs),-1)\n", str1,str2,strc);
02548           Fprintf(f,indent--,"endif\n");
02549           break;
02550         case DOUBLE:
02551           Fprintf(f,indent,"call dcopy(%s*%s,stk(%s),1,stk(lrs),1)\n", str1,str2,str);
02552           Fprintf(f,indent++,"if (%s.eq.1) then\n",str3);
02553           Fprintf(f,indent,"call dcopy(%s*%s,stk(%s),1,stk(lcs),1)\n", str1,str2,strc);
02554           Fprintf(f,indent--,"endif\n");
02555           break;
02556         case REAL:
02557           Fprintf(f,indent,"call rea2db(%s*%s,stk(%s),-1,stk(lrs),-1)\n", str1,str2,str);
02558           Fprintf(f,indent++,"if (%s.eq.1) then\n",str3);
02559           Fprintf(f,indent,"call rea2db(%s*%s,stk(%s),-1,stk(lcs),-1)\n", str1,str2,strc);
02560           Fprintf(f,indent--,"endif\n");
02561           break;
02562         }  
02563       break ;
02564    case POLYNOM:
02565       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02566       if ( insidelist != 0)
02567         {
02568           AddDeclare(DEC_LOGICAL,"listcreopoly");
02569           Fprintf(f,indent,"if(.not.listcreopoly(fname,top,%d,lw,0,%s,name%s,namel%s,lrs,lcs)) return\n",nel,str1,str,str);
02570         }
02571       else 
02572         {
02573           AddDeclare(DEC_LOGICAL,"creonepoly");
02574           Fprintf(f,indent,"if(.not.creonepoly(fname,top,0,%s,name%s,namel%s,lrs,lcs)) return\n",str1,str,str);
02575         }
02576       switch (var->for_type) {
02577       case INT:
02578         Fprintf(f,indent,"call int2db(%s,stk(%s),-1,stk(lrs),-1)\n",
02579                 str1,str);
02580         break;
02581       case DOUBLE:
02582         Fprintf(f,indent,"call dcopy(%s,stk(%s),1,stk(lrs),1)\n",
02583                 str1,str);
02584         break;
02585       case REAL:
02586         Fprintf(f,indent,"call rea2db(%s,stk(%s),-1,stk(lrs),-1)\n",
02587                 str1,str);
02588         break;
02589       }
02590       break;
02591     case STRING:
02592       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02593       if (barg != 0) 
02594         {
02595           sprintf(str1,"nlr%d",barg);
02596         }
02597 
02598       if ( insidelist != 0)
02599         {
02600           AddDeclare(DEC_LOGICAL,"listcrestring");
02601           Fprintf(f,indent,"if(.not.listcrestring(fname,top,%d,lw,%s,ilrs)) return\n",
02602                   nel,str1);
02603         }
02604       else 
02605         {
02606           AddDeclare(DEC_LOGICAL,"cresmat2");
02607           Fprintf(f,indent,"if(.not.cresmat2(fname,top,%s,ilrs)) return\n",str1);
02608         }
02609       Fprintf(f,indent,"call cvstr(%s,istk(ilrs),buf(lbufi%d:lbuff%d),0)\n",
02610               str1,farg,farg);
02611       break;
02612     case SCISMPOINTER:
02613     case SCIMPOINTER:
02614     case SCILPOINTER:
02615     case SCIBPOINTER:
02616     case SCIOPOINTER:
02617       if ( insidelist != 0)
02618         {
02619           printf(" %s in output list : not implemented ;",SGetSciType(var->type));
02620         }
02621       else 
02622         {
02623           sprintf(buf,"cre%s", SGetSciType(var->type));
02624           AddDeclare(DEC_LOGICAL,buf);
02625           Fprintf(f,indent,"if(.not.cre%s(fname,top,lrs)) return\n", SGetSciType(var->type));
02626           Fprintf(f,indent,"stk(lrs)=stk(%s)\n",str);
02627         }
02628       break;
02629     case STRINGMAT:
02630       strcpy(str1,Forname2Int(variables[var->el[0]-1]->for_name[0]));
02631       strcpy(str2,Forname2Int(variables[var->el[1]-1]->for_name[0]));
02632       sprintf(str,"lw%d",farg);
02633       if ( insidelist != 0)
02634         {
02635           AddDeclare(DEC_LOGICAL,"lcrestringmatfromC");
02636           Fprintf(f,indent,"if(.not.lcrestringmatfromC(fname,top,%d,lw,%s,%s,%s)) return\n",
02637                   nel,str,str1,str2);
02638         }
02639       else
02640         {
02641           AddDeclare(DEC_LOGICAL,"crestringmatfromC");
02642           Fprintf(f,indent,"if(.not.crestringmatfromC(fname,top,%s,%s,%s)) return\n",
02643                   str,str1,str2);
02644         }
02645       break;
02646     case WORK:
02647     case LIST:
02648     case TLIST:
02649     case SEQUENCE:
02650     case ANY:
02651       printf("output variable \"%s\" cannot have type\n",
02652              var->name);
02653       printf("  \"WORK\", \"LIST\", \"TLIST\", \"SEQUENCE\" or \"ANY\"\n");
02654       exit(1);
02655       break;
02656     }
02657 }

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

char buf[1024] [static]

Definition at line 20 of file intersci.c.

struct ftype FType[] [static]

Referenced by GetForType(), SGetCDec(), SGetExtForTypeStack(), SGetForDec(), SGetForType(), SGetForTypeAbrev(), SGetForTypeBConvert(), and SGetForTypeStack().

int icre = 1 [static]

Definition at line 22 of file intersci.c.

int indent = 0 [static]

Definition at line 23 of file intersci.c.

struct Declare Init[] [static]

int pass = 0 [static]

Definition at line 24 of file intersci.c.

char sbuf[MAXBUF]

Definition at line 3304 of file intersci.c.

struct btype SType[] [static]

Referenced by GetBasType(), and SGetSciType().

char unknown[] = "ukn"

Definition at line 3116 of file intersci.c.

Generated on Sun Mar 4 16:08:40 2007 for Scilab [trunk] by  doxygen 1.5.1