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