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;
}
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 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 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 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;
}
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;
}
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;
}
/*--------------------------------------------------------------------------*/
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;
}
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);
}
SciErr createCommonMatrixOfPoly(void* _pvCtx, int _iVar, int _iComplex, char* _pstVarName, int _iRows, int _iCols, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
int *piAddr = NULL;
int iSize = _iRows * _iCols;
int iNewPos = Top - Rhs + _iVar;
int iAddr = *Lstk(iNewPos);
int iTotalLen = 0;
//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;
}
getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
sciErr = fillCommonMatrixOfPoly(_pvCtx, piAddr, _pstVarName, _iComplex, _iRows, _iCols, _piNbCoef, _pdblReal, _pdblImg, &iTotalLen);
if(sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_POLY, _("%s: Unable to create variable in Scilab memory"), _iComplex ? "createComplexMatrixOfPoly" : "createMatrixOfPoly");
return sciErr;
}
updateInterSCI(_iVar, '$', iAddr, iAddr + 4 + 4 + iSize + 1);
updateLstk(iNewPos, iAddr + 4 + 4 + iSize + 1, iTotalLen);
return sciErr;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
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;
}
SciErr createCommonNamedMatrixOfPoly(void* _pvCtx, const char* _pstName, char* _pstVarName, int _iComplex, int _iRows, int _iCols, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
SciErr sciErr;
sciErr.iErr = 0;
sciErr.iMsgCount = 0;
int iVarID[nsiz];
int iSaveRhs = Rhs;
int iSaveTop = Top;
int *piAddr = NULL;
int iTotalLen = 0;
//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."), "createCommonNamedMatrixOfPoly");
return sciErr;
}
C2F(str2name)(_pstName, iVarID, (unsigned long)strlen(_pstName));
Top = Top + Nbvars + 1;
getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);
//write matrix information
sciErr = fillCommonMatrixOfPoly(_pvCtx, piAddr, _pstVarName, _iComplex, _iRows, _iCols, _piNbCoef, _pdblReal, _pdblImg, &iTotalLen);
if (sciErr.iErr)
{
addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_POLY, _("%s: Unable to create %s named \"%s\""), _iComplex ? "createNamedComplexMatrixOfPoly" : "createNamedMatrixOfPoly", _("matrix of double"), _pstName);
return sciErr;
}
//update "variable index"
updateLstk(Top, *Lstk(Top) + 4, iTotalLen);
Rhs = 0;
//Add name in stack reference list
createNamedVariable(iVarID);
Top = iSaveTop;
Rhs = iSaveRhs;
return sciErr;
}
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;
}
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;
}
/*-------------------------------------------------------------------------------------*/
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 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;
}
/*--------------------------------------------------------------------------*/
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;
}
SciErr createNamedComplexZMatrixOfDouble(void* _pvCtx, const char* _pstName, int _iRows, int _iCols, const doublecomplex* _pdblData)
{
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;
if (!checkNamedVarFormat(_pvCtx, _pstName))
{
addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createNamedComplexZMatrixOfDouble");
return sciErr;
}
C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
Top = Top + Nbvars + 1;
getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);
//write matrix information
fillCommonMatrixOfDouble(_pvCtx, piAddr, 1, _iRows, _iCols, &pdblReal, &pdblImg);
vGetPointerFromDoubleComplex(_pdblData, _iRows * _iCols, pdblReal, pdblImg);
//update "variable index"
updateLstk(Top, *Lstk(Top) + sadr(4), iSize * (2) * 2);
Rhs = 0;
//Add name in stack reference list
createNamedVariable(iVarID);
Top = iSaveTop;
Rhs = iSaveRhs;
return sciErr;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
void sciblk4(scicos_block *Blocks, int flag)
{
/*counter and address variable declaration*/
int i = 0, j = 0, k = 0, topsave = 0;
int ierr = 0;
int kfun = 0;
int *header = NULL, ne1 = 0;
double *le111 = NULL;
int *il_xd = NULL, *il_res = NULL, *il_out = NULL, *il_outptr = NULL;
int *il_xprop = NULL;
int *il_z = NULL, *il_oz = NULL, *il_ozptr = NULL, *il_x = NULL;
int *il_mode = NULL, *il_evout = NULL, *il_g = NULL;
double *l_mode = NULL;
double *l_xprop = NULL;
/* variable for output typed port */
int nout = 0;
int nv = 0, mv = 0;
int *ptr = NULL, *funtyp = NULL;
/* set number of left and right hand side parameters */
int mlhs = 1, mrhs = 2;
/* Save Top counter */
topsave = Top;
/* Retrieve block number */
kfun = get_block_number();
/* Retrieve funtyp by import structure */
strcpy(C2F(cha1).buf, "funtyp");
ierr = getscicosvarsfromimport(C2F(cha1).buf, (void**)&ptr, &nv, &mv);
if (ierr == 0)
{
goto err;
}
funtyp = (int *) ptr;
/****************************
* create scilab tlist Blocks
****************************/
if ((createblklist(&Blocks[0], &ierr, (i = -1), funtyp[kfun - 1])) == 0)
{
goto err;
}
/* * flag * */
C2F(itosci)(&flag, (i = 1, &i), (j = 1, &j));
if (C2F(scierr)() != 0)
{
goto err;
}
/**********************
* Call scilab function
**********************/
C2F(scifunc)(&mlhs, &mrhs);
if (C2F(scierr)() != 0)
{
goto err;
}
/***************************
* Update C block structure
**************************/
/* get header of output variable Blocks of sciblk4 */
header = (int *) stk(*Lstk(Top));
/* switch to appropriate flag */
switch (flag)
{
/**************************
* update continuous state
**************************/
case 0 :
{
if (Blocks[0].nx != 0)
{
/* 14 - xd */
il_xd = (int *) listentry(header, 14);
ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
{
/* 15 - res */
il_res = (int *) listentry(header, 15);
ierr = sci2var(il_res, Blocks[0].res, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
}
break;
/**********************
* update output state
**********************/
case 1 :
{
/* 21 - outptr */
if (Blocks[0].nout != 0)
{
il_out = (int*) listentry(header, 21);
nout = il_out[1];
for (j = 0; j < nout; j++)
{
il_outptr = (int *) listentry(il_out, j + 1);
ierr = sci2var(il_outptr, Blocks[0].outptr[j], Blocks[0].outsz[2 * nout + j]);
if (ierr != 0)
{
goto err;
}
}
}
}
break;
/***********************
* update discrete state
***********************/
case 2 :
{
/* 7 - z */
if (Blocks[0].nz != 0)
{
il_z = (int *) listentry(header, 7);
if (Blocks[0].scsptr > 0)
{
le111 = (double *) listentry(header, 7);
ne1 = header[7 + 2] - header[7 + 1];
C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
}
else
{
ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
/* 11 - oz */
if (Blocks[0].noz != 0)
{
il_oz = (int *) listentry(header, 11);
/* C blocks : extract */
if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
{
for (j = 0; j < Blocks[0].noz; j++)
{
il_ozptr = (int *) listentry(il_oz, j + 1);
if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
{
ne1 = Blocks[0].ozsz[j];
C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
(i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
}
else
{
ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
if (ierr != 0)
{
goto err;
}
}
}
}
/* sci blocks : don't extract */
else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
{
ne1 = Blocks[0].ozsz[0];
C2F(unsfdcopy)(&ne1, (double *)il_oz, \
(i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
}
}
if (Blocks[0].nx != 0)
{
/* 13 - x */
il_x = (int *) listentry(header, 13);
ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
/* 14 - xd */
il_xd = (int *) listentry(header, 14);
ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
break;
/***************************
* update event output state
***************************/
case 3 :
{
/* 23 - evout */
il_evout = (int *) listentry(header, 23);
ierr = sci2var(il_evout, Blocks[0].evout, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
break;
/**********************
* state initialisation
**********************/
case 4 :
{
/* 7 - z */
if (Blocks[0].nz != 0)
{
il_z = (int *) listentry(header, 7);
if (Blocks[0].scsptr > 0)
{
le111 = (double *) listentry(header, 7);
ne1 = header[7 + 2] - header[7 + 1];
C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
}
else
{
ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
/* 11 - oz */
if (Blocks[0].noz != 0)
{
il_oz = (int *) listentry(header, 11);
/* C blocks : extract */
if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
{
for (j = 0; j < Blocks[0].noz; j++)
{
il_ozptr = (int *) listentry(il_oz, j + 1);
if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
{
ne1 = Blocks[0].ozsz[j];
C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
(i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
}
else
{
ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
if (ierr != 0)
{
goto err;
}
}
}
}
/* sci blocks : don't extract */
else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
{
ne1 = Blocks[0].ozsz[0];
C2F(unsfdcopy)(&ne1, (double *)il_oz, \
(i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
}
}
if (Blocks[0].nx != 0)
{
/* 13 - x */
il_x = (int *) listentry(header, 13);
ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
/* 14 - xd */
il_xd = (int *) listentry(header, 14);
ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
break;
/*********
* finish
*********/
case 5 :
{
/* 7 - z */
if (Blocks[0].nz != 0)
{
il_z = (int *) listentry(header, 7);
if (Blocks[0].scsptr > 0)
{
le111 = (double *) listentry(header, 7);
ne1 = header[7 + 2] - header[7 + 1];
C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
}
else
{
ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
/* 11 - oz */
if (Blocks[0].noz != 0)
{
il_oz = (int *) listentry(header, 11);
/* C blocks : extract */
if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
{
for (j = 0; j < Blocks[0].noz; j++)
{
il_ozptr = (int *) listentry(il_oz, j + 1);
if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
{
ne1 = Blocks[0].ozsz[j];
C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
(i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
}
else
{
ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
if (ierr != 0)
{
goto err;
}
}
}
}
/* sci blocks : don't extract */
else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
{
ne1 = Blocks[0].ozsz[0];
C2F(unsfdcopy)(&ne1, (double *)il_oz, \
(i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
}
}
}
break;
/*****************************
* output state initialisation
*****************************/
case 6 :
{
/* 7 - z */
if (Blocks[0].nz != 0)
{
il_z = (int *) listentry(header, 7);
if (Blocks[0].scsptr > 0)
{
le111 = (double *) listentry(header, 7);
ne1 = header[7 + 2] - header[7 + 1];
C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
}
else
{
ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
/* 11 - oz */
if (Blocks[0].noz != 0)
{
il_oz = (int *) listentry(header, 11);
/* C blocks : extract */
if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
{
for (j = 0; j < Blocks[0].noz; j++)
{
il_ozptr = (int *) listentry(il_oz, j + 1);
if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
{
ne1 = Blocks[0].ozsz[j];
C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
(i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
}
else
{
ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
if (ierr != 0)
{
goto err;
}
}
}
}
/* sci blocks : don't extract */
else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
{
ne1 = Blocks[0].ozsz[0];
C2F(unsfdcopy)(&ne1, (double *)il_oz, \
(i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
}
}
if (Blocks[0].nx != 0)
{
/* 13 - x */
il_x = (int *) listentry(header, 13);
ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
/* 14 - xd */
il_xd = (int *) listentry(header, 14);
ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
/* 21 - outptr */
if (Blocks[0].nout != 0)
{
il_out = (int *) listentry(header, 21);
nout = il_out[1];
for (j = 0; j < nout; j++)
{
il_outptr = (int *) listentry(il_out, j + 1);
ierr = sci2var(il_outptr, Blocks[0].outptr[j], Blocks[0].outsz[2 * nout + j]);
if (ierr != 0)
{
goto err;
}
}
}
}
break;
/*******************************************
* define property of continuous time states
* (algebraic or differential states)
*******************************************/
case 7 :
{
if (Blocks[0].nx != 0)
{
/* 40 - x */
il_xprop = (int *) listentry(header, 40);
l_xprop = (double *)(il_xprop + 4);
for (nv = 0; nv < Blocks[0].nx; nv++)
{
Blocks[0].xprop[nv] = (int) l_xprop[nv];
}
}
}
break;
/****************************
* zero crossing computation
****************************/
case 9 :
{
/* 33 - g */
il_g = (int *) listentry(header, 33);
ierr = sci2var(il_g, Blocks[0].g, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
if (get_phase_simulation() == 1)
{
/* 39 - mode */
il_mode = (int *) listentry(header, 39);
// Alan, 16/10/07 : fix : mode is an int array
l_mode = (double *)(il_mode + 4);
for (nv = 0; nv < (il_mode[1]*il_mode[2]); nv++)
{
Blocks[0].mode[nv] = (int) l_mode[nv];
}
//ierr=sci2var(il_mode,Blocks[0].mode,SCSINT_N); /* int */
//if (ierr!=0) goto err;
}
}
break;
/**********************
* Jacobian computation
**********************/
case 10 :
{
if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
{
/* 15 - res */
il_res = (int *) listentry(header, 15);
ierr = sci2var(il_res, Blocks[0].res, SCSREAL_N); /* double */
if (ierr != 0)
{
goto err;
}
}
}
break;
}
/* Restore initial position Top */
Top = topsave;
return;
/* if error then restore initial position Top
* and set_block_error with flag -1 */
err:
Top = topsave;
if (ierr != 0) /*var2sci or sci2var error*/
{
/* Please update me !*/
if (ierr < 1000) /*var2sci error*/
{
switch (ierr)
{
case 1 :
Scierror(888, _("%s: error %d. Stack is full.\n"), "var2sci", ierr);
break;
case 2 :
Scierror(888, _("%s: error %d. No more space on the stack for new data.\n"), "var2sci", ierr);
break;
default :
Scierror(888, _("%s: error %d. Undefined error.\n"), "var2sci", ierr);
break;
}
}
else /*sci2var error*/
{
switch (ierr)
{
case 1001 :
Scierror(888, _("%s: error %d. Only int or double object are accepted.\n"), "sci2var", ierr);
break;
case 1002 :
Scierror(888, _("%s: error %d. Bad double object sub_type.\n"), "sci2var", ierr);
break;
case 1003 :
Scierror(888, _("%s: error %d. Bad int object sub_type.\n"), "sci2var", ierr);
break;
case 1004 :
Scierror(888, _("%s: error %d. A type of a scilab object has changed.\n"), "sci2var", ierr);
break;
default :
Scierror(888, _("%s: error %d. Undefined error.\n"), "sci2var", ierr);
break;
}
}
}
set_block_error(-1);
}
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;
}
static int get_hmat(int num, HyperMat *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) != sci_mlist )
{
return 0;
}
else if ( *istk(il + 1) != 3 ) /* a hm mlist must have 3 fields */
{
return 0;
}
/* 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) )
{
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;
}
/* get the 2d field */
if ( *istk(il2) == sci_matrix && *istk(il2 + 3) == 0 )
{
/* this is an old hypermat (the dim field is an array of doubles) */
H->type = OLD_HYPERMAT;
H->it = -1;
H->size = -1;
H->P = (void *) istk(il3);
return 2;
}
if ( (*istk(il2) != sci_ints) | (*istk(il2 + 3) != I_INT32) )
{
return 0;
}
H->dimsize = (*istk(il2 + 1)) * (*istk(il2 + 2));
H->dims = istk(il2 + 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 ? */
/* get the 3d field */
switch ( *istk(il3) )
{
case (sci_matrix):
H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
H->type = sci_matrix;
H->it = *istk(il3 + 3);
H->R = stk(sadr(il3 + 4));
if ( H->it == 1 )
{
H->I = H->R + H->size;
}
return 1;
case (sci_boolean):
H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
H->type = sci_boolean;
H->it = 0; /* not used */
H->P = (void *) istk(il3 + 3);
return 1;
case (sci_ints):
H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
H->type = sci_ints;
H->it = *istk(il3 + 3);
H->P = (void *) istk(il3 + 4);
return 1;
default:
H->type = NOT_REAL_or_CMPLX_or_BOOL_or_INT;
H->it = -1;
H->size = -1;
H->P = (void *) istk(il3);
return 2;
}
}
