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