int interface_gravite(char *fname)
{
static int un = 1, nddl = N_DOF;
static int n, nbis;
static int q, G;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 1, maxlhs = 1, maxrhs = 1;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != N_DOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &nddl, &un, &G);
modele_gravite(stk(q), stk(G));
LhsVar(1) = 2;
return 0;
}
SipExport int
sip_get_verbose_int(char *fname)
{
int rout,cout,
minlhs=1, maxlhs=1, minrhs=0, maxrhs=0;
char *pout;
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
switch (sip_verbose) {
case SIP_WORDY:
pout = "wordy";
break;
case SIP_QUIET:
pout = "quiet";
break;
default:
sip_error("BUG: internal variable has invalid value (please report)");
break;
}
cout = 1;
rout = strlen(pout);
CreateVarFromPtr(1, "c", &rout, &cout, &pout);
LhsVar(1)=1;
return true;
}
/*--------------------------------------------------------------------------*/
int sci_gethistoryfile(char *fname, unsigned long fname_len)
{
char *filename = NULL;
int m1 = 0, n1 = 0;
CheckRhs(0, 0) ;
CheckLhs(0, 1) ;
filename = getFilenameScilabHistory();
if (filename)
{
n1 = 1;
m1 = (int)strlen(filename);
CreateVarFromPtr(Rhs + 1, STRING_DATATYPE, &m1, &n1, &filename);
if (filename)
{
FREE(filename);
filename = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: An error occurred: %s\n"), fname, _("filename not defined."));
}
return 0;
}
int TagsInterface(char *fname)
{
static int one = 1, ndof = NDOF;
static int n, nbis;
static int q, N;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 2, maxlhs = 1, maxrhs = 2;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != NDOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &ndof, &one, &N);
Tags(stk(N), stk(q));
LhsVar(1) = 2;
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_timer(char *fname,unsigned long fname_len)
{
double timerval = 0;
Rhs = Max(0, Rhs);
CheckLhs(0,1);
CheckRhs(0,0);
timerval = scilab_timer();
if (timerval >= 0.)
{
int l1 = 0, n1 = 1;
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE, &n1, &n1,&l1);
*stk(l1) = (double)timerval;
LhsVar(1) = Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: An error occurred.\n"), fname);
}
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;
}
/*--------------------------------------------------------------------------*/
int sci_deletefile(char *fname,unsigned long fname_len)
{
CheckRhs(1,1);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
int m1,n1,l1;
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
/* Bug 3089 */
VarName = cstk(l1);
n1=1;
if ( deleteafile(VarName) )
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(TRUE);
}
else
{
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument: A string expected.\n"),fname);
}
return 0;
}
int sci_deleteNamedVariable(char *fname, unsigned long fname_len)
{
SciErr sciErr;
int iRet = 0;
int* piAddr = NULL;
char* pstVarName = NULL;
CheckRhs(1, 1);
CheckLhs(1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr, &pstVarName))
{
//error
return 1;
}
if (isNamedVarExist(pvApiCtx, pstVarName))
{
iRet = deleteNamedVariable(pvApiCtx, pstVarName);
}
createScalarBoolean(pvApiCtx, Rhs + 1, iRet);
AssignOutputVariable(pvApiCtx, 1) = Rhs + 1;
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_fromjava(char *fname, unsigned long fname_len)
{
static int n1;
int *paramoutINT = (int*)MALLOC(sizeof(int) + 1);
Rhs = Max(0, Rhs);
CheckRhs(0, 0);
CheckLhs(1, 1);
if ( IsFromJava() )
{
*paramoutINT = (int)(TRUE);
}
else
{
*paramoutINT = (int)(FALSE);
}
n1 = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &n1, &n1, ¶moutINT);
if (paramoutINT)
{
FREE(paramoutINT);
paramoutINT = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_tzer(char *fname, unsigned long fname_len)
{
CheckRhs(4, 4);
CheckLhs(2, 3);
C2F(scitzer)(fname, fname_len);
return 0;
}
int int_imread(char * fname)
{
int mR, nR, lR;
IplImage * pImage;
CheckRhs(1, 1);
CheckLhs(1, 1);
GetRhsVar(1, "c", &mR, &nR, &lR);
// fix default mode for compatibility with previous version of SIVP
pImage = cvLoadImage(cstk(lR), 1);
/* if load image failed */
if(pImage == NULL)
{
Scierror(999, "%s: Can not open file %s.\r\n", fname, cstk(lR));
return -1;
}
IplImg2Mat(pImage, 2);
LhsVar(1) = 2;
cvReleaseImage(&pImage);
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_getlanguagealias)(char *fname,unsigned long fname_len)
{
static int l1,n1,m1;
char *Output=NULL;
CheckRhs(0,0);
CheckLhs(0,1);
Output=getlanguagealias();
if (Output)
{
n1=1;
CreateVarFromPtr( Rhs+1,STRING_DATATYPE,(m1=(int)strlen(Output), &m1),&n1,&Output);
LhsVar(1) = Rhs+1;
PutLhsVar();;
if (Output) {FREE(Output);Output=NULL;}
}
else
{
m1=0;
n1=0;
l1=0;
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
LhsVar(1)=Rhs+1;
PutLhsVar();;
return 0;
}
return 0;
}
int InertiaInterface(char *fname)
{
static int ndof = NDOF;
static int n, nbis;
static int q, M;
/* Define minls=1, maxlhs, minrhs, maxrhs */
static int minlhs = 1, minrhs = 1, maxlhs = 1, maxrhs = 1;
/* Check rhs and lhs */
CheckRhs(minrhs, maxrhs) ;
CheckLhs(minlhs, maxlhs) ;
GetRhsVar(1, "d", &n, &nbis, &q);
if (n * nbis != NDOF)
{
sciprint("Wrong size!\r\n");
Error(999);
return 0;
}
CreateVar(2, "d", &ndof, &ndof, &M);
Inertia(stk(M), stk(q));
LhsVar(1) = 2;
return 0;
}
/* ========================================================================== */
int sci_gpuLoadDynLib(char* fname)
{
int row = 0;
int col = 0;
int* piLen = NULL;
char** pstData = NULL;
int* pstrA = NULL;
int inputType_A = 0;
int i = 0;
CheckRhs(1, 1);
CheckLhs(0, 1);
// get lib
getVarAddressFromPosition(pvApiCtx,1,&pstrA);
getVarType(pvApiCtx, pstrA, &inputType_A);
getMatrixOfString(pvApiCtx, pstrA, &row, &col, NULL, NULL);
piLen = (int*)malloc(sizeof(int) * row * col);
getMatrixOfString(pvApiCtx, pstrA, &row, &col, piLen, NULL);
pstData = (char**)malloc(sizeof(char*) * row * col);
for(i = 0 ; i < row * col ; i++)
{
pstData[i] = (char*)malloc(sizeof(char) * (piLen[i] + 1));
}
getMatrixOfString(pvApiCtx, pstrA, &row, &col, piLen, pstData);
// open lib
printf("%s\n", *pstData);
Sci_dlopen(*pstData);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*-------------------------------------------------------------------------------------*/
int sci_strcat(char *fname, unsigned long fname_len)
{
CheckRhs(1, 3);
CheckLhs(1, 1);
switch (Rhs)
{
case 3:
{
sci_strcat_three_rhs(fname);
}
break;
case 2:
{
sci_strcat_two_rhs(fname);
}
break;
case 1:
{
sci_strcat_one_rhs(fname);
}
break;
default:
/* nothing */
break;
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_exportUI(char * fname, unsigned long fname_len)
{
int iFigureId = 0; // id of the figure to export
int iRows = 0;
int iCols = 0;
size_t stackPointer = 0;
CheckLhs(0, 1);
CheckRhs(1, 1);
if (GetType(1) == sci_handles) // exportUI(figHandle)
{
const char *pstFigureUID = NULL;
int iHandleType = -1;
int *piHandleType = &iHandleType;
int *piFigureId = &iFigureId;
GetRhsVar(1, GRAPHICAL_HANDLE_DATATYPE, &iRows, &iCols, &stackPointer);
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
}
pstFigureUID = getObjectFromHandle((unsigned long) * (hstk(stackPointer)));
getGraphicObjectProperty(pstFigureUID, __GO_TYPE__, jni_int, (void **)&piHandleType);
if (iHandleType == __GO_FIGURE__)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
getGraphicObjectProperty(pstFigureUID, __GO_ID__, jni_int, (void **)&piFigureId);
}
else if (GetType(1) == sci_matrix) // exportUI(figId)
{
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &iRows, &iCols, &stackPointer);
if (iRows * iCols != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
iFigureId = (int) * (stk(stackPointer));
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real Scalar or a 'Figure' handle expected.\n"), fname, 1);
return FALSE;
}
// call the export function
exportUserInterface(iFigureId);
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_type(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddr = NULL;
int iType = 0;
int iRet = 0;
CheckRhs(1, 1);
CheckLhs(1, 1);
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
sciErr = getVarType(pvApiCtx, piAddr, &iType);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 0;
}
iRet = createMatrixOfDoubleFromInteger(pvApiCtx, Rhs + 1, 1, 1, &iType);
if (iRet)
{
return 0;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
int cdf_generic(char *fname, void* pvApiCtx, struct cdf_descriptor *cdf)
{
int iErr = 0;
struct cdf_item const * it;
char *option;
CheckRhs(cdf->minrhs, cdf->maxrhs);
CheckLhs(cdf->minlhs, cdf->maxlhs);
option = create_string(pvApiCtx, 1);
for (it = cdf->items; it != cdf->end_item; ++it)
{
if (strcmp(option, it->option) == 0)
{
/* "which" argument (5th) inferred from position in item list */
iErr = CdfBase(fname, pvApiCtx, it->inarg, it->oarg, it->shift, it - cdf->items + 1, cdf->fun);
break;
}
}
destroy_string(option);
if (it == cdf->end_item)
{
/* no target found */
char *optlist;
optlist = cdf_options(cdf);
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), fname, 1, optlist);
FREE(optlist);
return 1;
}
return iErr;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_havewindow)(char *fname, unsigned long fname_len)
{
static int n1, m1;
int *Status = NULL;
CheckRhs(0, 1);
CheckLhs(1, 1);
Status = (int*)MALLOC(sizeof(int));
*Status = (int) ( getScilabMode() == SCILAB_STD );
m1 = 1;
n1 = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &n1, &n1, &Status);
LhsVar(1) = Rhs + 1;
if (Status)
{
FREE(Status);
Status = NULL;
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_librarieslist(char *fname, unsigned long fname_len)
{
char **libraries = NULL;
int sizelibraries = 0;
CheckRhs(0, 0);
CheckLhs(0, 1);
libraries = getlibrarieslist(&sizelibraries);
if (libraries)
{
int m = 0, n = 0;
m = sizelibraries;
n = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m, &n, libraries);
}
else
{
int m = 0, n = 0, l = 0;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &n, &m, &l);
}
LhsVar(1) = Rhs + 1;
freeArrayOfString(libraries, sizelibraries);
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_iswaitingforinput(char *fname, unsigned long fname_len)
{
BOOL res = FALSE;
int un = 1, outIndex = 0;
Rhs = Max(Rhs, 0);
CheckRhs(0, 1);
CheckLhs(0, 1);
if (getScilabMode() == SCILAB_STD)
{
res = ConsoleIsWaitingForInput();
}
else
{
sciprint(_("%s: Not implemented in this mode.\n"), fname);
}
CreateVar(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &un, &un, &outIndex);
*istk(outIndex) = res;
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
/*
* hand written interface
* Interface for cdfchn
* Non-central Chi-Square
*/
int cdfchnI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mDf = 0, nDf = 0, lDf = 0, i = 0;
double *Df = NULL;
Nbvars = 0;
CheckRhs(4, 5);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[5] = {3, 4, 0, 1, 2};
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 3);
}
CdfBase(fname, 3, 2, callpos, "PQ", _("X,Df and Pnonc"), 1, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "X") == 0)
{
static int callpos[5] = {2, 3, 4, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 2);
}
CdfBase(fname, 4, 1, callpos, "X", _("Df,Pnonc,P and Q"), 2, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Df") == 0)
{
static int callpos[5] = {1, 2, 3, 4, 0};
CdfBase(fname, 4, 1, callpos, "Df", _("Pnonc,P,Q and X"), 3, C2F(cdfchn),
cdfchnErr);
}
else if ( strcmp(cstk(l1), "Pnonc") == 0)
{
static int callpos[5] = {0, 1, 2, 3, 4};
GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mDf, &nDf, &lDf);
Df = stk(lDf);
for (i = 0; i < mDf * nDf; ++i)
if ((int) Df[i] - Df[i] != 0)
{
sciprint(_("%s: Warning: using non integer values for argument #%d may lead to incorrect results.\n"), fname, 5);
}
CdfBase(fname, 4, 1, callpos, "Pnonc", _("P,Q,X and Df"), 4, C2F(cdfchn),
cdfchnErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "X", "Df", "Pnonc");
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_xname(char *fname, unsigned long fname_len)
{
int m1 = 0, n1 = 0, l1 = 0;
char *pstCurrentFigure = NULL;
CheckRhs(1, 1);
CheckLhs(1, 1);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
pstCurrentFigure = getCurrentFigure();
if (pstCurrentFigure == NULL)
{
pstCurrentFigure = createNewFigureWithAxes();
}
setGraphicObjectProperty(pstCurrentFigure, __GO_NAME__, cstk(l1), jni_string, 1);
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
int sci_curblockc(char *fname, unsigned long fname_len)
{
/***********************
* variables declaration
***********************/
/* address of the data of the output parameter */
int l1 = 0;
/* local counter variable */
int j = 1, k = 1;
/* definition of min/max output argument */
static int minlhs = 1, maxlhs = 1;
/**************************
* Check number of outputs
**************************/
CheckLhs(minlhs, maxlhs);
/************************
* Create double variable
************************/
/* Create int32 variable at the top addr. of the stack */
CreateVar(1, MATRIX_OF_DOUBLE_DATATYPE, &j, &k, &l1);
/* Store value of C2F(curblk).kfun at the l1 address in istk */
*stk(l1) = (double)C2F(curblk).kfun;
/* return the value stored at Top address to lhs variable */
LhsVar(1) = 1;
PutLhsVar();
/* return 0 as default value */
return 0;
}
int sci_create_if(char *fname)
{
static int l1, m1, n1;
static int l2, m2, n2;
static int minlhs=1, maxlhs=1;
static int minrhs=1, maxrhs=1;
static int err;
void *p_sci;
debug_1 ("[if_sci_create] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// Example: SCI_FIR
GetRhsVar(1, "i", &m1, &n1, &l1);
p_sci = sci_create_ifcpp(*(istk(l1)));
if (p_sci == NULL) {
Scierror(999,"%s failed err=%d", fname, sci_err);
}
else {
/* see C:\Program Files\scicoslab-44b7\examples\interface-tour-so\ex10intc.c */
m2=1;
n2=1;
CreateVarFromPtr(2,"p",&m2,&n2, p_sci);
LhsVar(1) =2; /* return pointer */
}
debug_1 ("p_sci = 0x%X \r\n", p_sci);
debug_1 ("[if_sci_create] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_mode)(char *fname,unsigned long fname_len)
{
Rhs = Max(0, Rhs);
CheckRhs(0,1);
CheckLhs(1,1);
if (Rhs == 0)
{
int n = 1 ,l = 0;
execMode mode = getExecMode();
CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &n, &n,&l);
*istk(l) = (int)mode;
LhsVar(1) = Rhs + 1;
}
else
{
if ( VarType(1)== sci_matrix )
{
int m1 = 0, n1 = 0, l1 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ( (m1 == n1) && (n1 == 1) )
{
double dmode = *stk(l1);
int mode = (int) dmode;
if (dmode != (double)mode)
{
Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
return 0;
}
setExecMode((execMode)mode);
if ( (mode == 7) || (mode == 4) )
{
int code_message = 26;
int val_message = 0;
C2F(msgs)(&code_message, &val_message);
}
LhsVar(1) = 0;
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
PutLhsVar();
return 0;
}
/*------------------------------------------------------------------------*/
int sci_grep(char *fname, unsigned long fname_len)
{
CheckRhs(2, 3);
CheckLhs(1, 2);
if (VarType(1) == sci_matrix)
{
int m1 = 0, n1 = 0;
char **Str = NULL;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &Str);
if ((m1 == 0) && (n1 == 0))
{
int l = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l);
LhsVar(1) = Rhs + 1;
PutLhsVar();
return 0;
}
}
if (Rhs == 3)
{
if (VarType(3) == sci_strings)
{
char typ = 'd'; /*default */
int m3 = 0, n3 = 0, l3 = 0;
GetRhsVar(3, STRING_DATATYPE, &m3, &n3, &l3);
if (m3 * n3 != 0)
{
typ = cstk(l3)[0];
}
if (typ == 'r')
{
sci_grep_common(fname, TRUE);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 3, "s");
return 0;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 3);
return 0;
}
}
else /* Rhs == 2 */
{
sci_grep_common(fname, FALSE);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_ftree2(char *fname,unsigned long fname_len)
{
CheckLhs(2,2);
CheckRhs(4,4);
C2F(intree2)(fname,fname_len);
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_umf_ludel(char* fname, unsigned long l)
{
int mLU_ptr = 0, nLU_ptr = 0, lLU_ptr = 0, it_flag = 0;
void * Numeric = NULL;
CellAdr *Cell = NULL;
Rhs = Max(Rhs, 0);
/* Check numbers of input/output arguments */
CheckRhs(0, 1);
CheckLhs(1, 1);
if (Rhs == 0) /* destroy all */
{
while ( ListNumeric )
{
Cell = ListNumeric;
ListNumeric = ListNumeric->next;
if (Cell->it == 0)
{
umfpack_di_free_numeric(&(Cell->adr));
}
else
{
umfpack_zi_free_numeric(&(Cell->adr));
}
FREE(Cell);
}
}
else
{
/* get the pointer to the LU factors */
GetRhsVar(1,SCILAB_POINTER_DATATYPE, &mLU_ptr, &nLU_ptr, &lLU_ptr);
Numeric = (void *) ((unsigned long int) *stk(lLU_ptr));
/* Check if the pointer is a valid ref to ... */
if (RetrieveAdrFromList(Numeric, &ListNumeric, &it_flag))
{
/* free the memory of the numeric object */
if ( it_flag == 0 )
{
umfpack_di_free_numeric(&Numeric);
}
else
{
umfpack_zi_free_numeric(&Numeric);
}
}
else
{
Scierror(999,_("%s: Wrong value for input argument #%d: Must be a valid reference to (umf) LU factors.\n"),fname,1);
return 0;
}
}
PutLhsVar();
return 0;
}
int sci_get_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int lr3, lc3;
static int minrhs=2, maxrhs=2;
static int minlhs=0, maxlhs=1;
static int err;
struct sci_var s_v;
debug_3 ("[if_sci_get] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
CheckLhs(minlhs,maxlhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_TAPS
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
s_v = sci_get_ifcpp(p_sci, *istk(l2));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
// now when m3,n3 are set - create [mxn] sci variable on stack (it=is_complex)
if (s_v.is_double)
{ CreateCVar(3,"d", &s_v.is_complex, &s_v.m, &s_v.n, &lr3, &lc3);
// alocated mem on scilab stack for [mxn] of (complex) double
s_v.p_re=stk(lr3);
s_v.p_im=stk(lc3);
}
else if (s_v.is_boolean)
{ CreateVar(3,"b", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] boolean
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
else
{ lr3 = I_INT32;;
CreateVar(3,"I", &s_v.m, &s_v.n, &lr3);
// alocated mem on scilab stack for [mxn] of U_INT32
s_v.p_re=istk(lr3);
s_v.p_im=NULL;
}
// copy values
sci_pop_var(&s_v);
// remove data from heap
sci_delete_var(&s_v);
LhsVar(1) = 3; /* return var */
debug_3 ("[if_sci_get] +++++++++++++++++++++ \r\n");
return 0;
}
