/*--------------------------------------------------------------------------*/
int get_colminmax_arg(char *fname,int pos,rhs_opts opts[], int ** colminmax )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,2);
*colminmax=istk(l);
}
else
{
/** global value can be modified **/
int zeros[2] = { 0, 0 } ;
setDefColMinMax( zeros ) ;
*colminmax = getDefColMinMax() ;
}
}
else if ((kopt=FindOpt("colminmax",opts)))
{
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,2);
*colminmax=istk(l);
}
else
{
/** global value can be modified **/
int zeros[2] = { 0, 0 } ;
setDefColMinMax( zeros ) ;
*colminmax = getDefColMinMax() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int get_with_mesh_arg(char *fname,int pos,rhs_opts opts[], BOOL * withMesh)
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,1);
*withMesh = *(istk(l));
}
else
{
/** global value can be modified **/
setDefWithMesh( FALSE );
*withMesh = getDefWithMesh() ;
}
}
else if ((kopt=FindOpt("mesh",opts)))
{
GetRhsVar(kopt,MATRIX_OF_BOOLEAN_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,1);
*withMesh = *(istk(l));
}
else
{
/** global value can be modified **/
setDefWithMesh( FALSE );
*withMesh = getDefWithMesh() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int get_colout_arg(char *fname,int pos,rhs_opts opts[], int ** colout )
{
int m,n,l,first_opt=FirstOpt(),kopt;
if (pos < first_opt)
{
if (VarType(pos))
{
GetRhsVar(pos,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(pos,m*n,2);
*colout = istk(l);
}
else
{
/** global value can be modified **/
int newDefCO[2] = { -1, -1 } ;
setDefColOut( newDefCO ) ;
*colout = getDefColOut() ;
}
}
else if ((kopt=FindOpt("colout",opts)))
{
GetRhsVar(kopt,MATRIX_OF_INTEGER_DATATYPE, &m, &n, &l);
CheckLength(kopt,m*n,2);
*colout=istk(l);
}
else
{
/** global value can be modified **/
int newDefCO[2] = { -1, -1 } ;
setDefColOut( newDefCO ) ;
*colout = getDefColOut() ;
}
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_deletefile(char *fname,unsigned long fname_len)
{
CheckRhs(1,1);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
int m1,n1,l1;
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
/* Bug 3089 */
VarName = cstk(l1);
n1=1;
if ( deleteafile(VarName) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument: A string expected.\n"),fname);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_loadfftwlibrary(char *fname,unsigned long fname_len)
{
static int l1,n1,m1;
char *FFTWLibname=NULL;
CheckRhs(1,1);
if (GetType(1) == sci_strings)
{
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
FFTWLibname=cstk(l1);
setfftwlibname(FFTWLibname);
n1=1;
if ( LoadFFTWLibrary(FFTWLibname) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: A string expected.\n"),fname,1);
}
return(0);
}
/*--------------------------------------------------------------------------*/
static SciErr getinternalVarAddress(void *_pvCtx, int _iVar, int **_piAddress)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iAddr = 0;
int iValType = 0;
/* we accept a call to getVarAddressFromPosition after a create... call */
if (_iVar > Rhs && _iVar > Nbvars)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_POSITION, _("%s: bad call to %s! (1rst argument).\n"), ((StrCtx *) _pvCtx)->pstName,
"getVarAddressFromPosition");
return sciErr;
}
iAddr = iadr(*Lstk(Top - Rhs + _iVar));
iValType = *istk(iAddr);
if (iValType < 0)
{
iAddr = iadr(*istk(iAddr + 1));
}
*_piAddress = istk(iAddr);
return sciErr;
}
/*--------------------------------------------------------------------------*/
int sci_xfarcs(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
long hdl = 0;
int i = 0;
double angle1 = 0.0;
double angle2 = 0.0;
CheckRhs(1, 2);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if (m1 != 6)
{
Scierror(999, _("%s: Wrong size for input argument #%d: %s expected.\n"), fname, 1, "(6,n)");
return 0;
}
if (Rhs == 2)
{
GetRhsVar(2, MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
CheckVector(2, m2, n2);
if (n1 != m2 * n2)
{
Scierror(999, _("%s: Wrong size for input arguments #%d and #%d.\n"), fname, 1, 2);
return 0;
}
}
else
{
m2 = 1;
n2 = n1;
CreateVar(2, MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
for (i = 0; i < n2; ++i)
{
*istk(l2 + i) = i + 1;
}
}
getOrCreateDefaultSubwin();
for (i = 0; i < n1; ++i)
{
angle1 = DEG2RAD(*stk(l1 + (6 * i) + 4) / 64.0);
angle2 = DEG2RAD(*stk(l1 + (6 * i) + 5) / 64.0);
Objarc(&angle1, &angle2, stk(l1 + (6 * i)), stk(l1 + (6 * i) + 1),
stk(l1 + (6 * i) + 2), stk(l1 + (6 * i) + 3), istk(l2 + i), istk(l2 + i), TRUE, FALSE, &hdl);
}
/** Construct Compound and make it current object **/
setCurrentObject(ConstructCompoundSeq(n1));
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
static void get_length_and_pointer(int num, int *n, int **t)
{
int il;
il = iadr(*Lstk( num + Top - Rhs ));
*n = *istk(il + 1);
*t = istk(il + 4);
}
int sci_get_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int lr3, lc3;
static int minrhs=2, maxrhs=2;
static int minlhs=0, maxlhs=1;
static int err;
struct sci_var s_v;
debug_3 ("[if_sci_get] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_TAPS
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
s_v = sci_get_ifcpp(p_sci, *istk(l2));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
// now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
if (s_v.is_double)
{ CreateCVar(3,"d", &s_v.is_complex, &s_v.m, &s_v.n, &lr3, &lc3);
// alocated mem on scilab stack for [mxn] of (complex) double
s_v.p_re=stk(lr3);
s_v.p_im=stk(lc3);
}
else if (s_v.is_boolean)
{ CreateVar(3,"b", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] boolean
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
else
{ lr3 = I_INT32;;
CreateVar(3,"I", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] of U_INT32
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
// copy values
sci_pop_var(&s_v);
// remove data from heap
sci_delete_var(&s_v);
LhsVar(1) = 3; /* return var */
debug_3 ("[if_sci_get] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
static int sci_emptystr_one_rhs(char *fname)
{
int m1 = 0, n1 = 0; /* m1 is the number of row ; n1 is the number of col*/
/*With a matrix for input argument returns a zero length character strings matrix of the same size */
int Type = VarType(1);
if (Type == sci_matrix)
{
char **Input_StringMatrix_One = NULL;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Input_StringMatrix_One);
if ((m1 == 0) && (n1 == 0)) /* emptystr([]) */
{
int l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
LhsVar(1) = Rhs + 1 ;
PutLhsVar();
return 0;
}
}
else
{
if ((Type == sci_mlist) || (Type == sci_tlist))
{
/* compatibility with 4.1.2 */
int lw = 1 + Top - Rhs;
C2F(overload)(&lw, fname, (int)strlen(fname));
return 0;
}
else
{
int RHSPOS = 1;
int l1 = 0;
int il = 0;
int lw = RHSPOS + Top - Rhs;
l1 = *Lstk(lw);
il = iadr(l1);
if (*istk(il ) < 0)
{
il = iadr(*istk(il + 1));
}
/* get dimensions */
m1 = getNumberOfLines(il); /* row */
n1 = getNumberOfColumns(il); /* col */
}
}
/* m1 is the number of row ; n1 is the number of col*/
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, NULL);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
void str2sci(char** x,int n,int m)
{
int l=0,il=0,zero=0,err,n1,i,m1=0;
if (Top >= Bot) {
i=18;
SciError(i);
} else {
Top = Top + 1;
il = iadr(*Lstk(Top));
l = sadr(il+6);
}
err = l + n*m - *Lstk(Bot);
if (err > 0) {
i=17;
SciError(i);
return;
}
*istk(il) = sci_strings;
*istk(il+1) = n;
*istk(il+2) = m;
*istk(il+3) = 0;
*istk(il+4) = 1;
for (i = 1; i <= n*m; i++){
n1=(int)strlen(x[i-1]);
*istk(il+4+i) = *istk(il+4+i-1)+n1;
if (n1 > 0)
C2F(cvstr)(&n1,istk(il+m*n+5 -1 + *istk(il+3+i)),x[i-1],&zero,(unsigned long) n1);
m1=m1+n1;
}
*Lstk(Top+1) = l + m1;
}
/**IsEqualOverloaded
* Used to call the overloading function when testing unknown data type for equality
* @param double *d1: pointer on the beginning of the first variable structure
* @param int n1: memory size used by the first variable, only used for overloading
* @param double *d2: pointer on the beginning of the first variable structure
* @param int n2: memory size used by the second variable, only used for overloading
* @return 0 is the variables differ and 1 if they are identical, -1 for recursion purpose
* @author Serge Steer
* @see IsEqualVar
*/
int IsEqualOverloaded(double *d1, int n1, double *d2, int n2)
{
int *id1 = (int *) d1;
int *id2 = (int *) d2;
int il, lw;
int l1, l2;
initStackParameters();
if (Rstk[Pt] == 914 || Rstk[Pt] == 915) /* coming back after evaluation of overloading function */
{
/* Get the computed value */
il = iadr(*Lstk(Top));
Top--;
Pt--;
return *istk(il + 3);
}
/* Prepare stack for calling overloading function */
/* put references to d1 and d2 variable at the top of the stack */
l1 = *Lstk(1) + (int)(d1 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
l2 = *Lstk(1) + (int)(d2 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id1[0];
*istk(il + 1) = l1; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /* variable number unknown */
*istk(il + 3) = n1; /* variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id2[0];
*istk(il + 1) = l2; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /*variable number unknown */
*istk(il + 3) = n2; /*variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Ptover(1);
Rhs = 2;
lw = Top - 1;
if ( GetDoubleCompMode() == 0)
{
C2F(overload)(&lw, "isequalbitwise", 14L);
Rstk[Pt] = 914;
}
else
{
C2F(overload)(&lw, "isequal", 7L);
Rstk[Pt] = 915;
}
/*DEBUG_OVERLOADING("IsEqualVar Overloaded calls the parser Top=%d, Rhs=%d, Pt=%d\n",Top,Rhs,Pt);*/
return -1;
}
int creonevoid(int *slw,int *lw)
{
int il;
il = iadr(*slw);
*istk(il )=1;
*istk(il+1)=0;
*istk(il+2)=0;
*istk(il+3)=0;
il += 4;
*lw = sadr(il);
return 0;
}
static int get_mat_as_hmat(int num, HyperMat *H)
{
int il, type, lw;
static int dims[2];
lw = num + Top - Rhs;
il = iadr(*Lstk( lw ));
if ( *istk(il) < 0 )
{
il = iadr(*istk(il + 1));
}
type = *istk(il);
if (type == sci_matrix || type == sci_boolean || type == sci_ints)
{
/* needed for Jpc stuff (putlhsvar) ? */
Nbvars = Max(Nbvars, num);
C2F(intersci).ntypes[num - 1] = '$';
C2F(intersci).iwhere[num - 1] = *Lstk(lw);
C2F(intersci).lad[num - 1] = 0; /* a voir ? */
H->type = type;
H->dimsize = 2;
dims[0] = *istk(il + 1);
dims[1] = *istk(il + 2);
H->size = dims[0] * dims[1];
H->dims = dims;
if (type == sci_matrix)
{
H->it = *istk(il + 3);
H->R = stk(sadr(il + 4));
if (H->it == 1)
{
H->I = H->R + H->size;
}
}
else if (type == sci_boolean)
{
H->it = 0;
H->P = (void *) istk(il + 3);
}
else /* type = sci_ints */
{
H->it = *istk(il + 3);
H->P = (void *) istk(il + 4);
}
return 1;
}
else
{
return 0;
}
}
static int get_sci_bool_sparse(int num, SciBoolSparse *M)
{
int il, lw;
lw = num + Top - Rhs;
il = iadr(*Lstk(lw));
if ( *istk(il) < 0 )
{
il = iadr(*istk(il + 1));
}
if ( *istk(il) != sci_boolean_sparse )
{
return 0;
}
/* needed for Jpc stuff (putlhsvar) */
Nbvars = Max(Nbvars, num);
C2F(intersci).ntypes[num - 1] = '$';
C2F(intersci).iwhere[num - 1] = *Lstk(lw);
C2F(intersci).lad[num - 1] = 0; /* a voir ? */
M->m = *istk(il + 1);
M->n = *istk(il + 2);
M->nel = *istk(il + 4);
M->mnel = istk(il + 5);
M->jcol = istk(il + 5 + M->m);
return 1;
}
/*--------------------------------------------------------------------------*/
void C2F(parsecomment)(void)
{
static int *Lstk = C2F(vstk).lstk - 1;
static int *Lin = C2F(iop).lin - 1;
static int *Lpt = C2F(iop).lpt - 1;
static int *Comp = C2F(com).comp - 1;
static int l, ll, lkp, l0, c1 = 1;
/* look for eol */
l0 = Lpt[4] - 1;
if ( (Lin[l0] == slash) && (Lin[l0 - 1] == slash) & (Lin[l0 + 1] == eol))
{
l0 = l0 + 1;
}
l = l0;
while (Lin[l] != eol)
{
l++;
}
ll = l - l0;
if (Comp[1] == 0)
{
/* ignore all characters up to the end */
}
else
{
/* compilation [30 number-of-char chars-vector] */
lkp = C2F(com).comp[0];
Err = (lkp + 2 + ll) / 2 + 1 - Lstk[Bot];
if (Err > 0)
{
/* Display the stack information */
SciError(17);
return ;
}
*istk(lkp) = 31;
*istk(lkp + 1) = ll;
C2F(icopy)(&ll, &(Lin[l0]), &c1, istk(lkp + 2), &c1);
Comp[1] = lkp + 2 + ll;
}
Lpt[4] = l;
C2F(com).char1 = eol;
C2F(com).sym = eol;
return ;
}
static int cre_hmat(int pos, HyperMat *H)
{
/* dans cette version, seuls les champs dimsize, size et it sont definis
* et on alloue alors la memoire des champs dims, R (et I si it=1) dans
* la pile scilab (juste � la place occupee par la variable).
*/
static char *Str[] = { "hm", "dims", "entries"};
int m1 = 1, n1 = 3;
int mL = 3, nL = 1, lL, one = 1, lr, lc, lar, lac;
CreateVar(pos, MATRIX_ORIENTED_TYPED_LIST_DATATYPE, &mL, &nL, &lL);
CreateListVarFromPtr(pos, 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, Str);
lr = 4;
lar = -1;
CreateListVarFrom(pos, 2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &one, &H->dimsize, &lr, &lar);
H->dims = istk(lr);
lar = -1;
lac = -1;
switch (H->type)
{
case (sci_matrix):
CreateListCVarFrom(pos, 3, MATRIX_OF_DOUBLE_DATATYPE, &H->it, &H->size, &one , &lr, &lc, &lar, &lac);
H->R = stk(lr);
if ( H->it == 1)
{
H->I = stk(lc);
}
return 1;
case (sci_boolean):
CreateListVarFrom(pos, 3, MATRIX_OF_BOOLEAN_DATATYPE, &H->size, &one, &lr, &lar);
H->P = (void *) istk(lr);
return 1;
case (sci_ints):
lr = H->it;
CreateListVarFrom(pos, 3, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &H->size, &one, &lr, &lar);
H->P = (void *) istk(lr);
return 1;
}
/* Ajout Allan CORNET Correction Warning */
/* warning C4715: 'cre_hmat' : not all control paths return a value */
return 1;
}
/*--------------------------------------------------------------------------*/
int sci_getsystemmetrics(char *fname, unsigned long l)
{
char *param = NULL;
int nIndex = -1;
int m1 = 0;
int n1 = 0;
int l1 = 0;
CheckRhs(1, 1);
if (GetType(1) != sci_strings)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
param = cstk(l1);
nIndex = getnIndexFromString(param);
if ( nIndex > -1 )
{
int one = 1;
CreateVar(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &one, &one, &l1);
*istk(l1) = GetSystemMetrics(nIndex);
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument: %s.\n"), fname, _("see help"));
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_iswaitingforinput(char *fname, unsigned long fname_len)
{
BOOL res = FALSE;
int un = 1, outIndex = 0;
Rhs = Max(Rhs, 0);
CheckRhs(0, 1);
CheckLhs(0, 1);
if (getScilabMode() == SCILAB_STD)
{
res = ConsoleIsWaitingForInput();
}
else
{
sciprint(_("%s: Not implemented in this mode.\n"), fname);
}
CreateVar(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &un, &un, &outIndex);
*istk(outIndex) = res;
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
int sci_exec_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int minrhs=2, maxrhs=2;
static int err;
debug_3 ("[sci_exec_if] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_RESET
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
sci_exec_ifcpp(p_sci, *(istk(l2)));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
debug_3 ("[sci_exec_if] +++++++++++++++++++++ \r\n");
return 0;
}
int sci_create_if(char *fname)
{
static int l1, m1, n1;
static int l2, m2, n2;
static int minlhs=1, maxlhs=1;
static int minrhs=1, maxrhs=1;
static int err;
void *p_sci;
debug_1 ("[if_sci_create] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// Example: SCI_FIR
GetRhsVar(1, "i", &m1, &n1, &l1);
p_sci = sci_create_ifcpp(*(istk(l1)));
if (p_sci == NULL) {
Scierror(999,"%s failed err=%d", fname, sci_err);
}
else {
/* see C:\Program Files\scicoslab-44b7\examples\interface-tour-so\ex10intc.c */
m2=1;
n2=1;
CreateVarFromPtr(2,"p",&m2,&n2, p_sci);
LhsVar(1) =2; /* return pointer */
}
debug_1 ("p_sci = 0x%X \r\n", p_sci);
debug_1 ("[if_sci_create] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
static int GetScalarInt(char *fname, int *prev, int *arg, int narg, int *ic, int ir, int *ival)
{
int mx = 0, nx = 0, lx = 0;
if (*prev != 1)
{
*arg = *arg + 1;
*ic = 1;
*prev = 1;
}
GetRhsVar(*arg, MATRIX_OF_INTEGER_DATATYPE, &mx, &nx, &lx);
if ( (*ic > nx) || (*prev != 1))
{
*arg = *arg + 1;
if (*arg > narg )
{
return NOT_ENOUGH_ARGS;
}
*ic = 1;
GetRhsVar(*arg, MATRIX_OF_INTEGER_DATATYPE, &mx, &nx, &lx);
}
if (ir > mx)
{
return RET_END;
}
*ival = *(istk(lx + ir - 1 + mx * (*ic - 1)));
*ic = *ic + 1;
return OK;
}
static int reshape_hmat(int pos, HyperMat *H, int new_dimsize)
{
/*
* This utility routine is used when an hypermatrix H
* is indexed with fewer indices vectors than its dimsize
* (for instance the profil of H is n1 x n2 x n3 but
* an expression like H(v1,v2) is used). So we have to
* reconsidered the profil of H for this operation (in
* my example H is then considered with the profil
* n1 x (n2*n3) ). For that (as H is passed by reference)
* we create a new variable at position pos, recompute
* the new profil in this var and then H->dims will points to it.
*
*/
int *new_dims;
int k, one = 1, l;
l = I_INT32;
CreateVar(pos, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &new_dimsize, &one, &l);
new_dims = istk(l);
for ( k = 0 ; k < new_dimsize ; k++)
{
new_dims[k] = H->dims[k];
}
for ( k = new_dimsize ; k < H->dimsize ; k++ )
{
new_dims[new_dimsize - 1] *= H->dims[k];
}
H->dimsize = new_dimsize;
H->dims = new_dims;
return 1;
}
/*--------------------------------------------------------------------------*/
static int GetString(char *fname, int *prev, int *arg, int narg, int *ic, int ir, char **sval)
{
int mx = 0, nx = 0, il = 0, ild = 0, lw = 0, k = 0, one = 1;
char *p = NULL;
if (*prev != 2)
{
*arg = *arg + 1;
*ic = 1;
*prev = 2;
}
lw = *arg + Top - Rhs;
if (! C2F(getwsmat)(fname, &Top, &lw, &mx, &nx, &il, &ild, (unsigned long)strlen(fname)))
{
return RET_BUG;
}
else
{
if ( *ic > nx )
{
*arg = *arg + 1;
if (*arg > narg)
{
return NOT_ENOUGH_ARGS;
}
*ic = 1;
lw = *arg + Top - Rhs;
if (! C2F(getwsmat)(fname, &Top, &lw, &mx, &nx, &il, &ild, (unsigned long) strlen(fname)))
{
return RET_BUG;
}
}
}
if (ir > mx)
{
return RET_END;
}
k = ir - 1 + mx * (*ic - 1);
if (SciStrtoStr(istk(il - 1 + *istk(ild + k)), &one, istk(ild + k), &p) < 0)
{
return MEM_LACK;
}
*ic = *ic + 1;
*sval = p;
return OK;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_mode)(char *fname,unsigned long fname_len)
{
Rhs = Max(0, Rhs);
CheckRhs(0,1);
CheckLhs(1,1);
if (Rhs == 0)
{
int n = 1 ,l = 0;
execMode mode = getExecMode();
CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &n, &n,&l);
*istk(l) = (int)mode;
LhsVar(1) = Rhs + 1;
}
else
{
if ( VarType(1)== sci_matrix )
{
int m1 = 0, n1 = 0, l1 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ( (m1 == n1) && (n1 == 1) )
{
double dmode = *stk(l1);
int mode = (int) dmode;
if (dmode != (double)mode)
{
Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
return 0;
}
setExecMode((execMode)mode);
if ( (mode == 7) || (mode == 4) )
{
int code_message = 26;
int val_message = 0;
C2F(msgs)(&code_message, &val_message);
}
LhsVar(1) = 0;
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
PutLhsVar();
return 0;
}
/*-------------------------------------------------------------------------------------*/
static int *lengthEachString(int rhspos, int *sizeArrayReturned)
{
int *StringsLength = NULL;
if (VarType(rhspos) == sci_strings)
{
int m = 0, n = 0; /* matrix size */
int mn = 0; /* m*n */
int il = 0;
int ilrd = 0;
int l1 = 0;
int x = 0;
int lw = rhspos + Top - Rhs;
l1 = *Lstk(lw);
il = iadr(l1);
if (*istk(il) < 0)
{
il = iadr(*istk(il + 1));
}
/* get dimensions */
m = getNumberOfLines(il); /* row */
n = getNumberOfColumns(il); /* col */
mn = m * n;
ilrd = il + 4;
StringsLength = (int *)MALLOC(sizeof(int) * mn);
if (StringsLength == NULL)
{
return NULL;
}
*sizeArrayReturned = mn;
for (x = 0; x < mn; x++)
{
StringsLength[x] = (int)(*istk(ilrd + x + 1) - *istk(ilrd + x));
}
}
return StringsLength;
}
/*--------------------------------------------------------------------------*/
int sci_ctree2(char *fname, unsigned long fname_len)
{
int one = 1, ipvec = 0, nvec = 0, mvec = 0, noin = 0, moin = 0, ipoin = 0, noinr = 0, moinr = 0, ipoinr = 0;
int ndep = 0, mdep = 0, ipdep = 0, ndepuptr = 0, mdepuptr = 0, ipdepuptr = 0, ipord = 0, ipok = 0, n = 0, nord = 0;
CheckRhs(5, 5);
CheckLhs(2, 2);
GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &nvec, &mvec, &ipvec);
GetRhsVar(2, MATRIX_OF_INTEGER_DATATYPE, &noin, &moin, &ipoin);
GetRhsVar(3, MATRIX_OF_INTEGER_DATATYPE, &noinr, &moinr, &ipoinr);
GetRhsVar(4, MATRIX_OF_INTEGER_DATATYPE, &ndep, &mdep, &ipdep);
GetRhsVar(5, MATRIX_OF_INTEGER_DATATYPE, &ndepuptr, &mdepuptr, &ipdepuptr);
n = nvec * mvec;
CreateVar(6, MATRIX_OF_INTEGER_DATATYPE, &n, &one, &ipord);
CreateVar(7, MATRIX_OF_INTEGER_DATATYPE, &one, &one, &ipok);
ctree2(istk(ipvec), n, istk(ipdep), istk(ipdepuptr), istk(ipoin), istk(ipoinr), istk(ipord), &nord, istk(ipok));
*istk(iadr(C2F(intersci).iwhere[5]) + 1) = nord;
LhsVar(1) = 6;
LhsVar(2) = 7;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
SciErr getVarAddressFromName(void *_pvCtx, const char *_pstName, int **_piAddress)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iVarID[nsiz];
int *piAddr = NULL;
//get variable id from name
C2F(str2name) (_pstName, iVarID, (int)strlen(_pstName));
//define scope of search
Fin = -6;
Err = 0;
//search variable
C2F(stackg) (iVarID);
//No idea :(
if (*Infstk(Fin) == 2)
{
Fin = *istk(iadr(*Lstk(Fin)) + 1 + 1);
}
if (Err > 0 || Fin == 0)
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Unable to get address of variable \"%s\""), "getVarAddressFromName", _pstName);
return sciErr;
}
//get variable address
getNewVarAddressFromPosition(_pvCtx, Fin, &piAddr);
if (piAddr[0] < 0)
{
//get address from reference
int iStackRef = *Lstk(Fin);
int iStackAddr = iadr(iStackRef);
int iNewStackRef = iStackAddr + 1;
int iNewStackPtr = *istk(iNewStackRef);
int iNewStackAddr = iadr(iNewStackPtr);
piAddr = istk(iNewStackAddr);
}
*_piAddress = piAddr;
return sciErr;
}
int
introundmode (char *fname)
{
int direct;
int t, u, v;
CheckRhs (1, 1);
CheckLhs (1, 1);
GetRhsVar (1, "i", &t, &u, &direct);
CreateVar (2, "i", &t, &u, &v);
*istk (v) = roundmode(istk (direct));
LhsVar (1) = 2;
return 0;
}
int
intpower (char *fname)
{
int ainf, asup, op, n;
int sa[2], flag[1];
int cinf, csup, f;
int ma, na;
int r, s, v, w;
int p, q, t, u;
CheckRhs (4, 4);
CheckLhs (2, 3);
GetRhsVar (1, "d", &na, &ma, &ainf);
GetRhsVar (2, "d", &na, &ma, &asup);
GetRhsVar (3, "c", &t, &u, &op);
GetRhsVar (4, "i", &p, &q, &n);
r = na;
s = ma;
v = 1;
w = 1;
CreateVar (5, "d", &r, &s, &cinf);
CreateVar (6, "d", &r, &s, &csup);
CreateVar (7, "i", &v, &w, &f);
sa[0] = na;
sa[1] = ma;
power (stk (ainf), stk (asup), sa, *cstk (op), istk (n),
stk (cinf), stk (csup), flag);
*istk (f) = flag[0];
LhsVar (1) = 5;
LhsVar (2) = 6;
LhsVar (3) = 7;
return 0;
}
