int C2F(inextj)(int *j)
{
int il, m, n, it, l, ilr, lr, r;
int one = 1;
il = iadr(*Lstk(Top - 1));
if (*istk(il ) < 0)
{
il = iadr(*istk(il + 1));
}
m = *istk(il + 1);
n = *istk(il + 2);
it = *istk(il + 3);
l = il + 4;
ilr = iadr(*Lstk(Top));
*istk(ilr) = 8;
*istk(ilr + 2) = 1;
*istk(ilr + 3) = it;
lr = ilr + 4;
if (m == -3) /*implicit vector*/
{
*istk(ilr + 1) = 1;
*Lstk(Top + 1) = sadr(lr + C2F(memused)(&it, &one));
r = gengetcol(it, *j, -1, 1, istk(l), istk(lr));
}
else
{
*istk(ilr + 1) = m;
*Lstk(Top + 1) = sadr(lr + C2F(memused)(&it, &m));
r = gengetcol(it, *j, m, n, istk(l), istk(lr));
}
return r;
}
SciErr allocPointer(void* _pvCtx, int _iVar, void** _pvPtr)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
int* piAddr = NULL;
void* pvPtr = NULL;
int iMemSize = 2;
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(iAddr));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
sciErr = fillPointer(_pvCtx, piAddr, &pvPtr);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_ALLOC_POINTER, _("%s: Unable to create variable in Scilab memory"), "allocPointer");
return sciErr;
}
*_pvPtr = pvPtr;
updateInterSCI(_iVar, '$', iAddr, sadr(iadr(iAddr) + 4));
updateLstk(iNewPos, sadr(iadr(iAddr) + 4), 2);
return sciErr;
}
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;
}
SciErr allocMatrixOfBoolean(void* _pvCtx, int _iVar, int _iRows, int _iCols, int** _piBool)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int *piAddr = NULL;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
//return empty matrix
if(_iRows == 0 && _iCols == 0)
{
double dblReal = 0;
sciErr = createMatrixOfDouble(_pvCtx, _iVar, 0, 0, &dblReal);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
}
return sciErr;
}
int iMemSize = (int)(((double)(_iRows * _iCols) / 2) + 2);
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(iAddr));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
fillMatrixOfBoolean(_pvCtx, piAddr, _iRows, _iCols, _piBool);
updateInterSCI(_iVar, '$', iAddr, sadr(iadr(iAddr) + 3));
updateLstk(iNewPos, sadr(iadr(iAddr) + 3), (_iRows * _iCols) / (sizeof(double) / sizeof(int)));
return sciErr;
}
/*--------------------------------------------------------------------------*/
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;
}
/**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;
}
/*--------------------------------------------------------------------------*/
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;
}
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;
}
}
/*--------------------------------------------------------------------------*/
int get_rhs_real_hmat(int num, RealHyperMat *H)
{
int il, il1, il2, il3,/* it, */lw;
lw = num + Top - Rhs;
il = iadr(*Lstk( lw ));
if ( *istk(il) < 0 )
il = iadr(*istk(il+1));
if ( *istk(il) != 17 )
goto err;
else if ( *istk(il+1) != 3 ) /* a hm mlist must have 3 fields */
goto err;
/* get the pointers for the 3 fields */
il1 = sadr(il+6);
il2 = il1 + *istk(il+3) - 1;
il3 = il1 + *istk(il+4) - 1;
il1 = iadr(il1); il2 = iadr(il2); il3 = iadr(il3);
/* test if the first field is a matrix string with 3 components
* and that the first is "hm" (ie 17 22 in scilab char code)
*/
if ( (*istk(il1) != sci_strings) | ((*istk(il1+1))*(*istk(il1+2)) != 3) )
goto err;
else if ( *istk(il1+5)-1 != 2 ) /* 1 str must have 2 chars */
goto err;
else if ( *istk(il1+8) != 17 || *istk(il1+9) != 22 )
goto err;
/* get the 2d field */
if ( (*istk(il2) != 8) | (*istk(il2+3) != 4) )
goto err;
H->dimsize = (*istk(il2+1))*(*istk(il2+2));
H->dims = istk(il2+4);
/* get the 3d field */
if ( !( *istk(il3) == 1 && *istk(il3+3)==0) )
goto err;
H->size = (*istk(il3+1))*(*istk(il3+2));
H->R = stk(sadr(il3+4));
/* 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 ? */
return 1;
err:
Scierror(999,_("Wrong type for input argument #%d: Real hypermatrix expected.\n"), num);
return 0;
}
SciErr createCommonNamedMatrixOfDouble(void* _pvCtx, const char* _pstName, int _iComplex, int _iRows, int _iCols, const double* _pdblReal, const double* _pdblImg)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iVarID[nsiz];
int iSaveRhs = Rhs;
int iSaveTop = Top;
int iSize = _iRows * _iCols;
int *piAddr = NULL;
double *pdblReal = NULL;
double *pdblImg = NULL;
int iOne = 1;
if (!checkNamedVarFormat(_pvCtx, _pstName))
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createCommonNamedMatrixOfDouble");
return sciErr;
}
C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
Top = Top + Nbvars + 1;
int iMemSize = _iRows * _iCols * (_iComplex + 1) + 2;
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(Top));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);
//write matrix information
fillCommonMatrixOfDouble(_pvCtx, piAddr, _iComplex, _iRows, _iCols, &pdblReal, &pdblImg);
//copy data in stack
C2F(dcopy)(&iSize, const_cast<double*>(_pdblReal), &iOne, pdblReal, &iOne);
if(_iComplex)
{
C2F(dcopy)(&iSize, const_cast<double*>(_pdblImg), &iOne, pdblImg, &iOne);
}
//update "variable index"
updateLstk(Top, *Lstk(Top) + sadr(4), iSize * (_iComplex + 1) * 2);
Rhs = 0;
//Add name in stack reference list
createNamedVariable(iVarID);
Top = iSaveTop;
Rhs = iSaveRhs;
return sciErr;
}
SciErr createNamedPointer(void* _pvCtx, const char* _pstName, int* _pvPtr)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iVarID[nsiz];
int iSaveRhs = Rhs;
int iSaveTop = Top;
void* pvPtr = NULL;
int *piAddr = NULL;
if (!checkNamedVarFormat(_pvCtx, _pstName))
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createNamedPointer");
return sciErr;
}
C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
Top = Top + Nbvars + 1;
int iMemSize = 1;
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(*Lstk(Top)));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);
//write matrix information
sciErr = fillPointer(_pvCtx, piAddr, &pvPtr);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_POINTER, _("%s: Unable to create %s named \"%s\""), "createNamedPointer", _("pointer"), _pstName);
return sciErr;
}
//copy data in stack
((double*)pvPtr)[0] = (double) ((unsigned long int)_pvPtr);
updateLstk(Top, *Lstk(Top) + sadr(4), 2);
Rhs = 0;
//Add name in stack reference list
createNamedVariable(iVarID);
Top = iSaveTop;
Rhs = iSaveRhs;
return sciErr;
}
SciErr allocCommonSparseMatrix(void* _pvCtx, int _iVar, int _iComplex, int _iRows, int _iCols, int _iNbItem, int** _piNbItemRow, int** _piColPos, double** _pdblReal, double** _pdblImg)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
int iTotalSize = 0;
int iOffset = 0;
int* piAddr = NULL;
//return empty matrix
if(_iRows == 0 && _iCols == 0)
{
double dblReal = 0;
sciErr = createMatrixOfDouble(_pvCtx, _iVar, 0, 0, &dblReal);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
}
return sciErr;
}
//header + offset
int iMemSize = (5 + _iRows + _iNbItem + !((_iRows + _iNbItem) % 2)) / 2;
//+ items size
iMemSize += _iNbItem * (_iComplex + 1);
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(iAddr));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
sciErr = fillCommonSparseMatrix(_pvCtx, piAddr, _iComplex, _iRows, _iCols, _iNbItem, _piNbItemRow, _piColPos, _pdblReal, _pdblImg, &iTotalSize);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_ALLOC_SPARSE, _("%s: Unable to create variable in Scilab memory"), _iComplex ? "allocComplexSparseMatrix" : "allocSparseMatrix");
return sciErr;
}
iOffset = 5;//4 for header + 1 for NbItem
iOffset += _iRows + _iNbItem + !((_iRows + _iNbItem) % 2);
updateInterSCI(_iVar, '$', iAddr, sadr(iadr(iAddr) + iOffset));
updateLstk(iNewPos, sadr(iadr(iAddr) + iOffset), iTotalSize);
return sciErr;
}
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;
}
int __overl__(char *fname)
{
int lp;
int id[nsiz], *id1;
lp = iadr (*Lstk (1 + Top - Rhs));
C2F(funnam) (id, fname, &lp, strlen (fname));
Fin = -1;
C2F(stackg) (id);
if (Err > 0)
return 0;
if (Fin != 0)
id1 = id;
else
{
id1 = getassoc (id);
if (id1 == NULL)
id1 = id;
}
C2F(putid) (&C2F(recu).ids[C2F(recu).pt * nsiz], id1);
C2F(com).fun = -1;
return 0;
}
/*--------------------------------------------------------------------------*/
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;
}
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);
}
/*-------------------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
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 C2F(ishm)()
{
/* teste si l'argument en Top est une hypermatrice */
int il, il1;
il = iadr(*Lstk( Top ));
if ( *istk(il) < 0 )
{
il = iadr(*istk(il + 1));
}
if ( *istk(il) != sci_mlist )
{
return 0;
}
else if ( *istk(il + 1) != 3 ) /* a hm mlist must have 3 fields */
{
return 0;
}
/* get the pointer of the first and second fields */
il1 = sadr(il + 6);
il1 = iadr(il1);
/* test if the first field is a matrix string with 3 components
* and that the first is "hm" (ie 17 22 in scilab char code)
*/
if ( (*istk(il1) != sci_strings) | ((*istk(il1 + 1)) * (*istk(il1 + 2)) != 3) )
{
return 0;
}
else if ( *istk(il1 + 5) - 1 != 2 ) /* 1 str must have 2 chars */
{
return 0;
}
else if ( *istk(il1 + 8) != 17 || *istk(il1 + 9) != 22 )
{
return 0;
}
return 1;
}
SciErr allocBooleanSparseMatrix(void* _pvCtx, int _iVar, int _iRows, int _iCols, int _iNbItem, int** _piNbItemRow, int** _piColPos)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
int iPos = 5 + _iRows + _iNbItem;
int* piAddr = NULL;
//return empty matrix
if(_iRows == 0 && _iCols == 0)
{
double dblReal = 0;
sciErr = createMatrixOfDouble(_pvCtx, _iVar, 0, 0, &dblReal);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
}
return sciErr;
}
int iMemSize = (int)( ( (double)iPos / 2 ) + 0.5);
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(iAddr));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
sciErr = fillBooleanSparseMatrix(_pvCtx, piAddr, _iRows, _iCols, _iNbItem, _piNbItemRow, _piColPos);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_ALLOC_BOOLEAN_SPARSE, _("%s: Unable to create variable in Scilab memory"), "allocBooleanSparseMatrix");
return sciErr;
}
iPos += iAddr;
updateInterSCI(_iVar, '$', iAddr, iPos);
updateLstk(iNewPos, iPos, 0);
return sciErr;
}
int crelistofvoids(int *slw,int *lw,int *nels)
{
int il,k;
il = iadr(*slw);
*istk(il) = 15;
*istk(il + 1) = *nels;
*istk(il + 2) = 1;
for (k=0; k<*nels; k++) *istk(il+3+k) = *istk(il+2+k) + 2;
il += 3+*nels;
il=iadr(sadr(il));
for (k=0; k<*nels; k++) {
*istk(il )=1;
*istk(il+1)=0;
*istk(il+2)=0;
*istk(il+3)=0;
il += 4;
};
if ( ((il-iadr(*slw)) %2) ) il +=1;
*lw = sadr(il);
return 0;
}
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;
}
SciErr allocCommonMatrixOfDouble(void* _pvCtx, int _iVar, int _iComplex, int _iRows, int _iCols, double** _pdblReal, double** _pdblImg)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
int* piAddr = NULL;
int iMemSize = _iRows * _iCols * (_iComplex + 1) + 2;
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(iAddr));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
fillCommonMatrixOfDouble(_pvCtx, piAddr, _iComplex, _iRows, _iCols, _pdblReal, _pdblImg);
updateInterSCI(_iVar, '$', iAddr, sadr(iadr(iAddr) + 4));
updateLstk(iNewPos, sadr(iadr(iAddr) + 4), _iRows * _iCols * (_iComplex + 1));
return sciErr;
}
/*--------------------------------------------------------------------------*/
int get_rhs_scalar_string(int num, int *length, int **tabchar)
{
int il, lw;
lw = num + Top - Rhs;
il = iadr(*Lstk( lw ));
if ( *istk(il) < 0 )
il = iadr(*istk(il+1));
if ( ! ( *istk(il) == sci_strings && (*istk(il+1))*(*istk(il+2)) == 1 ) )
{
/* we look for a scalar string */
Scierror(999,_("Wrong type for input argument #%d: String expected.\n"), num);
return 0;
}
*length = *istk(il+5)-1;
*tabchar = istk(il+6);
Nbvars = Max(Nbvars,num);
C2F(intersci).ntypes[num-1] = '$';
C2F(intersci).iwhere[num-1] = *Lstk(lw);
C2F(intersci).lad[num-1] = 0;
return 1;
}
/*--------------------------------------------------------------------------*/
int deleteNamedVariable(void* _pvCtx, const char* _pstName)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iVarID[nsiz];
int iZero = 0;
int il;
int sRhs = Rhs;
int sLhs = Lhs;
int sTop = Top;
if (isNamedVarExist(_pvCtx, _pstName) == 0)
{
return 0;
}
if (!checkNamedVarFormat(_pvCtx, _pstName))
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createNamedComplexZMatrixOfDouble");
return 0;
}
//get varId from varName
C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
//create a null matrix a the Top of the stack
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = 0;
*Lstk(Top + 1) = *Lstk(Top) + 1;
Rhs = 0;
//Replace existing value by null matrix to delete it
C2F(stackp) (iVarID, &iZero);
Rhs = sRhs;
Lhs = sLhs;
Top = sTop ;
if (C2F(iop).err > 0/* || C2F(errgst).err1 > 0*/)
{
return 0;
}
//No Idea :x
Fin = 1;
return 1;
}
/*--------------------------------------------------------------------------*/
char *getlibrarypath(char *libraryname)
{
char *path = NULL;
int lw = 0; int fin = 0;
if (C2F(objptr)(libraryname,&lw,&fin,(unsigned long)strlen(libraryname)))
{
int *header = istk(iadr(*Lstk(fin)));
if ( (header) && (header[0] == sci_lib ) )
{
int lengthpath = 0, job = 0;
lengthpath = header[1];
path = (char *) MALLOC((lengthpath+1)*sizeof(char));
job=1; /* convert scilab to ascii */
C2F(cvstr)(&lengthpath, &header[2], path,&job,lengthpath);
path[lengthpath]='\0';
}
}
return path;
}
/*--------------------------------------------------------------------------*/
int var2sci(void *x, int n, int m, int typ_var)
{
/************************************
* variables and constants d?inition
************************************/
/*counter and address variable declaration*/
int nm = 0, il = 0, l = 0, lw = 0, j = 0, i = 0, err = 0;
/*define all type of accepted ptr */
SCSREAL_COP *x_d = NULL, *ptr_d = NULL;
SCSINT8_COP *x_c = NULL, *ptr_c = NULL;
SCSUINT8_COP *x_uc = NULL, *ptr_uc = NULL;
SCSINT16_COP *x_s = NULL, *ptr_s = NULL;
SCSUINT16_COP *x_us = NULL, *ptr_us = NULL;
SCSINT_COP *x_i = NULL, *ptr_i = NULL;
SCSUINT_COP *x_ui = NULL, *ptr_ui = NULL;
SCSINT32_COP *x_l = NULL, *ptr_l = NULL;
SCSUINT32_COP *x_ul = NULL, *ptr_ul = NULL;
/* Check if the stack is not full */
if (Top >= Bot)
{
err = 1;
return err;
}
else
{
Top = Top + 1;
il = iadr(*Lstk(Top));
l = sadr(il + 4);
}
/* set number of double needed to store data */
if (typ_var == SCSREAL_N)
{
nm = n * m; /*double real matrix*/
}
else if (typ_var == SCSCOMPLEX_N)
{
nm = n * m * 2; /*double real matrix*/
}
else if (typ_var == SCSINT_N)
{
nm = (int)(ceil((n * m) / 2) + 1); /*int*/
}
else if (typ_var == SCSINT8_N)
{
nm = (int)(ceil((n * m) / 8) + 1); /*int8*/
}
else if (typ_var == SCSINT16_N)
{
nm = (int)(ceil((n * m) / 4) + 1); /*int16*/
}
else if (typ_var == SCSINT32_N)
{
nm = (int)(ceil((n * m) / 2) + 1); /*int32*/
}
else if (typ_var == SCSUINT_N)
{
nm = (int)(ceil((n * m) / 2) + 1); /*uint*/
}
else if (typ_var == SCSUINT8_N)
{
nm = (int)(ceil((n * m) / 8) + 1); /*uint8*/
}
else if (typ_var == SCSUINT16_N)
{
nm = (int)(ceil((n * m) / 4) + 1); /*uint16*/
}
else if (typ_var == SCSUINT32_N)
{
nm = (int)(ceil((n * m) / 2) + 1); /*uint32*/
}
else if (typ_var == SCSUNKNOW_N)
{
nm = n * m; /*arbitrary scilab object*/
}
else
{
nm = n * m; /*double real matrix*/
}
/*check if there is free space for new data*/
err = l + nm - *Lstk(Bot);
if (err > 0)
{
err = 2;
return err;
}
/**************************
* store data on the stack
*************************/
switch (typ_var) /*for each type of data*/
{
case SCSREAL_N : /* set header */
*istk(il) = sci_matrix; /*double real matrix*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 0;
x_d = (SCSREAL_COP *) x;
ptr_d = (SCSREAL_COP *) stk(l);
for (j = 0; j < m * n; j++)
{
ptr_d[j] = x_d[j];
}
break;
case SCSCOMPLEX_N : /* set header */
*istk(il) = 1; /*double complex matrix*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 1;
x_d = (SCSCOMPLEX_COP *) x;
ptr_d = (SCSCOMPLEX_COP *) stk(l);
for (j = 0; j < 2 * m * n; j++)
{
ptr_d[j] = x_d[j];
}
break;
case SCSINT_N : /* set header */
*istk(il) = sci_ints; /*int*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 4;
x_i = (SCSINT_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_i = (SCSINT_COP *) istk(il + 4);
ptr_i[j] = x_i[j];
}
break;
case SCSINT8_N : /* set header */
*istk(il) = sci_ints; /*int8*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 1;
x_c = (SCSINT8_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_c = (SCSINT8_COP *) istk(il + 4);
ptr_c[j] = x_c[j];
}
break;
case SCSINT16_N : /* set header */
*istk(il) = sci_ints; /*int16*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 2;
x_s = (SCSINT16_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_s = (SCSINT16_COP *) istk(il + 4);
ptr_s[j] = x_s[j];
}
break;
case SCSINT32_N : /* set header */
*istk(il) = sci_ints; /*int32*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 4;
x_l = (SCSINT32_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_l = (SCSINT32_COP *) istk(il + 4);
ptr_l[j] = x_l[j];
}
break;
case SCSUINT_N : /* set header */
*istk(il) = sci_ints; /*uint*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 14;
x_ui = (SCSUINT_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_ui = (SCSUINT_COP *) istk(il + 4);
ptr_ui[j] = x_ui[j];
}
break;
case SCSUINT8_N : /* set header */
*istk(il) = sci_ints; /*uint8*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 11;
x_uc = (SCSUINT8_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_uc = (SCSUINT8_COP *) istk(il + 4);
ptr_uc[j] = x_uc[j];
}
break;
case SCSUINT16_N : /* set header */
*istk(il) = sci_ints; /*uint16*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 12;
x_us = (SCSUINT16_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_us = (SCSUINT16_COP *) istk(il + 4);
ptr_us[j] = x_us[j];
}
break;
case SCSUINT32_N : /* set header */
*istk(il) = sci_ints; /*uint32*/
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 14;
x_ul = (SCSUINT32_COP *) x;
for (j = 0; j < m * n; j++)
{
ptr_ul = (SCSUINT32_COP *) istk(il + 4);
ptr_ul[j] = x_ul[j];
}
break;
case SCSUNKNOW_N :
lw = Top;
x_d = (double *) x;
C2F(unsfdcopy)(&nm, x_d, (j = 1, &j), stk(*Lstk(Top)), (i = 1, &i));
break;
default : /* set header */
*istk(il) = sci_matrix; /* double by default */
*istk(il + 1) = n;
*istk(il + 2) = m;
*istk(il + 3) = 0;
x_d = (double *) x;
for (j = 0; j < m * n; j++)
{
ptr_d = (double *) stk(il + 4);
ptr_d[j] = x_d[j];
}
break;
}
/* set value in lstk */
*Lstk(Top + 1) = l + nm;
/*return error flag = 0 */
err = 0;
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(expr)(void)
{
static int eye[6] = { 672014862, 673720360, 673720360, 673720360, 673720360, 673720360 };
int i = 0, j = 0;
int r = 0 , s = 0, ir = 0, op = 0, ls = 0, sign = 0;
int temp = 0;
int kount = 0;
if (C2F(iop).ddt == 4)
{
static char tmp[100];
static int io;
sprintf(tmp, " expr pt:%d rstk(pt):%d sym:%d", C2F(recu).pt, C2F(recu).rstk[C2F(recu).pt - 1], C2F(com).sym);
C2F(basout)(&io, &C2F(iop).wte, tmp, (long)strlen(tmp));
}
r = C2F(recu).rstk[C2F(recu).pt - 1];
if (r == 204)
{
goto L85;
}
ir = r / 100;
if (ir != 1)
{
goto L1;
}
switch (r - 100)
{
case 1:
goto L5;
case 2:
goto L6;
case 3:
goto L25;
case 4:
goto L26;
case 5:
goto L61;
case 6:
goto L73;
case 7:
goto L74;
case 8:
goto L82;
case 9:
goto L83;
case 10:
goto L86;
case 11:
goto L87;
case 12:
goto L102;
case 13:
goto L104;
case 14:
goto L102;
case 15:
goto L23;
}
L1:
if (C2F(com).sym >= ou && C2F(com).sym <= great)
{
SciError(40);
return 0;
}
L2:
kount = 1;
if (C2F(com).sym == not)
{
goto L70;
}
if (C2F(com).sym == colon)
{
C2F(putid)(C2F(com).syn, eye);
}
L3:
s = 1;
L4:
if (C2F(com).sym == minus)
{
s = -s;
}
if (C2F(com).sym == plus || C2F(com).sym == minus)
{
C2F(getsym)();
goto L4;
}
sign = plus;
if (s < 0)
{
sign = minus;
}
if (C2F(eptover)(&inc, &checkvalue))
{
return 0;
}
C2F(recu).pstk[C2F(recu).pt - 1] = sign + (kount << 8);
C2F(recu).rstk[C2F(recu).pt - 1] = 101;
C2F(recu).icall = 2;
/* *call* term */
return 0;
L5:
sign = C2F(recu).pstk[C2F(recu).pt - 1] % 256;
kount = C2F(recu).pstk[C2F(recu).pt - 1] / 256;
--C2F(recu).pt;
if (sign != minus)
{
goto L10;
}
Rhs = 1;
++C2F(recu).pt;
C2F(recu).pstk[C2F(recu).pt - 1] = kount;
Fin = minus;
C2F(recu).rstk[C2F(recu).pt - 1] = 102;
C2F(recu).icall = 4;
/* *call* allops(minus) */
return 0;
L6:
kount = C2F(recu).pstk[C2F(recu).pt - 1];
--C2F(recu).pt;
L10:
if (C2F(com).sym == plus || C2F(com).sym == minus)
{
goto L20;
}
if (C2F(recu).rstk[C2F(recu).pt - 1] == 113)
{
goto L104;
}
if (C2F(recu).rstk[C2F(recu).pt - 1] == 112)
{
goto L102;
}
if (C2F(com).sym == eol)
{
goto L50;
}
if (C2F(com).sym >= ou || C2F(com).sym == equal)
{
goto L70;
}
goto L50;
L20:
if (C2F(recu).rstk[C2F(recu).pt - 1] != 301)
{
goto L21;
}
/* blank or tab is delimiter inside angle brackets */
ls = C2F(iop).lpt[2] - 2;
if ( (i = C2F(iop).lin[ls - 1], abs(i)) == blank && (j = C2F(iop).lin[C2F(iop).lpt[2] - 1], abs(j)) != blank)
{
goto L50;
}
L21:
op = C2F(com).sym;
C2F(getsym)();
/* next lines added to handle sequence of + and - operators, S. Steer */
/* 03/2005 (Matlab compatibility). Here i implemented a lazy way */
/* without calling unary + or unary - operator */
L22:
if (C2F(com).sym == plus)
{
/* 1++2 or 1-+2 */
C2F(getsym)();
goto L22;
}
if (C2F(com).sym == minus)
{
/* 1+-2 or 1--2 */
if (op == minus)
{
op = plus;
}
else
{
op = minus;
}
C2F(getsym)();
goto L22;
}
++C2F(recu).pt;
C2F(recu).pstk[C2F(recu).pt - 1] = op + (kount << 8);
if (C2F(com).sym != not)
{
goto L24;
}
C2F(recu).rstk[C2F(recu).pt - 1] = 115;
/* *call* lfact */
goto L85;
L23:
goto L25;
L24:
C2F(recu).rstk[C2F(recu).pt - 1] = 103;
C2F(recu).icall = 2;
/* *call* term */
return 0;
L25:
op = C2F(recu).pstk[C2F(recu).pt - 1] % 256;
kount = C2F(recu).pstk[C2F(recu).pt - 1] / 256;
Rhs = 2;
C2F(recu).pstk[C2F(recu).pt - 1] = kount;
C2F(recu).rstk[C2F(recu).pt - 1] = 104;
Fin = op;
C2F(recu).icall = 4;
/* *call* allops(op) */
return 0;
L26:
kount = C2F(recu).pstk[C2F(recu).pt - 1];
--C2F(recu).pt;
goto L10;
L50:
if (C2F(com).sym != colon)
{
goto L60;
}
C2F(getsym)();
++kount;
goto L3;
L60:
if (kount > 3)
{
SciError(33);
if (Err > 0)
{
return 0;
}
}
Rhs = kount;
if (kount <= 1)
{
return 0;
}
++C2F(recu).pt;
C2F(recu).rstk[C2F(recu).pt - 1] = 105;
Fin = colon;
C2F(recu).icall = 4;
/* *call* allops(colon) */
return 0;
L61:
--C2F(recu).pt;
r = C2F(recu).rstk[C2F(recu).pt - 1];
ir = r / 100;
if (ir != 1)
{
return 0;
}
switch (r - 100)
{
case 1:
goto L5;
case 2:
goto L6;
case 3:
goto L25;
case 4:
goto L26;
case 5:
goto L61;
case 6:
goto L73;
case 7:
goto L74;
case 8:
goto L82;
case 9:
goto L83;
case 10:
goto L86;
case 11:
goto L87;
case 12:
goto L102;
case 13:
goto L104;
case 14:
goto L102;
}
/* in-line lexpr */
L70:
if (C2F(iop).ddt == 4) {}
L72:
if (C2F(eptover)(&inc, &checkvalue))
{
return 0;
}
C2F(recu).ids[C2F(recu).pt * 6 - 6] = 0;
C2F(recu).ids[C2F(recu).pt * 6 - 5] = C2F(errgst).err1;
if (C2F(com).sym == ou)
{
/* call getsym */
C2F(recu).pstk[C2F(recu).pt - 1] = ou;
if (C2F(ifexpr)())
{
/* checking for possible logical 'if expression' */
/* evaluation shortcircuit */
if (C2F(com).comp[0] != 0)
{
if (C2F(compil)(&code, &inc, &val, &val, &val))
{
if (Err > 0)
{
return 0;
}
C2F(recu).ids[C2F(recu).pt * 6 - 6] = C2F(com).comp[0];
}
}
else
{
temp = (i = *istk(iadr(C2F(vstk).lstk[Top - 1])), abs(i));
if ( (temp != 8) && (C2F(istrue)(&val)) )
{
/* first term is true there is no use to evaluate the other */
C2F(recu).ids[C2F(recu).pt * 6 - 6] = 1;
/* err1 <>0 sets interpretation without evaluation */
/* use special value to be able to distinguish from */
/* recovered errors */
C2F(errgst).err1 = 9191919;
}
}
}
}
else
{
C2F(recu).pstk[C2F(recu).pt - 1] = 0;
}
C2F(recu).pstk[C2F(recu).pt - 1] += kount << 8;
C2F(recu).rstk[C2F(recu).pt - 1] = 106;
/* *call* lterm */
goto L80;
L73:
op = C2F(recu).pstk[C2F(recu).pt - 1] % 256;
kount = C2F(recu).pstk[C2F(recu).pt - 1] / 256;
--C2F(recu).pt;
if (op == 0)
{
goto L75;
}
if (C2F(com).comp[0] == 0 && C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 6] == 1)
{
/* term has not been evaluated */
if ((i = -C2F(errgst).errct, abs(i)) / 100000 == 0)
{
C2F(errgst).err1 = C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5];
}
else if (C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5] != 0)
{
C2F(errgst).err1 = C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5];
}
else
{
if (C2F(errgst).err1 == 9191919)
{
C2F(errgst).err1 = 0;
}
}
if (C2F(errgst).err1 > 0)
{
return 0;
}
goto L75;
}
C2F(recu).icall = 4;
Fin = ou;
Rhs = 2;
++C2F(recu).pt;
C2F(recu).rstk[C2F(recu).pt - 1] = 107;
C2F(recu).pstk[C2F(recu).pt - 1] = kount;
/* *call* allops(ou) */
return 0;
L74:
kount = C2F(recu).pstk[C2F(recu).pt - 1];
if (C2F(com).comp[0] != 0 && C2F(recu).ids[C2F(recu).pt * 6 - 6] != 0)
{
i = C2F(recu).ids[C2F(recu).pt * 6 - 6] - 1;
if ( (C2F(compil)(&code, &val, &i, &val, &val)) && (Err > 0) )
{
return 0;
}
}
--C2F(recu).pt;
L75:
if (C2F(com).sym == ou)
{
goto L72;
}
goto L50;
/* in-line lterm */
L80:
if (C2F(iop).ddt == 4) { }
L81:
if (C2F(eptover)(&inc, &checkvalue))
{
return 0;
}
C2F(recu).ids[C2F(recu).pt * 6 - 6] = 0;
C2F(recu).ids[C2F(recu).pt * 6 - 5] = C2F(errgst).err1;
if (C2F(com).sym == et)
{
C2F(recu).pstk[C2F(recu).pt - 1] = et;
C2F(recu).ids[C2F(recu).pt * 6 - 6] = 0;
if (C2F(ifexpr)())
{
/* if expression evaluation, checking for possible */
/* logical expression evaluation shortcircuit */
if (C2F(com).comp[0] != 0)
{
if (C2F(compil)(&code, &val, &val, &val, &val))
{
if (Err > 0)
{
return 0;
}
C2F(recu).ids[C2F(recu).pt * 6 - 6] = C2F(com).comp[0];
}
}
else
{
temp = (i = *istk(iadr(C2F(vstk).lstk[Top - 1])), abs(i));
if ( (temp != 8) && (! C2F(istrue)(&val)) )
{
/* first term is false there is no use to evaluate the other */
C2F(recu).ids[C2F(recu).pt * 6 - 6] = 1;
/* err1 <>0 sets interpretation without evaluation */
C2F(errgst).err1 = 9191919;
}
}
}
}
else
{
C2F(recu).pstk[C2F(recu).pt - 1] = 0;
}
C2F(recu).pstk[C2F(recu).pt - 1] += kount << 8;
C2F(recu).rstk[C2F(recu).pt - 1] = 108;
/* *call* lfact */
goto L85;
L82:
op = C2F(recu).pstk[C2F(recu).pt - 1] % 256;
kount = C2F(recu).pstk[C2F(recu).pt - 1] / 256;
--C2F(recu).pt;
if (op == 0)
{
goto L84;
}
if (C2F(com).comp[0] == 0 && C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 6] == 1)
{
/* term has not been evaluated */
if ((i = -C2F(errgst).errct, abs(i)) / 100000 == 0)
{
C2F(errgst).err1 = C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5];
}
else if (C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5] != 0)
{
/* error detected before if expression evaluation (should not occur ?) */
C2F(errgst).err1 = C2F(recu).ids[(C2F(recu).pt + 1) * 6 - 5];
}
else
{
if (C2F(errgst).err1 == 9191919)
{
C2F(errgst).err1 = 0;
}
}
if (C2F(errgst).err1 > 0)
{
return 0;
}
goto L84;
}
C2F(recu).icall = 4;
Fin = et;
Rhs = 2;
++C2F(recu).pt;
C2F(recu).pstk[C2F(recu).pt - 1] = kount;
C2F(recu).rstk[C2F(recu).pt - 1] = 109;
/* *call* allops(et) */
return 0;
L83:
kount = C2F(recu).pstk[C2F(recu).pt - 1];
if (C2F(com).comp[0] != 0 && C2F(recu).ids[C2F(recu).pt * 6 - 6] != 0)
{
i = C2F(recu).ids[C2F(recu).pt * 6 - 6] - 1;
if ( (C2F(compil)(&code, &val, &i, &val, &val)) && (Err > 0) )
{
return 0;
}
}
--C2F(recu).pt;
L84:
if (C2F(com).sym != et)
{
goto L73;
}
goto L81;
/* in-line lfact */
L85:
if (C2F(iop).ddt == 4) { }
if (C2F(eptover)(&inc, &checkvalue))
{
return 0;
}
C2F(recu).pstk[C2F(recu).pt - 1] = 0;
if (C2F(com).sym == not && C2F(com).char1 != equal)
{
C2F(recu).pstk[C2F(recu).pt - 1] = not;
C2F(getsym)();
}
C2F(recu).pstk[C2F(recu).pt - 1] += kount << 8;
C2F(recu).rstk[C2F(recu).pt - 1] = 110;
/* *call* lprim */
goto L100;
L86:
op = C2F(recu).pstk[C2F(recu).pt - 1] % 256;
kount = C2F(recu).pstk[C2F(recu).pt - 1] / 256;
--C2F(recu).pt;
if (op == 0)
{
goto L82;
}
Fin = op;
Rhs = 1;
++C2F(recu).pt;
C2F(recu).pstk[C2F(recu).pt - 1] = kount;
C2F(recu).rstk[C2F(recu).pt - 1] = 111;
C2F(recu).icall = 4;
/* *call* allops(not) */
return 0;
L87:
kount = C2F(recu).pstk[C2F(recu).pt - 1];
--C2F(recu).pt;
/* next two lines to handle a+~b and a*~b,... */
if (C2F(recu).rstk[C2F(recu).pt - 1] == 115)
{
goto L23;
}
if (C2F(recu).rstk[C2F(recu).pt - 1] == 204)
{
return 0;
}
goto L82;
/* in-line lprim */
L100:
if (C2F(iop).ddt == 4) { }
if (C2F(recu).pstk[C2F(recu).pt - 1] % 256 != 0)
{
goto L101;
}
if (C2F(com).sym != et && C2F(com).sym != ou)
{
goto L103;
}
C2F(getsym)();
/* modif SS */
if (C2F(eptover)(&val, &checkvalue))
{
return 0;
}
L101:
++C2F(recu).pt;
C2F(recu).rstk[C2F(recu).pt - 1] = 112;
C2F(recu).icall = 1;
/* *call* expr */
goto L2;
L102:
--C2F(recu).pt;
if ((C2F(com).sym != equal && C2F(com).sym < less) || C2F(com).sym == eol)
{
goto L86;
}
L103:
op = C2F(com).sym;
C2F(getsym)();
if (op == equal && C2F(com).sym != equal)
{
int code_message = 7;
C2F(msgs)(&code_message, &val);
}
if (C2F(com).sym == equal || C2F(com).sym == great)
{
if (op != equal)
{
op += C2F(com).sym;
}
C2F(getsym)();
if (op == not + equal)
{
op = less + great;
}
}
++C2F(recu).pt;
C2F(recu).rstk[C2F(recu).pt - 1] = 113;
C2F(recu).pstk[C2F(recu).pt - 1] = op;
C2F(recu).icall = 1;
/* *call* expr */
goto L2;
L104:
Fin = C2F(recu).pstk[C2F(recu).pt - 1];
Rhs = 2;
C2F(recu).rstk[C2F(recu).pt - 1] = 114;
C2F(recu).icall = 4;
/* *call* allops(fin) */
return 0;
}
SciErr createNamedBooleanSparseMatrix(void* _pvCtx, const char* _pstName, int _iRows, int _iCols, int _iNbItem, const int* _piNbItemRow, const int* _piColPos)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int iVarID[nsiz];
int iSaveRhs = Rhs;
int iSaveTop = Top;
int iPos = 0;
int* piAddr = NULL;
int* piNbItemRow = NULL;
int* piColPos = NULL;
//return named empty matrix
if(_iRows == 0 && _iCols == 0)
{
double dblReal = 0;
sciErr = createNamedMatrixOfDouble(_pvCtx, _pstName, 0, 0, &dblReal);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createNamedEmptyMatrix");
}
return sciErr;
}
if (!checkNamedVarFormat(_pvCtx, _pstName))
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createNamedBooleanSparseMatrix");
return sciErr;
}
C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
Top = Top + Nbvars + 1;
int iMemSize = (int)( ( (double)iPos / 2) + 0.5);
int iFreeSpace = iadr(*Lstk(Bot)) - (iadr(Top));
if (iMemSize > iFreeSpace)
{
addStackSizeError(&sciErr, ((StrCtx*)_pvCtx)->pstName, iMemSize);
return sciErr;
}
getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);
sciErr = fillBooleanSparseMatrix(_pvCtx, piAddr, _iRows, _iCols, _iNbItem, &piNbItemRow, &piColPos);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_BOOLEAN_SPARSE, _("%s: Unable to create %s named \"%s\""), "createNamedBooleanSparseMatrix", _("boolean sparse matrix"), _pstName);
return sciErr;
}
memcpy(piNbItemRow, _piNbItemRow, _iRows * sizeof(int));
memcpy(piColPos, _piColPos, _iNbItem * sizeof(int));
iPos = 5;//4 for header + 1 for NbItem
iPos += _iRows + _iNbItem;
//update "variable index"
updateLstk(Top, *Lstk(Top) + iPos, 0);
Rhs = 0;
//Add name in stack reference list
createNamedVariable(iVarID);
Top = iSaveTop;
Rhs = iSaveRhs;
return sciErr;
}
int C2F(intihm)()
{
/*
une routine d'insertion pour hypermatrice : cas le plus
simple : A( vi1, ..., vik ) = B
ihm ( vi1, vi2, ..., vik, B, A )
avec des vecteurs d'indices classiques vi1, vi2, ....
et B une hypermatrice ou bien une matrice
*/
HyperMat A, B;
int i, k,/* l, li, m, n,*/ ntot, mn,/* err_neg,*/ iconf, ind_max;
int nb_index_vectors, B_is_scalar;
int *j,/* nd,*/ one = 1, ltot, il, dec/*, Top_save*/;
int *PA, *PB;
short int *siPA, *siPB;
char *cPA, *cPB;
int ilp, topk;
/* CheckLhs(minlhs,maxlhs); */
if ( Rhs < 3 )
{
Scierror(999, _("%s: Wrong number of input arguments: at least %d expected.\n"), "hmops", 3);
return 0;
};
nb_index_vectors = Rhs - 2;
if ( ! get_hmat(Rhs, &A) )
{
Scierror(999, _("%s: Wrong type for input argument(s): An hypermatrix expected.\n"), "hmops");
return 0;
}
else if ( A.type == NOT_REAL_or_CMPLX_or_BOOL_or_INT || A.type == OLD_HYPERMAT )
{
/* do the job by the %x_i_hm macro family */
Fin = -Fin;
return 0;
}
if ( ! get_hmat(Rhs - 1, &B) ) /* B is not an hypermat => try if it is a matrix */
if ( ! get_mat_as_hmat(Rhs - 1, &B) ) /* it is not a matrix of type 1, 4 or 8 */
{
/* it stays some authorized possibilities like A(....) = B with B a polynomial
* matrix and A a real hypermatrix => try the %x_i_hm macro family
*/
Fin = -Fin;
return 0;
}
if ( A.type != B.type || A.it != B.it || B.size == 0 || A.dimsize < nb_index_vectors )
{
/* do the job by the %x_i_hm macro family */
Fin = -Fin;
return 0;
}
if ( B.size == 1 )
{
B_is_scalar = 1;
}
else
{
B_is_scalar = 0;
}
if ( A.dimsize > nb_index_vectors )
{
ReshapeHMat(Rhs + 1, &A, nb_index_vectors);
dec = Rhs + 1;
}
else
{
dec = Rhs;
}
/* get the index vectors */
ntot = 1;
iconf = 0;
for ( i = 1 ; i <= nb_index_vectors ; i++ )
{
if (! create_index_vector(i, dec + i, &mn, A.dims[i - 1], &ind_max))
{
return 0;
}
if ( mn == 0 ) /* the i th index vector is [] */
{
if ( B_is_scalar )
/* nothing append (strange but reproduces the Matlab behavior) */
{
goto the_end;
}
else /* B have at least 2 elts */
{
Scierror(999, _("%s: Bad hypermatrix insertion.\n"), "hmops");
return 0;
}
}
else if ( ind_max > A.dims[i - 1] )
{
/* we have to enlarge the hypermat : do the job by the %x_i_hm macro family */
Fin = -Fin;
return 0;
}
else if ( !B_is_scalar && mn != 1 ) /* do the conformity test */
{
while ( iconf < B.dimsize && B.dims[iconf] == 1 )
{
iconf++;
}
if ( iconf >= B.dimsize || B.dims[iconf] != mn )
{
Scierror(999, _("%s: Bad hypermatrix insertion.\n"), "hmops");
return 0;
}
iconf++;
}
ntot *= mn;
}
/* to finish the conformity test */
if ( !B_is_scalar && ntot != B.size )
{
Scierror(999, _("%s: Bad hypermatrix insertion.\n"), "hmops");
return 0;
}
/* indices computing */
ltot = 4;
CreateVar(dec + Rhs - 1, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &ntot, &one, <ot);
j = istk(ltot);
compute_indices(dec, nb_index_vectors, A.dims, j);
/* modify in place the hypermatrix A */
switch ( A.type )
{
case (sci_matrix) :
if ( B_is_scalar )
{
for ( k = 0 ; k < ntot ; k++ )
{
A.R[j[k]] = B.R[0];
}
if (A.it == 1)
for ( k = 0 ; k < ntot ; k++ )
{
A.I[j[k]] = B.I[0];
}
}
else
{
for ( k = 0 ; k < ntot ; k++ )
{
A.R[j[k]] = B.R[k];
}
if (A.it == 1)
for ( k = 0 ; k < ntot ; k++ )
{
A.I[j[k]] = B.I[k];
}
}
break;
case (sci_boolean) :
PA = (int *) A.P ;
PB = (int *) B.P;
if ( B_is_scalar )
for ( k = 0 ; k < ntot ; k++ )
{
PA[j[k]] = PB[0];
}
else
for ( k = 0 ; k < ntot ; k++ )
{
PA[j[k]] = PB[k];
}
break;
case (sci_ints) :
if ( A.it == I_INT32 || A.it == I_UINT32 )
{
PA = (int *) A.P ;
PB = (int *) B.P;
if ( B_is_scalar )
for ( k = 0 ; k < ntot ; k++ )
{
PA[j[k]] = PB[0];
}
else
for ( k = 0 ; k < ntot ; k++ )
{
PA[j[k]] = PB[k];
}
}
else if ( A.it == I_INT16 || A.it == I_UINT16 )
{
siPA = (short int *) A.P;
siPB = (short int *) B.P;
if ( B_is_scalar )
for ( k = 0 ; k < ntot ; k++ )
{
siPA[j[k]] = siPB[0];
}
else
for ( k = 0 ; k < ntot ; k++ )
{
siPA[j[k]] = siPB[k];
}
}
else /* 1 Byte int */
{
cPA = (char *) A.P;
cPB = (char *) B.P;
if ( B_is_scalar )
for ( k = 0 ; k < ntot ; k++ )
{
cPA[j[k]] = cPB[0];
}
else
for ( k = 0 ; k < ntot ; k++ )
{
cPA[j[k]] = cPB[k];
}
}
break;
}
/*
* ici j'essaie de faire le boulot de putlhsvar
* le code se base sur setref (SCI/system/createref.f)
* on met une variable speciale "en Top" (le nouveau
* Top = Top-Rhs+1) qui indique en fait que l'on a
* modifi� "en place" la variable topk.
* Les instructions LhsVar(1) = 0; et Nbvars = 0;
* permettent a priori de sortir "convenablement"
* de putlhsvar.
*/
the_end:
il = iadr(*Lstk(Top));
topk = *istk(il + 2);
Top = Top - Rhs + 1;
ilp = iadr(*Lstk(Top));
*istk(ilp) = -1;
*istk(ilp + 1) = -1;
*istk(ilp + 2) = topk;
if ( topk > 0 )
{
*istk(ilp + 3) = *Lstk(topk + 1) - *Lstk(topk);
}
else
{
*istk(ilp + 3) = 0;
}
*Lstk(Top + 1) = sadr(ilp + 4);
LhsVar(1) = 0;
Nbvars = 0;
return 0;
}
