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 WriteFunctionCode(FILE * f) { int i; IVAR ivar; if (pass == 1) { printf(" generating C interface for function (%s) Scilab function\"%s\"\n", forsub->name, basfun->name); } FCprintf(f, "/******************************************\n"); FCprintf(f, " * SCILAB function : %s, fin = %d\n", basfun->name, nFun); FCprintf(f, " ******************************************/\n"); WriteHeader(f, "ints", basfun->name); /* optional arguments : new style */ /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */ basfun->NewMaxOpt = basfun->maxOpt; if (basfun->NewMaxOpt > 0) { /** optional arguments **/ AddDeclare(DEC_INT, "nopt"); AddDeclare(DEC_INT, "iopos"); Fprintf(f, indent, "nopt=NumOpt();\n"); } /* rhs argument number checking */ if (basfun->NewMaxOpt > 0) Fprintf(f, indent, "CheckRhs(%d,%d+nopt);\n", basfun->nin - basfun->maxOpt, basfun->nin - basfun->maxOpt); else Fprintf(f, indent, "CheckRhs(%d,%d);\n", basfun->nin - basfun->maxOpt, basfun->nin); /* lhs argument number checking */ ivar = basfun->out; if (ivar == 0) { Fprintf(f, indent, "CheckLhs(0,1);\n"); } else { if ((variables[ivar - 1]->length == 0) || (variables[ivar - 1]->type == LIST) || (variables[ivar - 1]->type == TLIST)) { Fprintf(f, indent, "CheckLhs(1,1);\n"); } else { Fprintf(f, indent, "CheckLhs(1,%d);\n", variables[ivar - 1]->length); } } /* SCILAB argument checking */ for (i = 0; i < basfun->nin - basfun->NewMaxOpt; i++) { switch (variables[i]->type) { case LIST: WriteListAnalysis(f, i, "l"); break; case TLIST: WriteListAnalysis(f, i, "t"); break; case MLIST: WriteListAnalysis(f, i, "m"); break; default: WriteArgCheck(f, i); break; } } if (basfun->NewMaxOpt != 0) { sprintf(str1, "rhs_opts opts[]={\n"); for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++) { sprintf(str2, "\t{-1,\"%s\",\"%s\",0,0,0},\n", variables[i]->name, SGetForTypeAbrev(variables[i])); strcat(str1, str2); } strcat(str1, "\t{-1,NULL,NULL,NULL,0,0}}"); AddDeclare(DEC_DATA, str1); Fprintf(f, indent, "iopos=Rhs;\n"); Fprintf(f, indent, "if ( get_optionals(fname,opts) == 0) return 0;\n"); for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++) { WriteOptArgPhase2(f, i); } } /* SCILAB cross checking */ WriteCrossCheck(f); /* SCILAB equal output variable checking */ WriteEqualCheck(f); /* FORTRAN call */ WriteFortranCall(f); /* FORTRAN output to SCILAB */ WriteOutput(f); }
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"); }