예제 #1
0
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;
}
예제 #2
0
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;
}
예제 #3
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
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;
}
예제 #4
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;      
                
} 
예제 #5
0
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;
}
예제 #6
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
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;
    }
}
예제 #7
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;
}
예제 #8
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;
}
예제 #9
0
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;
}
예제 #10
0
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;
}
예제 #11
0
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;
}
예제 #12
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;
}
예제 #13
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
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);
}
예제 #14
0
SciErr createCommonMatrixOfPoly(void* _pvCtx, int _iVar, int _iComplex, char* _pstVarName, int _iRows, int _iCols, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
	SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
	int *piAddr     = NULL;
	int iSize       = _iRows * _iCols;
	int iNewPos     = Top - Rhs + _iVar;
	int iAddr       = *Lstk(iNewPos);
	int iTotalLen   = 0;

    //return empty matrix
    if(_iRows == 0 && _iCols == 0)
    {
        double dblReal = 0;
        sciErr = createMatrixOfDouble(_pvCtx, _iVar, 0, 0, &dblReal);
        if (sciErr.iErr)
        {
            addErrorMessage(&sciErr, API_ERROR_CREATE_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createEmptyMatrix");
        }
        return sciErr;
    }

	getNewVarAddressFromPosition(_pvCtx, iNewPos, &piAddr);
	sciErr = fillCommonMatrixOfPoly(_pvCtx, piAddr, _pstVarName, _iComplex, _iRows, _iCols, _piNbCoef, _pdblReal, _pdblImg, &iTotalLen);
	if(sciErr.iErr)
	{
		addErrorMessage(&sciErr, API_ERROR_CREATE_POLY, _("%s: Unable to create variable in Scilab memory"), _iComplex ? "createComplexMatrixOfPoly" : "createMatrixOfPoly");
		return sciErr;
	}

	updateInterSCI(_iVar, '$', iAddr, iAddr + 4 + 4 + iSize + 1);
	updateLstk(iNewPos, iAddr + 4 + 4 + iSize + 1, iTotalLen);

	return sciErr;
}
예제 #15
0
/*--------------------------------------------------------------------------*/
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;
}
예제 #16
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;
}
예제 #17
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;
}
예제 #18
0
SciErr createCommonNamedMatrixOfPoly(void* _pvCtx, const char* _pstName, char* _pstVarName, int _iComplex, int _iRows, int _iCols, const int* _piNbCoef, const double* const* _pdblReal, const double* const* _pdblImg)
{
    SciErr sciErr;
    sciErr.iErr = 0;
    sciErr.iMsgCount = 0;
    int iVarID[nsiz];
    int iSaveRhs    = Rhs;
    int iSaveTop    = Top;
    int *piAddr     = NULL;
    int iTotalLen   = 0;

    //return named empty matrix
    if (_iRows == 0 && _iCols == 0)
    {
        double dblReal = 0;
        sciErr = createNamedMatrixOfDouble(_pvCtx, _pstName, 0, 0, &dblReal);
        if (sciErr.iErr)
        {
            addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_EMPTY_MATRIX, _("%s: Unable to create variable in Scilab memory"), "createNamedEmptyMatrix");
        }
        return sciErr;
    }

    if (!checkNamedVarFormat(_pvCtx, _pstName))
    {
        addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createCommonNamedMatrixOfPoly");
        return sciErr;
    }

    C2F(str2name)(_pstName, iVarID, (unsigned long)strlen(_pstName));
    Top = Top + Nbvars + 1;

    getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);

    //write matrix information
    sciErr = fillCommonMatrixOfPoly(_pvCtx, piAddr, _pstVarName, _iComplex, _iRows, _iCols, _piNbCoef, _pdblReal, _pdblImg, &iTotalLen);
    if (sciErr.iErr)
    {
        addErrorMessage(&sciErr, API_ERROR_CREATE_NAMED_POLY, _("%s: Unable to create %s named \"%s\""), _iComplex ? "createNamedComplexMatrixOfPoly" : "createNamedMatrixOfPoly", _("matrix of double"), _pstName);
        return sciErr;
    }


    //update "variable index"
    updateLstk(Top, *Lstk(Top) + 4, iTotalLen);

    Rhs = 0;
    //Add name in stack reference list
    createNamedVariable(iVarID);

    Top = iSaveTop;
    Rhs = iSaveRhs;

    return sciErr;
}
예제 #19
0
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;
}
예제 #20
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;
}
예제 #21
0
/*--------------------------------------------------------------------------*/
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;
}
예제 #22
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;
}
예제 #23
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
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;
}
예제 #24
0
/*--------------------------------------------------------------------------*/
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;
}
예제 #25
0
SciErr createNamedComplexZMatrixOfDouble(void* _pvCtx, const char* _pstName, int _iRows, int _iCols, const doublecomplex* _pdblData)
{
    SciErr sciErr; sciErr.iErr = 0; sciErr.iMsgCount = 0;
    int iVarID[nsiz];
    int iSaveRhs			= Rhs;
    int iSaveTop			= Top;
    int iSize					= _iRows * _iCols;
    int *piAddr				= NULL;
    double *pdblReal	= NULL;
    double *pdblImg		= NULL;

    if (!checkNamedVarFormat(_pvCtx, _pstName))
    {
        addErrorMessage(&sciErr, API_ERROR_INVALID_NAME, _("%s: Invalid variable name."), "createNamedComplexZMatrixOfDouble");
        return sciErr;
    }

    C2F(str2name)(_pstName, iVarID, (int)strlen(_pstName));
    Top = Top + Nbvars + 1;

    getNewVarAddressFromPosition(_pvCtx, Top, &piAddr);

    //write matrix information
    fillCommonMatrixOfDouble(_pvCtx, piAddr, 1, _iRows, _iCols, &pdblReal, &pdblImg);

    vGetPointerFromDoubleComplex(_pdblData, _iRows * _iCols, pdblReal, pdblImg);

    //update "variable index"
    updateLstk(Top, *Lstk(Top) + sadr(4), iSize * (2) * 2);

    Rhs = 0;
    //Add name in stack reference list
    createNamedVariable(iVarID);

    Top = iSaveTop;
    Rhs = iSaveRhs;

    return sciErr;
}
예제 #26
0
파일: var2sci.c 프로젝트: quanpan302/scilab
/*--------------------------------------------------------------------------*/
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;
}
예제 #27
0
파일: sciblk4.c 프로젝트: quanpan302/scilab
/*--------------------------------------------------------------------------*/
void sciblk4(scicos_block *Blocks, int flag)
{
    /*counter and address variable declaration*/
    int i = 0, j = 0, k = 0, topsave = 0;
    int ierr = 0;
    int kfun = 0;

    int *header = NULL, ne1 = 0;
    double *le111 = NULL;

    int *il_xd = NULL, *il_res = NULL, *il_out = NULL, *il_outptr = NULL;
    int *il_xprop = NULL;

    int *il_z = NULL, *il_oz = NULL, *il_ozptr = NULL, *il_x = NULL;
    int *il_mode = NULL, *il_evout = NULL, *il_g = NULL;
    double *l_mode = NULL;
    double *l_xprop = NULL;

    /* variable for output typed port */
    int nout = 0;

    int nv = 0, mv = 0;
    int *ptr = NULL, *funtyp = NULL;

    /* set number of left and right hand side parameters */
    int mlhs = 1, mrhs = 2;

    /* Save Top counter */
    topsave = Top;

    /* Retrieve block number */
    kfun = get_block_number();

    /* Retrieve funtyp by import structure */
    strcpy(C2F(cha1).buf, "funtyp");
    ierr = getscicosvarsfromimport(C2F(cha1).buf, (void**)&ptr, &nv, &mv);
    if (ierr == 0)
    {
        goto err;
    }
    funtyp = (int *) ptr;

    /****************************
     * create scilab tlist Blocks
     ****************************/
    if ((createblklist(&Blocks[0], &ierr, (i = -1), funtyp[kfun - 1])) == 0)
    {
        goto err;
    }

    /* * flag * */
    C2F(itosci)(&flag, (i = 1, &i), (j = 1, &j));
    if (C2F(scierr)() != 0)
    {
        goto err;
    }

    /**********************
     * Call scilab function
     **********************/
    C2F(scifunc)(&mlhs, &mrhs);
    if (C2F(scierr)() != 0)
    {
        goto err;
    }

    /***************************
     * Update C block structure
     **************************/
    /* get header of output variable Blocks of sciblk4 */
    header = (int *) stk(*Lstk(Top));

    /* switch to appropriate flag */
    switch (flag)
    {

            /**************************
             * update continuous state
             **************************/
        case 0 :
        {
            if (Blocks[0].nx != 0)
            {
                /* 14 - xd */
                il_xd = (int *) listentry(header, 14);
                ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }

                if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
                {
                    /* 15 - res */
                    il_res = (int *) listentry(header, 15);
                    ierr = sci2var(il_res, Blocks[0].res, SCSREAL_N); /* double */
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }
        }
        break;

        /**********************
         * update output state
         **********************/
        case 1 :
        {
            /* 21 - outptr */
            if (Blocks[0].nout != 0)
            {
                il_out = (int*) listentry(header, 21);
                nout = il_out[1];

                for (j = 0; j < nout; j++)
                {
                    il_outptr = (int *) listentry(il_out, j + 1);
                    ierr = sci2var(il_outptr, Blocks[0].outptr[j], Blocks[0].outsz[2 * nout + j]);
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }
        }
        break;

        /***********************
         * update discrete state
         ***********************/
        case 2 :
        {
            /* 7 - z */
            if (Blocks[0].nz != 0)
            {
                il_z = (int *) listentry(header, 7);
                if (Blocks[0].scsptr > 0)
                {
                    le111 = (double *) listentry(header, 7);
                    ne1 = header[7 + 2] - header[7 + 1];
                    C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
                }
                else
                {
                    ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }

            /* 11 - oz */
            if (Blocks[0].noz != 0)
            {
                il_oz = (int *) listentry(header, 11);
                /* C blocks : extract */
                if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
                {
                    for (j = 0; j < Blocks[0].noz; j++)
                    {
                        il_ozptr = (int *) listentry(il_oz, j + 1);
                        if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
                        {
                            ne1 = Blocks[0].ozsz[j];
                            C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
                                           (i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
                        }
                        else
                        {
                            ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
                            if (ierr != 0)
                            {
                                goto err;
                            }
                        }
                    }
                }
                /* sci blocks : don't extract */
                else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
                {
                    ne1 = Blocks[0].ozsz[0];
                    C2F(unsfdcopy)(&ne1, (double *)il_oz, \
                                   (i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
                }
            }

            if (Blocks[0].nx != 0)
            {
                /* 13 - x */
                il_x = (int *) listentry(header, 13);
                ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }

                /* 14 - xd */
                il_xd = (int *) listentry(header, 14);
                ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }
            }
        }
        break;

        /***************************
         * update event output state
         ***************************/
        case 3 :
        {
            /* 23 - evout */
            il_evout = (int *) listentry(header, 23);
            ierr = sci2var(il_evout, Blocks[0].evout, SCSREAL_N); /* double */
            if (ierr != 0)
            {
                goto err;
            }
        }
        break;

        /**********************
         * state initialisation
         **********************/
        case 4 :
        {
            /* 7 - z */
            if (Blocks[0].nz != 0)
            {
                il_z = (int *) listentry(header, 7);
                if (Blocks[0].scsptr > 0)
                {
                    le111 = (double *) listentry(header, 7);
                    ne1 = header[7 + 2] - header[7 + 1];
                    C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
                }
                else
                {
                    ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }

            /* 11 - oz */
            if (Blocks[0].noz != 0)
            {
                il_oz = (int *) listentry(header, 11);
                /* C blocks : extract */
                if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
                {
                    for (j = 0; j < Blocks[0].noz; j++)
                    {
                        il_ozptr = (int *) listentry(il_oz, j + 1);
                        if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
                        {
                            ne1 = Blocks[0].ozsz[j];
                            C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
                                           (i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
                        }
                        else
                        {
                            ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
                            if (ierr != 0)
                            {
                                goto err;
                            }
                        }
                    }
                }
                /* sci blocks : don't extract */
                else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
                {
                    ne1 = Blocks[0].ozsz[0];
                    C2F(unsfdcopy)(&ne1, (double *)il_oz, \
                                   (i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
                }
            }

            if (Blocks[0].nx != 0)
            {
                /* 13 - x */
                il_x = (int *) listentry(header, 13);
                ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }

                /* 14 - xd */
                il_xd = (int *) listentry(header, 14);
                ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }
            }
        }
        break;

        /*********
         * finish
         *********/
        case 5 :
        {
            /* 7 - z */
            if (Blocks[0].nz != 0)
            {
                il_z = (int *) listentry(header, 7);
                if (Blocks[0].scsptr > 0)
                {
                    le111 = (double *) listentry(header, 7);
                    ne1 = header[7 + 2] - header[7 + 1];
                    C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
                }
                else
                {
                    ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }

            /* 11 - oz */
            if (Blocks[0].noz != 0)
            {
                il_oz = (int *) listentry(header, 11);
                /* C blocks : extract */
                if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
                {
                    for (j = 0; j < Blocks[0].noz; j++)
                    {
                        il_ozptr = (int *) listentry(il_oz, j + 1);
                        if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
                        {
                            ne1 = Blocks[0].ozsz[j];
                            C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
                                           (i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
                        }
                        else
                        {
                            ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
                            if (ierr != 0)
                            {
                                goto err;
                            }
                        }
                    }
                }
                /* sci blocks : don't extract */
                else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
                {
                    ne1 = Blocks[0].ozsz[0];
                    C2F(unsfdcopy)(&ne1, (double *)il_oz, \
                                   (i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
                }
            }
        }
        break;

        /*****************************
         * output state initialisation
         *****************************/
        case 6 :
        {
            /* 7 - z */
            if (Blocks[0].nz != 0)
            {
                il_z = (int *) listentry(header, 7);
                if (Blocks[0].scsptr > 0)
                {
                    le111 = (double *) listentry(header, 7);
                    ne1 = header[7 + 2] - header[7 + 1];
                    C2F(unsfdcopy)(&ne1, le111, (i = -1, &i), Blocks[0].z, (j = -1, &j));
                }
                else
                {
                    ierr = sci2var(il_z, Blocks[0].z, SCSREAL_N); /* double */
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }

            /* 11 - oz */
            if (Blocks[0].noz != 0)
            {
                il_oz = (int *) listentry(header, 11);
                /* C blocks : extract */
                if ((funtyp[kfun - 1] == 4) || (funtyp[kfun - 1] == 10004))
                {
                    for (j = 0; j < Blocks[0].noz; j++)
                    {
                        il_ozptr = (int *) listentry(il_oz, j + 1);
                        if (Blocks[0].oztyp[j] == SCSUNKNOW_N)
                        {
                            ne1 = Blocks[0].ozsz[j];
                            C2F(unsfdcopy)(&ne1, (double *)il_ozptr, \
                                           (i = 1, &i), (double *)Blocks[0].ozptr[j], (k = 1, &k));
                        }
                        else
                        {
                            ierr = sci2var(il_ozptr, Blocks[0].ozptr[j], Blocks[0].oztyp[j]);
                            if (ierr != 0)
                            {
                                goto err;
                            }
                        }
                    }
                }
                /* sci blocks : don't extract */
                else if ((funtyp[kfun - 1] == 5) || (funtyp[kfun - 1] == 10005))
                {
                    ne1 = Blocks[0].ozsz[0];
                    C2F(unsfdcopy)(&ne1, (double *)il_oz, \
                                   (i = 1, &i), (double *)Blocks[0].ozptr[0], (j = 1, &j));
                }
            }

            if (Blocks[0].nx != 0)
            {
                /* 13 - x */
                il_x = (int *) listentry(header, 13);
                ierr = sci2var(il_x, Blocks[0].x, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }

                /* 14 - xd */
                il_xd = (int *) listentry(header, 14);
                ierr = sci2var(il_xd, Blocks[0].xd, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }
            }

            /* 21 - outptr */
            if (Blocks[0].nout != 0)
            {
                il_out = (int *) listentry(header, 21);
                nout = il_out[1];
                for (j = 0; j < nout; j++)
                {
                    il_outptr = (int *) listentry(il_out, j + 1);
                    ierr = sci2var(il_outptr, Blocks[0].outptr[j], Blocks[0].outsz[2 * nout + j]);
                    if (ierr != 0)
                    {
                        goto err;
                    }
                }
            }
        }
        break;

        /*******************************************
         * define property of continuous time states
         * (algebraic or differential states)
         *******************************************/
        case 7 :
        {
            if (Blocks[0].nx != 0)
            {
                /* 40 - x */
                il_xprop = (int *) listentry(header, 40);
                l_xprop = (double *)(il_xprop + 4);
                for (nv = 0; nv < Blocks[0].nx; nv++)
                {
                    Blocks[0].xprop[nv] = (int) l_xprop[nv];
                }
            }
        }
        break;

        /****************************
         * zero crossing computation
         ****************************/
        case 9 :
        {
            /* 33 - g */
            il_g = (int *) listentry(header, 33);
            ierr = sci2var(il_g, Blocks[0].g, SCSREAL_N); /* double */
            if (ierr != 0)
            {
                goto err;
            }

            if (get_phase_simulation() == 1)
            {
                /* 39 - mode */
                il_mode = (int *) listentry(header, 39);
                // Alan, 16/10/07 : fix : mode is an int array
                l_mode = (double *)(il_mode + 4);
                for (nv = 0; nv < (il_mode[1]*il_mode[2]); nv++)
                {
                    Blocks[0].mode[nv] = (int) l_mode[nv];
                }
                //ierr=sci2var(il_mode,Blocks[0].mode,SCSINT_N); /* int */
                //if (ierr!=0) goto err;
            }
        }
        break;

        /**********************
         * Jacobian computation
         **********************/
        case 10 :
        {
            if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
            {
                /* 15 - res */
                il_res = (int *) listentry(header, 15);
                ierr = sci2var(il_res, Blocks[0].res, SCSREAL_N); /* double */
                if (ierr != 0)
                {
                    goto err;
                }
            }
        }
        break;
    }

    /* Restore initial position Top */
    Top = topsave;
    return;

    /* if error then restore initial position Top
     * and set_block_error with flag -1 */
err:
    Top = topsave;
    if (ierr != 0) /*var2sci or sci2var error*/
    {
        /* Please update me !*/
        if (ierr < 1000) /*var2sci error*/
        {
            switch (ierr)
            {
                case 1  :
                    Scierror(888, _("%s: error %d. Stack is full.\n"), "var2sci", ierr);
                    break;

                case 2  :
                    Scierror(888, _("%s: error %d. No more space on the stack for new data.\n"), "var2sci", ierr);
                    break;

                default :
                    Scierror(888, _("%s: error %d. Undefined error.\n"), "var2sci", ierr);
                    break;
            }
        }
        else /*sci2var error*/
        {
            switch (ierr)
            {
                case 1001  :
                    Scierror(888, _("%s: error %d. Only int or double object are accepted.\n"), "sci2var", ierr);
                    break;

                case 1002  :
                    Scierror(888, _("%s: error %d. Bad double object sub_type.\n"), "sci2var", ierr);
                    break;

                case 1003  :
                    Scierror(888, _("%s: error %d. Bad int object sub_type.\n"), "sci2var", ierr);
                    break;

                case 1004  :
                    Scierror(888, _("%s: error %d. A type of a scilab object has changed.\n"), "sci2var", ierr);
                    break;

                default    :
                    Scierror(888, _("%s: error %d. Undefined error.\n"), "sci2var", ierr);
                    break;
            }
        }
    }
    set_block_error(-1);
}
예제 #28
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;
}
예제 #29
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
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, &ltot);
    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;
}
예제 #30
0
파일: hmops.c 프로젝트: ZhanlinWang/scilab
static int get_hmat(int num, HyperMat *H)
{
    int il, il1, il2, il3,/* it,*/ lw;

    lw = num + Top - Rhs;
    il = iadr(*Lstk( lw ));
    if ( *istk(il) < 0 )
    {
        il = iadr(*istk(il + 1));
    }

    if ( *istk(il) != sci_mlist )
    {
        return 0;
    }
    else if ( *istk(il + 1) != 3 ) /* a hm mlist must have 3 fields */
    {
        return 0;
    }

    /*  get the pointers for the 3 fields */
    il1 = sadr(il + 6);
    il2 = il1 + *istk(il + 3) - 1;
    il3 = il1 + *istk(il + 4) - 1;
    il1 = iadr(il1);
    il2 = iadr(il2);
    il3 = iadr(il3);

    /*  test if the first field is a matrix string with 3 components
     *  and that the first is "hm" (ie 17 22  in scilab char code)
     */
    if ( (*istk(il1) != sci_strings)  |  ((*istk(il1 + 1)) * (*istk(il1 + 2)) != 3)  )
    {
        return 0;
    }
    else if ( *istk(il1 + 5) - 1 != 2 ) /* 1 str must have 2 chars */
    {
        return 0;
    }
    else if ( *istk(il1 + 8) != 17  || *istk(il1 + 9) != 22 )
    {
        return 0;
    }


    /*  get the 2d field */
    if ( *istk(il2) == sci_matrix  &&  *istk(il2 + 3) == 0 )
    {
        /* this is an old hypermat (the dim field is an array of doubles) */
        H->type = OLD_HYPERMAT;
        H->it = -1;
        H->size = -1;
        H->P = (void *) istk(il3);
        return 2;
    }

    if ( (*istk(il2) != sci_ints)  |  (*istk(il2 + 3) != I_INT32) )
    {
        return 0;
    }


    H->dimsize = (*istk(il2 + 1)) * (*istk(il2 + 2));
    H->dims = istk(il2 + 4);

    /* needed for Jpc stuff (putlhsvar) */
    Nbvars = Max(Nbvars, num);
    C2F(intersci).ntypes[num - 1] = '$';
    C2F(intersci).iwhere[num - 1] = *Lstk(lw);
    C2F(intersci).lad[num - 1] = 0; /* a voir ? */

    /*  get the 3d field */
    switch ( *istk(il3) )
    {
        case (sci_matrix):
            H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
            H->type = sci_matrix;
            H->it = *istk(il3 + 3);
            H->R = stk(sadr(il3 + 4));
            if ( H->it == 1 )
            {
                H->I = H->R + H->size;
            }
            return 1;

        case (sci_boolean):
            H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
            H->type = sci_boolean;
            H->it = 0;   /* not used */
            H->P = (void *) istk(il3 + 3);
            return 1;

        case (sci_ints):
            H->size = (*istk(il3 + 1)) * (*istk(il3 + 2));
            H->type = sci_ints;
            H->it = *istk(il3 + 3);
            H->P = (void *) istk(il3 + 4);
            return 1;

        default:
            H->type = NOT_REAL_or_CMPLX_or_BOOL_or_INT;
            H->it = -1;
            H->size = -1;
            H->P = (void *) istk(il3);
            return 2;
    }
}