void WriteListAnalysis(FILE * f, int i, char *list_type)
{
int k, i1;
VARPTR var;
i1 = i + 1;
AddDeclare1(DEC_INT, "m%d", i1);
AddDeclare1(DEC_INT, "n%d", i1);
AddDeclare1(DEC_INT, "l%d", i1);
Fprintf(f, indent, "GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n", i1, list_type, i1, i1, i1);
for (k = 0; k < nVariable; k++)
{
var = variables[k];
if ((var->list_el != 0) && (strcmp(var->list_name, variables[i]->name) == 0) && var->present)
{
Fprintf(f, indent, "/* list element %d %s */\n", var->list_el, var->name);
if (RHSTAB[var->type].type != var->type)
{
fprintf(stderr, "Bug in intersci : Something wrong in RHSTAB\n");
}
(*(RHSTAB[var->type].fonc)) (f, var, 0);
}
}
}
void GetCom(FILE *f, VARPTR var, int flag)
{
static char C[] = "GetRhsVar(%s,\"%s\",&m%d,&n%d,&l%d);\n";
static char LC[] = "GetListRhsVar(%s,%d,\"%s\",&m%s,&n%s,&l%s);\n";
int i1 = var->stack_position;
if ( flag == 1 )
{
sprintf(str2, "k");
}
else
{
sprintf(str2, "%d", i1);
}
if (var->list_el == 0 )
{
/** A scilab matrix argument **/
sprintf(str1, "%d", i1);
Fprintf(f, indent, C, str2, SGetForTypeAbrev(var), i1, i1, i1);
/* Adding the calling sequence in the for_names */
ChangeForName2(var, "%s(l%s)", SGetForTypeStack(var), str1);
}
else
{
/** A scilab matrix argument inside a list **/
sprintf(str1, "%de%d", i1, var->list_el);
Fprintf(f, indent, LC, str2, var->list_el, SGetForTypeAbrev(var), str1, str1, str1, str1);
/* Adding the calling sequence in the for_names */
ChangeForName2(var, "%s(l%s)", SGetForTypeStack(var), str1);
}
AddDeclare1(DEC_INT, "m%s", str1);
AddDeclare1(DEC_INT, "n%s", str1);
AddDeclare1(DEC_INT, "l%s", str1);
}
void OptMATRIX(FILE *f,VARPTR var)
{
int opt_posi = basfun->NewMaxOpt - (basfun->nin - var->stack_position)-1;
Fprintf(f,indent++,"if ( opts[%d].position == -1 ){\n",opt_posi);
Fprintf(f,indent,"iopos++ ; opts[%d].position = iopos;\n",opt_posi);
AddDeclare1(DEC_DATA,"%s xdat%d[]= %s, *dat%d = xdat%d",
SGetCDec(var->for_type),
opt_posi,data,opt_posi,opt_posi);
AddDeclare1(DEC_INT,"m%d",var->stack_position);
AddDeclare1(DEC_INT,"n%d",var->stack_position);
AddDeclare1(DEC_INT,"l%d",var->stack_position);
switch ( var->type )
{
case MATRIX :
Fprintf(f,indent,"opts[%d].m = 1;opts[%d].n = %s; opts[%d].type = \"%s\";\n",
opt_posi,opt_posi,size,opt_posi,SGetForTypeAbrev(var));
break;
case STRING :
Fprintf(f,indent,"opts[%d].m = %s;opts[%d].n = 1; opts[%d].type = \"%s\";\n",
opt_posi,size,opt_posi,opt_posi,SGetForTypeAbrev(var));
break;
case SCALAR:
Fprintf(f,indent,"opts[%d].m = 1;opts[%d].n = 1;\n",opt_posi,opt_posi);
break;
}
Fprintf(f,indent,"CreateVarFromPtr(opts[%d].position,opts[%d].type,&opts[%d].m,&opts[%d].n,&dat%d);\n",
opt_posi,opt_posi,opt_posi,opt_posi,
opt_posi);
Fprintf(f,indent,"opts[%d].l = VarPtr(opts[%d].position);\n",opt_posi, opt_posi);
switch ( var->type )
{
case MATRIX :
ChangeForName2(variables[var->el[0]-1],"opts[%d].m",opt_posi);
ChangeForName2(variables[var->el[1]-1],"opts[%d].n",opt_posi);
break;
case STRING :
ChangeForName2(variables[var->el[0]-1],"opts[%d].m",opt_posi);
break;
}
ChangeForName2(var,"%s(opts[%d].l)",SGetForTypeStack(var), opt_posi);
Fprintf(f,--indent,"}\n");
Fprintf(f,indent," else {\n");
/* should be optimized to exploit dimension infos stored in opts */
Fprintf(f,indent++,"GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n",var->stack_position,
SGetForTypeAbrev(var),var->stack_position,var->stack_position,var->stack_position);
(*(CHECKTAB[var->type].fonc))(f,var,0);
Fprintf(f,--indent,"}\n");
}
void GetPOINTER(FILE *f, VARPTR var, int flag)
{
static char C[] = "GetRhsOPointer(%s,&lr%d);\n";
int i1 = var->stack_position;
if ( flag == 1 )
{
sprintf(str2, "k");
}
else
{
sprintf(str2, "%d", i1);
}
sprintf(str1, "%d", i1);
if (var->list_el == 0 )
{
/** A scilab matrix argument **/
sprintf(str1, "%d", i1);
Fprintf(f, indent, C, str2, i1);
/* Adding the calling sequence in the for_names */
ChangeForName2(var, "stk(lr%s)", str1);
}
else
{
fprintf(stderr, "Wrong type opointer inside a list\n");
exit(1);
}
AddDeclare1(DEC_INT, "lr%s", str1);
}
void GetVECTOR(FILE *f, VARPTR var, int flag)
{
int i1 = var->stack_position;
GetCom(f, var, flag);
Check(f, var, 0);
if (var->list_el == 0 )
{
Fprintf(f, indent, "CheckVector(%d,m%d,n%d);\n", i1, i1, i1);
Fprintf(f, indent, "mn%d=m%d*n%d;\n", i1, i1, i1);
AddDeclare1(DEC_INT, "mn%d", i1);
}
else
{
sprintf(str1, "%de%d", i1, var->list_el);
Fprintf(f, indent, "CheckListVector(%d,%d,m%s,n%s);\n", i1, var->list_el, str1, str1);
Fprintf(f, indent, "l%dmn%d=m%s*n%s;\n", i1, var->list_el, str1, str1);
AddDeclare1(DEC_INT, "l%dmn%d", i1, var->list_el);
}
}
void OptOpointer(FILE *f,VARPTR var)
{
Fprintf(f,indent++,"if ( %sok == 0) {\n",var->name);
Fprintf(f,indent,"%spos=iopos=iopos+1;\n",var->name);
Fprintf(f,indent,"CreateSCO(iopos,&lr%d,%s);\n",
var->stack_position,data);
AddDeclare1(DEC_INT,"lr%d",var->stack_position);
Fprintf(f,--indent,"}\n");
}
void GetSPARSE(FILE *f, VARPTR var, int flag)
{
static char C[] = "GetRhsVar(%s,\"s\",&m%d,&n%d,&S%d);\n";
static char LC[] = "GetListRhsVar(%s,%d,\"s\",&m%s,&n%s,&S%s);\n";
int i1 = var->stack_position;
if ( flag == 1 )
{
sprintf(str2, "k");
}
else
{
sprintf(str2, "%d", i1);
}
if (var->list_el == 0 )
{
/** A scilab matrix argument **/
sprintf(str1, "%d", i1);
Fprintf(f, indent, C, str2, i1, i1, i1);
/* Adding the calling sequence in the for_names */
ChangeForName2(var, "&S%d", i1);
}
else
{
/** A scilab matrix argument inside a list **/
sprintf(str1, "%de%d", i1, var->list_el);
Fprintf(f, indent, LC, str2, var->list_el, str1, str1, str1);
/* Adding the calling sequence in the for_names */
ChangeForName2(var, "&S%s", str1);
}
AddDeclare1(DEC_INT, "m%s", str1);
AddDeclare1(DEC_INT, "n%s", str1);
AddDeclare1(DEC_SPARSE, "S%s", str1);
/** str1 was set by GetCom */
CheckSquare(f, var, str1, str2);
Check(f, var, 0);
Check(f, var, 1);
}
void WriteOptArgPhase2(FILE *f,IVAR i)
{
VARPTR var = variables[basfun->in[i]-1];
int opt_posi = basfun->NewMaxOpt - (basfun->nin - var->stack_position)-1;
Fprintf(f,indent,"/* default value to optional argument %s */\n",var->name);
switch (var->opt_type)
{
case NAME:
Fprintf(f,indent++,"if ( opts[%d].position == -1 ){\n",opt_posi);
Fprintf(f,indent,"iopos++ ; opts[%d].position = iopos;\n",opt_posi);
AddDeclare1(DEC_INT,"opt%d",opt_posi);
Fprintf(f,indent,"GetMatrixptr(\"%s\",&opts[%d].m, &opts[%d].n,&opt%d);\n",
var->opt_name,opt_posi,opt_posi,opt_posi);
Fprintf(f,indent,"CreateVarFrom(opts[%d].position,\"d\",&opts[%d].m, &opts[%d].n,&opts[%d].l,&opt%d)\n",
opt_posi,opt_posi,opt_posi,opt_posi,opt_posi);
ChangeForName2(var,"%s(opts[%d].l)",SGetForTypeStack(var), opt_posi);
Fprintf(f,--indent,"}\n");
break;
case VALUE:
switch (var->type)
{
case SCALAR:
sprintf(data,"{%s}",var->opt_name);
OptvarGetSize(var->opt_name,size,data);
OptMATRIX(f,var);
break;
case MATRIX:
OptvarGetSize(var->opt_name,size,data);
OptMATRIX(f,var);
break;
case STRING:
sprintf(size,"%d",(int)strlen(var->opt_name));
sprintf(data,"\"%s\"",var->opt_name);
OptMATRIX(f,var);
break;
case SCIOPOINTER :
sprintf(size,"size-[%d]",(int)strlen(var->opt_name));
strcpy(data,var->opt_name);
OptOpointer(f,var);
break;
default:
printf("Optional variable with value must be \"SCALAR\" or \"STRING\"\n");
exit(1);
break;
}
break;
}
}
void GetSTRINGMAT(FILE *f, VARPTR var, int flag)
{
int i1 = var->stack_position;
if ( flag == 1 )
{
sprintf(str2, "k");
}
else
{
sprintf(str2, "%d", i1);
}
if (var->list_el == 0 )
{
AddDeclare1(DEC_SMAT, "Str%d", i1);
AddDeclare1(DEC_INT, "m%d", i1);
AddDeclare1(DEC_INT, "n%d", i1);
Fprintf(f, indent, "GetRhsVar(%s,\"S\",&m%d,&n%d,&Str%d);\n", str2, i1, i1, i1);
sprintf(str, "&Str%d", i1);
ChangeForName1(var, str);
}
else
{
sprintf(str1, "%de%d", i1, var->list_el);
AddDeclare1(DEC_SMAT, "Str%s", str1);
AddDeclare1(DEC_INT, "m%s", str1);
AddDeclare1(DEC_INT, "n%s", str1);
Fprintf(f, indent, "GetListRhsVar(%s,%d,\"S\",&m%s,&n%s,&Str%s);\n", str2, var->list_el,
str1, str1, str1);
sprintf(str, "&Str%s", str1);
ChangeForName1(var, str);
}
/* square matrix */
CheckSquare(f, var, str1, str2);
Check(f, var, 0);
Check(f, var, 1);
if (var->for_type != CSTRINGV)
{
printf("incompatibility between the type %s and FORTRAN type %s for variable \"%s\"\n",
SGetSciType(STRINGMAT), SGetForType(var->for_type), var->name);
exit(1);
}
}
void WriteOptArg(FILE *f,VARPTR var)
{
char lsize[MAXNAM];
char ldata[MAXNAM];
Fprintf(f,indent++,"if( Rhs <= %d)\n",
var->stack_position-1 );
Fprintf(f,indent,"{\n");
switch (var->opt_type)
{
case NAME:
AddDeclare(DEC_LOGICAL,"optvarget");
Fprintf(f,indent,"if (.not.optvarget(fname,topk,%d,'%s ')) return\n",
var->stack_position,var->opt_name);
break;
case VALUE:
switch (var->type)
{
case SCALAR:
(*(CRERHSTAB[var->type].fonc))(f,var);
Fprintf(f,indent,"stk(lr%d)= %s\n",var->stack_position,
var->opt_name);
break;
case MATRIX:
OptvarGetSize(var->opt_name,lsize,ldata);
AddDeclare1(DEC_DATA,"%s dat%d[]= %s",
SGetCDec(var->for_type),
var->stack_position,ldata);
Fprintf(f,indent,"m%d = 1;n%d = %s;\n",var->stack_position,
var->stack_position,lsize);
(*(CRERHSTAB[var->type].fonc))(f,var);
AddDeclare1(DEC_INT,"un=1");
Fprintf(f,indent,"C2F(%scopy)(&m%d,dat%d,&un,%s(l%d),&un);\n",
SGetForTypeAbrev(var),
var->stack_position,
var->stack_position,
SGetForTypeStack(var),var->stack_position);
break;
case STRING:
Fprintf(f,indent,"m%d = %d\n",var->stack_position,
strlen(var->opt_name));
(*(CRERHSTAB[var->type].fonc))(f,var);
Fprintf(f,indent,"call stringcopy(m%d,'%s',cstk(lr%d))\n",
var->stack_position,var->opt_name,var->stack_position);
break;
case SCIOPOINTER :
(*(CRERHSTAB[var->type].fonc))(f,var);
break;
default:
printf("Optional variable with value must be \"SCALAR\" or \"STRING\"\n");
exit(1);
break;
}
break;
}
Fprintf(f,indent--,"}\n");
Fprintf(f,indent++,"else\n");
Fprintf(f,indent,"{\n");
(*(RHSTAB[var->type].fonc))(f,var,0);
Fprintf(f,indent--,"}\n");
}
