int empty(void)
{
int m, n;
int k;
int m1, n1, p1;
int m2, n2, p2;
int NZMAX = 1;
int jc = 5;
int ir;
int *header;
double *value;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &p1);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &p2);
m = (int) * stk(p1);
n = (int) * stk(p2);
CreateData(3, (6 + n + 1)*sizeof(int) + sizeof(double));
header = (int *) GetData(3);
value = (double *) header;
header[0] = 7;
header[1] = m;
header[2] = n;
header[3] = 0;
header[4] = NZMAX;
header[jc] = 0;
ir = jc + n + 1;
for (k = 0; k < n; ++k)
{
header[jc + k + 1] = 0;
}
header[ir] = 0;
value[(5 + header[2] + header[4]) / 2 + 1] = 0.0;
LhsVar(1) = 3;
PutLhsVar();
return 1;
}
/*
* 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 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;
}
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_multiply_by_two(char * fname)
{
int m_in_var, n_in_var, l_in_var;
int m_out_var, n_out_var, l_out_var;
int i_row, j_col;
// First, access to the input variable (a matrix of doubles)
GetRhsVar(1, "d", &m_in_var, &n_in_var, &l_in_var);
// Create the returned variable (a matrix of doubles)
m_out_var = m_in_var;
n_out_var = n_in_var;
CreateVar(2, "d", &m_out_var, &n_out_var, &l_out_var);
// Perform some simple operations on the matrix
for (i_row = 0; i_row < m_in_var; i_row++)
{
for (j_col = 0; j_col < n_in_var; j_col++)
{
*stk(l_out_var + i_row + j_col * m_out_var) = 2 * (*stk(l_in_var + i_row + j_col * m_in_var));
}
}
// Return the output variable
LhsVar(1) = 2;
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;
}
/**IsEqualOverloaded
* Used to call the overloading function when testing unknown data type for equality
* @param double *d1: pointer on the beginning of the first variable structure
* @param int n1: memory size used by the first variable, only used for overloading
* @param double *d2: pointer on the beginning of the first variable structure
* @param int n2: memory size used by the second variable, only used for overloading
* @return 0 is the variables differ and 1 if they are identical, -1 for recursion purpose
* @author Serge Steer
* @see IsEqualVar
*/
int IsEqualOverloaded(double *d1, int n1, double *d2, int n2)
{
int *id1 = (int *) d1;
int *id2 = (int *) d2;
int il, lw;
int l1, l2;
initStackParameters();
if (Rstk[Pt] == 914 || Rstk[Pt] == 915) /* coming back after evaluation of overloading function */
{
/* Get the computed value */
il = iadr(*Lstk(Top));
Top--;
Pt--;
return *istk(il + 3);
}
/* Prepare stack for calling overloading function */
/* put references to d1 and d2 variable at the top of the stack */
l1 = *Lstk(1) + (int)(d1 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
l2 = *Lstk(1) + (int)(d2 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id1[0];
*istk(il + 1) = l1; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /* variable number unknown */
*istk(il + 3) = n1; /* variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id2[0];
*istk(il + 1) = l2; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /*variable number unknown */
*istk(il + 3) = n2; /*variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Ptover(1);
Rhs = 2;
lw = Top - 1;
if ( GetDoubleCompMode() == 0)
{
C2F(overload)(&lw, "isequalbitwise", 14L);
Rstk[Pt] = 914;
}
else
{
C2F(overload)(&lw, "isequal", 7L);
Rstk[Pt] = 915;
}
/*DEBUG_OVERLOADING("IsEqualVar Overloaded calls the parser Top=%d, Rhs=%d, Pt=%d\n",Top,Rhs,Pt);*/
return -1;
}
int main(int, char**)
{
// Test the explicit deduction guides
{
std::vector<int> v{0, 1, 2, 3, 4, 5, 6, 7, 8, 9 };
std::stack stk(v);
static_assert(std::is_same_v<decltype(stk), std::stack<int, std::vector<int>>>, "");
assert(stk.size() == v.size());
assert(stk.top() == v.back());
}
{
std::list<long, test_allocator<long>> l{10, 11, 12, 13, 14, 15, 16, 17, 18, 19 };
std::stack stk(l, test_allocator<long>(0,2)); // different allocator
static_assert(std::is_same_v<decltype(stk)::container_type, std::list<long, test_allocator<long>>>, "");
static_assert(std::is_same_v<decltype(stk)::value_type, long>, "");
assert(stk.size() == 10);
assert(stk.top() == 19);
// I'd like to assert that we've gotten the right allocator in the stack, but
// I don't know how to get at the underlying container.
}
// Test the implicit deduction guides
{
// We don't expect this one to work - no way to implicitly get value_type
// std::stack stk(std::allocator<int>()); // stack (allocator &)
}
{
std::stack<A> source;
std::stack stk(source); // stack(stack &)
static_assert(std::is_same_v<decltype(stk)::value_type, A>, "");
static_assert(std::is_same_v<decltype(stk)::container_type, std::deque<A>>, "");
assert(stk.size() == 0);
}
{
// This one is odd - you can pass an allocator in to use, but the allocator
// has to match the type of the one used by the underlying container
typedef short T;
typedef test_allocator<T> A;
typedef std::deque<T, A> C;
C c{0,1,2,3};
std::stack<T, C> source(c);
std::stack stk(source, A(2)); // stack(stack &, allocator)
static_assert(std::is_same_v<decltype(stk)::value_type, T>, "");
static_assert(std::is_same_v<decltype(stk)::container_type, C>, "");
assert(stk.size() == 4);
assert(stk.top() == 3);
}
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;
}
int intfun1(char *fname)
{
int m1, n1, l1;
CheckRhs(1, 1);
CheckLhs(1, 1);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
fun1(stk(l1), stk(l1));
LhsVar(1) = 1;
return 0;
}
/*--------------------------------------------------------------------------*/
static int sci_emptystr_two_rhs(char *fname)
{
/*value_param_pos_1 is the number of row ; value_param_pos_2 is the number of col*/
int Type_One = GetType(1);
int Type_Two = GetType(2);
if ((Type_One == sci_matrix) && (Type_Two == sci_matrix))
{
double value_param_pos_1 = 0;
double value_param_pos_2 = 0;
int matrixdimension = 0;
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &l2);
value_param_pos_1 = *stk(l1);
value_param_pos_2 = *stk(l2);
matrixdimension = (int)(value_param_pos_1 * value_param_pos_2);
if (matrixdimension > 0)
{
int m = (int)value_param_pos_1;
int n = (int)value_param_pos_2;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_STRING_DATATYPE, &m, &n, NULL);
}
else
{
/* returns [] */
int l = 0;
int m = 0;
int n = 0;
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
if (Type_One != sci_matrix)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of integers expected.\n"), fname, 1);
}
else /* Type_Two */
{
Scierror(999, _("%s: Wrong type for input argument #%d: Matrix of integers expected.\n"), fname, 2);
}
}
return 0;
}
int sci_create_list(char * fname)
{
int m_list_out, n_list_out;
int m_var1, n_var1, l_var1, l_list_var1;
int m_var2, n_var2, l_var2, l_list_var2;
int m_mlist, n_mlist, l_mlist;
// The labels of our mlist
static const char * ListLabels [] = {"mylist", "var1", "var2"};
// First, we create the variables using a classical way
// The size of the Scilab variables
m_var1 = 1;
n_var1 = strlen("a string") + 1; // a null terminated string
m_var2 = 2;
n_var2 = 2; // A 2x2 double matrix
m_mlist = 3;
n_mlist = 1; // A mlist with 3 elements
// Creation of the Scilab variables
// A('var1')
CreateVar(1, "c", &m_var1, &n_var1, &l_var1);
// A('var2')
CreateVar(2, "d", &m_var2, &n_var2, &l_var2);
// A
CreateVar(3, "m", &m_mlist, &n_mlist, &l_mlist);
// We store values in the create variables
// The matrix will be stored in A('var2')
*stk(l_var2 + 0) = 1;
*stk(l_var2 + 1) = 2;
*stk(l_var2 + 2) = 3;
*stk(l_var2 + 3) = 4;
// The string will be stored in A('var1')
strncpy(cstk(l_var1), "a string\0", n_var1);
m_list_out = 3;
n_list_out = 1;
// now, affect the variable to the mlist
// The labels (it corresponds to A = mlist(['mylist','var1','var2'], ...
CreateListVarFromPtr(3, 1, "S", &m_list_out, &n_list_out, ListLabels);
// The value stored in A('var1') (it corresponds to A = ...,'a string', ...
CreateListVarFrom(3, 2, "c", &m_var1, &n_var1, &l_list_var1, &l_var1);
// The value stored in A('var2') (it corresponds to A = ...,[1 2,3 4]);
CreateListVarFrom(3, 3, "d", &m_var2, &n_var2, &l_list_var2, &l_var2);
// We return only the mlist which has been created at position 3
LhsVar(1) = 3;
return 0;
}
/*--------------------------------------------------------------------------*/
int get_rect_arg(char *fname,int pos,rhs_opts opts[], double ** rect )
{
int m,n,l,first_opt=FirstOpt(),kopt,i;
if (pos < first_opt)
{
if (VarType(pos)) {
GetRhsVar(pos,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
if (m * n != 4) {
Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,pos,4);
return 0;
}
*rect = stk(l);
for(i=0;i<4;i++)
if(finite((*rect)[i]) == 0){
Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
return 0;
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
setDefRect( zeros ) ;
*rect = getDefRect() ;
}
}
else if ((kopt=FindOpt("rect",opts))) {/* named argument: rect=value */
GetRhsVar(kopt,MATRIX_OF_DOUBLE_DATATYPE, &m, &n, &l);
if (m * n != 4) {
Scierror(999,"%s: Wrong size for input argument #%d: %d expected\n",fname,kopt,4);
return 0;
}
*rect = stk(l);
for(i=0;i<4;i++)
if(finite((*rect)[i]) == 0){
Scierror(999,"%s: Wrong values (Nan or Inf) for input argument: %d finite values expected\n",fname,4);
return 0;
}
}
else
{
/** global value can be modified **/
double zeros[4] = { 0.0, 0.0, 0.0, 0.0 } ;
setDefRect( zeros ) ;
*rect = getDefRect() ;
}
return 1;
}
int ext8c(double *y)
{
static int m, n, lp, i;
GetMatrixptr("param", &m, &n, &lp);
/* param can be changed */
*stk(lp) = 18.0;
/* param can be read */
for (i = 0; i < m * n ; i++ )
{
y[i] = (*stk(lp + i));
}
return 0;
}
/*--------------------------------------------------------------------------*/
int cdfpoiI(char* fname, unsigned long l)
{
int m1 = 0, n1 = 0, l1 = 0, mS = 0, nS = 0, lS = 0, i = 0;
double *S = NULL;
Nbvars = 0;
CheckRhs(3, 4);
CheckLhs(1, 2);
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
if ( strcmp(cstk(l1), "PQ") == 0)
{
static int callpos[4] = {2, 3, 0, 1};
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 2);
return 0;
}
CdfBase(fname, 2, 2, callpos, "PQ", _("S and Xlam"), 1, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "S") == 0)
{
static int callpos[4] = {1, 2, 3, 0};
CdfBase(fname, 3, 1, callpos, "S", _("Xlam,P and Q"), 2, C2F(cdfpoi),
cdfpoiErr);
}
else if ( strcmp(cstk(l1), "Xlam") == 0)
{
static int callpos[4] = {0, 1, 2, 3};
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mS, &nS, &lS);
S = stk(lS);
for (i = 0; i < mS * nS; ++i)
if (S[i] == S[i] && S[i] + 1 != S[i]) // NaN and Inf will be handled in the program
if ((int) S[i] - S[i] != 0)
{
Scierror(999, _("%s: Wrong value for input argument #%d: A matrix of integer value expected.\n"), fname, 4);
return 0;
}
CdfBase(fname, 3, 1, callpos, "Xlam", _("P,Q and S"), 3, C2F(cdfpoi),
cdfpoiErr);
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s', '%s' or '%s' expected.\n"), fname, 1, "PQ", "S", "Xlam");
}
return 0;
}
static int cre_hmat(int pos, HyperMat *H)
{
/* dans cette version, seuls les champs dimsize, size et it sont definis
* et on alloue alors la memoire des champs dims, R (et I si it=1) dans
* la pile scilab (juste � la place occupee par la variable).
*/
static char *Str[] = { "hm", "dims", "entries"};
int m1 = 1, n1 = 3;
int mL = 3, nL = 1, lL, one = 1, lr, lc, lar, lac;
CreateVar(pos, MATRIX_ORIENTED_TYPED_LIST_DATATYPE, &mL, &nL, &lL);
CreateListVarFromPtr(pos, 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, Str);
lr = 4;
lar = -1;
CreateListVarFrom(pos, 2, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &one, &H->dimsize, &lr, &lar);
H->dims = istk(lr);
lar = -1;
lac = -1;
switch (H->type)
{
case (sci_matrix):
CreateListCVarFrom(pos, 3, MATRIX_OF_DOUBLE_DATATYPE, &H->it, &H->size, &one , &lr, &lc, &lar, &lac);
H->R = stk(lr);
if ( H->it == 1)
{
H->I = stk(lc);
}
return 1;
case (sci_boolean):
CreateListVarFrom(pos, 3, MATRIX_OF_BOOLEAN_DATATYPE, &H->size, &one, &lr, &lar);
H->P = (void *) istk(lr);
return 1;
case (sci_ints):
lr = H->it;
CreateListVarFrom(pos, 3, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &H->size, &one, &lr, &lar);
H->P = (void *) istk(lr);
return 1;
}
/* Ajout Allan CORNET Correction Warning */
/* warning C4715: 'cre_hmat' : not all control paths return a value */
return 1;
}
int sci_exec_if(char *fname)
{
static int l1, m1, n1;
void *p_sci;
static int l2, m2, n2;
static int minrhs=2, maxrhs=2;
static int err;
debug_3 ("[sci_exec_if] ..................... \r\n");
CheckRhs(minrhs,maxrhs);
// example: pfir1
m1=1;
n1=1;
GetRhsVar(1,"p",&m1,&n1,&l1);
// example: SCI_RESET
GetRhsVar(2, "i", &m2, &n2, &l2);
p_sci = (void *) ((unsigned long int) *stk(l1));
sci_exec_ifcpp(p_sci, *(istk(l2)));
if (sci_err) {
sciprint("\n%s:\n info:%d\n",sci_err_msg,sci_info);
Scierror(999,"%s failed err=%d", fname, sci_err);
return 0;
}
debug_3 ("[sci_exec_if] +++++++++++++++++++++ \r\n");
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_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 set_figure_size_property(void* _pvCtx, char* pobjUID, size_t stackPointer, int valueType, int nbRow, int nbCol )
{
double * values = stk( stackPointer ) ;
BOOL status = FALSE;
int intValues[2];
if ( !( valueType == sci_matrix ) )
{
Scierror(999, _("Wrong type for '%s' property: Real matrix expected.\n"), "figure_size");
return SET_PROPERTY_ERROR ;
}
if ( nbRow * nbCol != 2 )
{
Scierror(999, _("Wrong size for '%s' property: %d elements expected.\n"), "figure_size", 2) ;
return SET_PROPERTY_ERROR ;
}
intValues[0] = (int)values[0];
intValues[1] = (int)values[1];
status = setGraphicObjectProperty(pobjUID, __GO_SIZE__, intValues, jni_int_vector, 2);
if (status == TRUE)
{
return SET_PROPERTY_SUCCEED;
}
else
{
Scierror(999, _("'%s' property does not exist for this handle.\n"), "figure_size");
return SET_PROPERTY_ERROR;
}
}
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_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 set_z_shift_property(void* _pvCtx, char * pobjUID, size_t stackPointer, int valueType, int nbRow, int nbCol )
{
BOOL result = FALSE;
double* shiftCoordinates = NULL;
int nbElement = nbRow * nbCol;
int iNumElements = 0;
int* piNumElements = &iNumElements;
if ( !( valueType == sci_matrix ) )
{
Scierror(999, _("Wrong type for '%s' property: Real matrix expected.\n"), "z_shift");
return SET_PROPERTY_ERROR;
}
if ( nbRow > 1 && nbCol > 1 )
{
Scierror(999, _("Wrong size for '%s' property: Must be in the set {%s}.\n"), "z_shift", "0x0, 1xn, nx1");
return SET_PROPERTY_ERROR;
}
getGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_NUM_ELEMENTS__, jni_int, (void**)&piNumElements);
if (piNumElements == NULL)
{
Scierror(999, _("'%s' property does not exist for this handle.\n"), "z_shift");
return SET_PROPERTY_ERROR;
}
if ( nbElement != 0 && nbElement != iNumElements) /* we can specify [] (null vector) to reset to default */
{
Scierror(999, _("Wrong size for '%s' property: %d or %d elements expected.\n"), "z_shift", 0, iNumElements);
return SET_PROPERTY_ERROR;
}
if ( nbElement != 0 )
{
shiftCoordinates = (double*) stk(stackPointer);
result = setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Z_COORDINATES_SHIFT__, shiftCoordinates, jni_double_vector, iNumElements);
/* The FALSE value is used for now to identify a failed memory allocation */
if (result == FALSE)
{
Scierror(999, _("%s: No more memory.\n"), "set_z_shift_property");
return SET_PROPERTY_ERROR;
}
}
else
{
/*
* Setting the shift flag to 0 directly in the model
* when filling the shift coordinates array (0-element case)
* would probably be better.
*/
int shiftSet = 0;
setGraphicObjectProperty(pobjUID, __GO_DATA_MODEL_Z_COORDINATES_SHIFT_SET__, &shiftSet, jni_double_vector, 1);
}
return SET_PROPERTY_SUCCEED;
}
void test_expression_evaluator_each(GLEPolish* polish, const std::string& expression, const std::string& expectedValue) {
int cp = 0;
int rtype = 0;
GLEPcodeList pc_list;
GLEPcode pcode(&pc_list);
polish->polish(expression.c_str(), pcode, &rtype);
GLERC<GLEArrayImpl> stk(new GLEArrayImpl());
std::ostringstream msg;
msg << expression << ": ";
if (is_float(expectedValue)) {
GLEMemoryCell* mc = evalGeneric(stk.get(), &pc_list, (int*)&pcode[0], &cp);
gle_memory_cell_check(mc, GLEObjectTypeDouble);
double expectedDouble = tokenizer_string_to_double(expectedValue.c_str());
msg << mc->Entry.DoubleVal << " == " << expectedValue;
if (expectedDouble == 0.0) {
unit_test_msg(fabs(mc->Entry.DoubleVal) < CUTILS_REL_PREC_FINE, msg.str());
} else {
unit_test_msg(equals_rel_fine(mc->Entry.DoubleVal, expectedDouble), msg.str());
}
} else {
GLERC<GLEString> result(evalString(stk.get(), &pc_list, (int*)&pcode[0], &cp, true));
std::string computedString(result->toUTF8());
msg << computedString << " == " << expectedValue;
unit_test_msg(expectedValue == computedString, msg.str());
}
}
/*--------------------------------------------------------------------------*/
static int GetScalarDouble(char *fname, int *prev, int *arg, int narg, int *ic, int ir, double *dval)
{
int mx = 0, nx = 0, lx = 0;
if (*prev != 1)
{
*arg = *arg + 1;
*ic = 1;
*prev = 1;
}
GetRhsVar(*arg, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
if (*ic > nx)
{
*arg = *arg + 1;
if (*arg > narg )
{
return NOT_ENOUGH_ARGS;
}
*ic = 1;
GetRhsVar(*arg, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
}
if (ir > mx)
{
return RET_END;
}
*dval = *(stk(lx + ir - 1 + mx * (*ic - 1)));
*ic = *ic + 1;
return OK;
}
/*--------------------------------------------------------------------------*/
int C2F(sci_mode)(char *fname,unsigned long fname_len)
{
Rhs = Max(0, Rhs);
CheckRhs(0,1);
CheckLhs(1,1);
if (Rhs == 0)
{
int n = 1 ,l = 0;
execMode mode = getExecMode();
CreateVar(Rhs+1, MATRIX_OF_INTEGER_DATATYPE, &n, &n,&l);
*istk(l) = (int)mode;
LhsVar(1) = Rhs + 1;
}
else
{
if ( VarType(1)== sci_matrix )
{
int m1 = 0, n1 = 0, l1 = 0;
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &l1);
if ( (m1 == n1) && (n1 == 1) )
{
double dmode = *stk(l1);
int mode = (int) dmode;
if (dmode != (double)mode)
{
Scierror(999,_("%s: Wrong value for input argument #%d: A int expected.\n"),fname,1);
return 0;
}
setExecMode((execMode)mode);
if ( (mode == 7) || (mode == 4) )
{
int code_message = 26;
int val_message = 0;
C2F(msgs)(&code_message, &val_message);
}
LhsVar(1) = 0;
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
else
{
Scierror(999,_("%s: Wrong size for input argument #%d: A scalar expected.\n"),fname,1);
return 0;
}
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
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;
}
ehval_p Function::exec(ehval_p base_object, ehval_p function_object, ehval_p args, EHI *ehi) {
Function::t *f = function_object->get<Function>();
switch(f->type) {
case lib_e: {
ehstack_entry_t stk(function_object->get_full_name(), nullptr, ehi->get_stack());
return f->libmethod_pointer(base_object, args, ehi);
}
case compiled_e: {
ehval_p newcontext = Function_Scope::make(f->parent, ehi->get_parent());
ehstack_entry_t stk(function_object->get_full_name(), newcontext, ehi->get_stack());
return f->compiled_pointer(base_object, args, ehi, ehcontext_t(base_object, newcontext));
}
case user_e: {
ehval_p newcontext = Function_Scope::make(f->parent, ehi->get_parent());
ehstack_entry_t stk(function_object->get_full_name(), newcontext, ehi->get_stack());
ehcontext_t context(base_object, newcontext);
// set arguments
attributes_t attributes(private_e, nonstatic_e, nonconst_e);
ehi->set(f->args, args, &attributes, context);
// execute the function
ehval_p ret = ehi->eh_execute(f->code, context);
ehi->not_returning();
return ret;
}
case bytecode_e: {
ehval_p newcontext = Function_Scope::make(f->parent, ehi->get_parent());
ehstack_entry_t stk(function_object->get_full_name(), newcontext, ehi->get_stack());
ehcontext_t context(base_object, newcontext);
if(f->is_generator) {
auto frame = new eh_frame_t(eh_frame_t::generator_e, f->bytecode.co, f->bytecode.offset, context, args);
auto gen = Generator::make(function_object, frame, ehi);
// execute the argument-setting code of the generator function
eh_execute_frame(frame, ehi);
return gen;
} else {
eh_frame_t frame(eh_frame_t::function_e, f->bytecode.co, f->bytecode.offset, context, args);
return eh_execute_frame(&frame, ehi);
}
}
}
}
void GLEPolish::internalEval(const char *exp, double *x) throw(ParserError) {
// difference with eval: no try / catch
int rtype = 1, cp = 0;
GLEPcodeList pc_list;
GLEPcode pcode(&pc_list);
internalPolish(exp, pcode, &rtype);
GLERC<GLEArrayImpl> stk(new GLEArrayImpl());
*x = evalDouble(stk.get(), &pc_list, (int*)&pcode[0], &cp);
}
vector<int> findRedundantDirectedConnection(vector<vector<int>>& edges) {
//construct the graph, and record the node which has 2 parents if possible
int N = edges.size();
for(int n=1; n<=N; ++n)
getNode[n] = Node();
int node2parents = -1;
for(int i=0; i<N; ++i){
int p = edges[i][0];
int c = edges[i][1];
edgeOrder[p][c] = i;
getNode[p].to.push_back(c);
getNode[c].from.push_back(p);
if(getNode[c].from.size()==2) //we find a node with 2 parents
node2parents = c;
}
//doing DFS to find the loop if loop exists
vector<int> status(N+1,0); // status 0,1,2 ==> 0:unvisited, 1:visiting, 2:visited
stack<int> loop;
bool loopfound = false;
for(int i=1; i<=N; ++i){
if(loopfound) break;
if(status[i] == 0){ //DFS started with node i
status[i] = 1;
stack<int> stk({i});
DFS(stk,status,loopfound,loop);
status[i] = 2;
}
}
if(!loopfound){ // Case 1
int parent1 = getNode[node2parents].from[0];
int parent2 = getNode[node2parents].from[1];
return (edgeOrder[parent1][node2parents] > edgeOrder[parent2][node2parents]) ?
vector<int>({parent1,node2parents}) : vector<int>({parent2,node2parents});
}
int last_occur_order = 0;
vector<int> last_occur_edge;
int begin = loop.top();
while(!loop.empty()){
int child = loop.top();
loop.pop();
int parent = loop.top();
if(node2parents != -1 && child == node2parents) // Case 2
return vector<int>({parent,child});
int order = edgeOrder[parent][child];
if(order > last_occur_order){
last_occur_order = order;
last_occur_edge = vector<int>({parent,child});
}
if(parent == begin)
break; //loop ends
}
return last_occur_edge; // Case 3
}
void GLEPolish::internalEvalString(const char* exp, string* str) throw(ParserError) {
// difference with eval_string: no try / catch
int rtype = 2, cp = 0;
GLEPcodeList pc_list;
GLEPcode pcode(&pc_list);
internalPolish(exp, pcode, &rtype);
GLERC<GLEArrayImpl> stk(new GLEArrayImpl());
GLERC<GLEString> result(::evalString(stk.get(), &pc_list, (int*)&pcode[0], &cp, true));
*str = result->toUTF8();
}
