stack2.c File Reference

#include <string.h>
#include <stdio.h>
#include "MALLOC.h"
#include "stack-c.h"
#include "sciprint.h"
#include "stack2.h"
#include "../../../string/includes/men_Sutils.h"

Include dependency graph for stack2.c:

Go to the source code of this file.

Data Structures
struct	inter_s_
struct	inter_l
Typedefs
typedef inter_s_	intersci_state
typedef inter_l	intersci_list
Functions
static char *Get_Iname	__PARAMS ((void))
static int	C2F (mvfromto)
int C2F()	checklhs (char *fname, integer *iMin, integer *iMax, unsigned long fname_len)
int C2F()	isopt (integer *k, char *namex, unsigned long name_len)
int C2F()	isoptlw (integer *topk, integer *lw, char *namex, unsigned long name_len)
integer C2F()	firstopt ()
int C2F()	findopt (char *str, rhs_opts opts[])
integer C2F()	numopt ()
integer C2F()	vartype (integer *number)
integer C2F()	gettype (integer *lw)
integer C2F()	overloadtype (integer *lw, char *fname, char *typ)
integer C2F()	overload (integer *lw, char *fname, unsigned long l)
integer C2F()	ogettype (integer *lw)
int	get_optionals (char *fname, rhs_opts opts[])
int	rhs_opt_find (char *name, rhs_opts opts[])
void	rhs_opt_print_names (rhs_opts opts[])
int	IsRef (int number)
int C2F()	isref (integer *number)
int C2F()	createvar (integer *lw, char *typex, integer *m, integer *n, integer *lr, unsigned long type_len)
int C2F()	createcvar (integer *lw, char *typex, integer *it, integer *m, integer *n, integer *lr, integer *lc, unsigned long type_len)
int C2F()	createlist (integer *lw, integer *nel)
int C2F()	createvarfrom (integer *lw, char *typex, integer *m, integer *n, integer *lr, integer *lar, unsigned long type_len)
int C2F()	createcvarfrom (integer *lw, char *typex, integer *it, integer *m, integer *n, integer *lr, integer *lc, integer *lar, integer *lac, unsigned long type_len)
int C2F()	createlistvarfrom (integer *lnumber, integer *number, char *typex, integer *m, integer *n, integer *lr, integer *lar, unsigned long type_len)
int C2F()	createlistcvarfrom (integer *lnumber, integer *number, char *typex, integer *it, integer *m, integer *n, integer *lr, integer *lc, integer *lar, integer *lac, unsigned long type_len)
int C2F()	createlistvarfromptr (integer *lnumber, integer *number, char *typex, integer *m, integer *n, void *iptr, unsigned long type_len)
int C2F()	createlistcvarfromptr (integer *lnumber, integer *number, char *typex, integer *it, integer *m, integer *n, void *iptr, void *iptc, unsigned long type_len)
int C2F()	creatework (integer *number, integer *m, integer *lr)
int C2F()	setworksize (integer *number, integer *size)
int C2F()	getmatdims (integer *number, integer *m, integer *n)
int C2F()	getrhsvar (integer *number, char *typex, integer *m, integer *n, integer *lr, unsigned long type_len)
int C2F()	getrhscvar (integer *number, char *typex, integer *it, integer *m, integer *n, integer *lr, integer *lc, unsigned long type_len)
int C2F()	elementtype (integer *lnumber, integer *number)
int C2F()	getlistrhsvar (integer *lnumber, integer *number, char *typex, integer *m, integer *n, integer *lr, unsigned long type_len)
int C2F()	getlistrhscvar (integer *lnumber, integer *number, char *typex, integer *it, integer *m, integer *n, integer *lr, integer *lc, unsigned long type_len)
int C2F()	createvarfromptr (integer *number, char *typex, integer *m, integer *n, void *iptr, unsigned long type_len)
int C2F()	createcvarfromptr (integer *number, char *typex, integer *it, integer *m, integer *n, double *iptr, double *iptc, unsigned long type_len)
int C2F()	mklistfromvars (integer *pos, integer *n)
int C2F()	mktlistfromvars (integer *pos, integer *n)
int C2F()	mkmlistfromvars (integer *pos, integer *n)
int C2F()	callscifun (char *string, unsigned long string_len)
int C2F()	scifunction (integer *number, integer *ptr, integer *mlhs, integer *mrhs)
int C2F()	scistring (integer *ifirst, char *thestring, integer *mlhs, integer *mrhs, unsigned long thestring_len)
integer C2F()	getopcode (char *string, unsigned long string_len)
int C2F()	scibuiltin (integer *number, integer *ifun, integer *ifin, integer *mlhs, integer *mrhs)
int C2F()	sciops (integer *number, integer *op, integer *mlhs, integer *mrhs)
int C2F()	getrhssys (integer *lw, integer *n, integer *m, integer *p, integer *ptra, integer *ptrb, integer *ptrc, integer *ptrd, integer *ptrx0, double *hx)
int C2F()	errorinfo (char *fname, integer *info, unsigned long fname_len)
integer C2F()	maxvol (integer *lw, char *lw_type, unsigned long type_len)
static int	Check_references ()
int C2F()	putlhsvar ()
static int C2F()	mvfromto (integer *itopl, integer *ix)
int	Ref2val (int from, int to)
int C2F()	convert2sci (integer *ix)
void	strcpy_tws (char *str1, char *str2, int len)
int C2F()	in2str (integer *n, integer *line, char *str, unsigned long str_len)
static char *	Get_Iname ()
char *	ArgPosition (int i)
char *	ArgsPosition (int i, int j)
void	ConvertData (char *type, int size, int l)
static int	check_prop (char *mes, int posi, int m)
int	check_square (int posi, int m, int n)
int	check_vector (int posi, int m, int n)
int	check_row (int posi, int m, int n)
int	check_col (int posi, int m, int n)
int	check_scalar (int posi, int m, int n)
int	check_dims (int posi, int m, int n, int m1, int n1)
int	check_one_dim (int posi, int dim, int val, int valref)
int	check_length (int posi, int m, int m1)
int	check_same_dims (int i, int j, int m1, int n1, int m2, int n2)
int	check_dim_prop (int i, int j, int flag)
static int	check_list_prop (char *mes, int lpos, int posi, int m)
int check_list_square	__PARAMS ((int lpos, int posi, int m, int n))
int	check_list_vector (int lpos, int posi, int m, int n)
int	check_list_row (int lpos, int posi, int m, int n)
int	check_list_col (int lpos, int posi, int m, int n)
int	check_list_scalar (int lpos, int posi, int m, int n)
int	check_list_one_dim (int lpos, int posi, int dim, int val, int valref)
int C2F()	createdata (integer *lw, integer n)
int C2F()	copyvarfromsciptr (integer lw, integer n, integer l)
void *	GetData (int lw)
int	GetDataSize (int lw)
void *	GetRawData (int lw)
void *	GetDataFromName (char *name)
int C2F()	createreference (int number, int pointed)
int C2F()	changetoref (int number, int pointed)
int C2F()	createreffromname (int number, char *name)
static int	intersci_push (void)
static void	intersci_pop (void)
Variables
static integer	cx1 = 1
static integer	cx0 = 0
static char	Fname [nlgh+1]
static char *	pos [] = {"first","second","third","fourth"}
static char	arg_position [56]
static intersci_list *	L_intersci

---

Typedef Documentation

typedef struct inter_l intersci_list

typedef struct inter_s_ intersci_state

---

Function Documentation

int check_list_square __PARAMS

(

(int lpos, int posi, int m, int n)

)

Definition at line 2998 of file stack2.c.

References check_list_prop().

{
  return check_list_prop("square",lpos,posi, (m != n));
}

Here is the call graph for this function:

static char* Get_Iname __PARAMS

(

(void)

)

[static]

char* ArgPosition

(

int

i

)

Definition at line 2810 of file stack2.c.

Referenced by check_dims(), check_length(), check_list_prop(), check_one_dim(), and check_prop().

{
  if ( i > 0 && i <= 4 ) 
    sprintf(arg_position,"%s argument",pos[i-1]);
  else 
    sprintf(arg_position,"argument number %d",i);
  return arg_position;
}

Here is the caller graph for this function:

char* ArgsPosition	(	int	i,
		int	j
	)

Definition at line 2819 of file stack2.c.

Referenced by check_dim_prop(), and check_same_dims().

{
  if ( i > 0 && i <= 4 ) 
    {
      if ( j > 0 && j <= 4 ) 
        sprintf(arg_position,"%s and %s arguments",pos[i-1],pos[j-1]);
      else 
        sprintf(arg_position,"%s argument and argument %d",pos[i-1],j);
    }
  else 
    {
      if ( j > 0 && j <= 4 ) 
        sprintf(arg_position,"%s argument and argument %d",pos[j-1],i);
      else 
        sprintf(arg_position,"arguments %d and %d",i,j);
    }
  return arg_position;
}

Here is the caller graph for this function:

static int C2F

(

mvfromto

)

[static]

Definition at line 30 of file stack2.c.

References C2F, cvname(), cx0, FALSE_, get_fname(), nsiz, and TRUE_.

           : checks right hand side arguments 
 *-----------------------------------------------*/

int C2F(checkrhs)(char *fname, integer *iMin, integer *iMax, unsigned long  fname_len)
{
  /*
   * store the name in recu array, fname can be a non null terminated char array  
   * Get_Iname() can be used in other function to get the interface name 
   */

  C2F(cvname)(&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], fname, &cx0, fname_len);
  
  if ( Rhs < *iMin || Rhs > *iMax) 
    {
      Scierror(77,"%s: wrong number of rhs arguments\r\n",get_fname(fname,fname_len));
      return FALSE_; 
    }
  return TRUE_;
} 

Here is the call graph for this function:

int C2F() callscifun	(	char *	string,
		unsigned long	string_len
	)

Definition at line 1836 of file stack2.c.

References C2F, cvname(), cx0, id, nsiz, putid(), and string_len.

Referenced by sci_xload(), and sci_xsave().

{
  integer id[nsiz];
  C2F(cvname)(id, string, &cx0, string_len);
  C2F(putid)(&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], id);
  C2F(com).fun = -1;
  return 0;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() changetoref	(	int	number,
		int	pointed
	)

Definition at line 3156 of file stack2.c.

References C2F, GetRawData(), iadr, istk, Lstk, offset, pointed, Rhs, and Top.

{
  int offset; int point_ed; int *header;
  header =  GetRawData(number);
  offset = Top - Rhs;
  point_ed = offset + pointed;
  header[0]= - *istk( iadr(*Lstk( point_ed )) );  /* reference : 1st entry (type) is opposite */
  header[1]= *Lstk(point_ed);  /* pointed adress */
  header[2]= pointed; /* pointed variable */
  header[3]= *Lstk(point_ed + 1) - *Lstk(point_ed);  /* size of pointed variable */
  C2F(intersci).ntypes[number-1]= '-';
  return 1;
}

Here is the call graph for this function:

int check_col	(	int	posi,
		int	m,
		int	n
	)

Definition at line 2911 of file stack2.c.

References check_prop().

{
  return check_prop("should be a column vector",posi, n != 1);
}

Here is the call graph for this function:

int check_dim_prop	(	int	i,
		int	j,
		int	flag
	)

Definition at line 2972 of file stack2.c.

References ArgsPosition(), FALSE_, Get_Iname(), and TRUE_.

{
  if ( flag ) 
    {
      Scierror(999,"%s: %s have incompatible dimensions\r\n",
               Get_Iname(),
               ArgsPosition(i,j));
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

int check_dims	(	int	posi,
		int	m,
		int	n,
		int	m1,
		int	n1
	)

Definition at line 2921 of file stack2.c.

References ArgPosition(), FALSE_, Get_Iname(), and TRUE_.

{
  if ( m != m1 ||  n != n1 ) 
    { 
      Scierror(999,"%s: %s has wrong dimensions (%d,%d), expecting (%d,%d)\r\n",
               Get_Iname(),
               ArgPosition(posi),
               m,n,
               m1,n1);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

int check_length	(	int	posi,
		int	m,
		int	m1
	)

Definition at line 2949 of file stack2.c.

References ArgPosition(), FALSE_, Get_Iname(), and TRUE_.

{
  if ( m != m1 )
    { 
      Scierror(999,"%s: %s has wrong length %d, expecting (%d)\r\n",
               Get_Iname(),
               ArgPosition(posi),
               m, m1);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

int check_list_col	(	int	lpos,
		int	posi,
		int	m,
		int	n
	)

Definition at line 3013 of file stack2.c.

References check_list_prop().

{
  return check_list_prop("a column vector",lpos,posi, n != 1);
}

Here is the call graph for this function:

int check_list_one_dim	(	int	lpos,
		int	posi,
		int	dim,
		int	val,
		int	valref
	)

Definition at line 3023 of file stack2.c.

References FALSE_, Get_Iname(), and TRUE_.

{
  if ( val != valref) 
    { 
      Scierror(999,"%s: argument %d(%d) has wrong %s dimension (%d), expecting (%d)\r\n",
               Get_Iname(),lpos,posi,
               ( dim == 1 ) ? "first" : "second" ,
               val,valref);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

static int check_list_prop	(	char *	mes,
		int	lpos,
		int	posi,
		int	m
	)			[static]

Definition at line 2985 of file stack2.c.

References ArgPosition(), FALSE_, Get_Iname(), and TRUE_.

Referenced by __PARAMS(), check_list_col(), check_list_row(), check_list_scalar(), and check_list_vector().

{
  if ( m ) 
    { 
      Scierror(999,"%s: %s should be a list with %d-element being %s \r\n",
               Get_Iname(),
               ArgPosition(posi),
               posi,mes);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int check_list_row	(	int	lpos,
		int	posi,
		int	m,
		int	n
	)

Definition at line 3008 of file stack2.c.

References check_list_prop().

{
  return check_list_prop("a row vector",lpos,posi, m != 1);
}

Here is the call graph for this function:

int check_list_scalar	(	int	lpos,
		int	posi,
		int	m,
		int	n
	)

Definition at line 3018 of file stack2.c.

References check_list_prop().

{
  return check_list_prop("a scalar",lpos, posi, n != 1 || m != 1);
}

Here is the call graph for this function:

int check_list_vector	(	int	lpos,
		int	posi,
		int	m,
		int	n
	)

Definition at line 3003 of file stack2.c.

References check_list_prop().

{
  return check_list_prop("a vector",lpos,posi, m != 1 && n != 1);
}

Here is the call graph for this function:

int check_one_dim	(	int	posi,
		int	dim,
		int	val,
		int	valref
	)

Definition at line 2935 of file stack2.c.

References ArgPosition(), FALSE_, Get_Iname(), and TRUE_.

{
  if ( val != valref) 
    { 
      Scierror(999,"%s: %s has wrong %s dimension (%d), expecting (%d)\r\n",
               Get_Iname(),
               ArgPosition(posi),
               ( dim == 1 ) ? "first" : "second" ,
               val,valref);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

static int check_prop	(	char *	mes,
		int	posi,
		int	m
	)			[static]

Definition at line 2882 of file stack2.c.

References ArgPosition(), FALSE_, Get_Iname(), and TRUE_.

Referenced by check_col(), check_row(), check_scalar(), check_square(), and check_vector().

{
  if ( m ) 
    { 
      /* XXXX moduler 999 en fn des messages */
      Scierror(999,"%s: %s %s\r\n",
               Get_Iname(),
               ArgPosition(posi),
               mes);
      return FALSE_;
    }
  return TRUE_;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int Check_references

(

)

[static]

Definition at line 2418 of file stack2.c.

References C2F, ConvertData(), FALSE_, iadr, istk, lad, Lstk, ntypes, Rhs, size, Top, and TRUE_.

Referenced by putlhsvar().

{
        int ivar ; 
        for (ivar = 1; ivar <= Rhs ; ++ivar) 
                {
                        unsigned char Type = (unsigned char)C2F(intersci).ntypes[ivar - 1];
                        if ( Type != '$') 
                                {
                                        int lw = ivar + Top - Rhs;
                                        int il = iadr(*Lstk(lw));
                                        if ( *istk(il) < 0) 
                                                {
                                                        int m,n,it,size;
                                                        /* back conversion if necessary of a reference */ 
                                                        /* sciprint("%d: is a reference\r\n",ivar);  */
                                                        if ( *istk(il) < 0)  il = iadr(*istk(il +1));
                                                        m =*istk(il +1);
                                                        n =*istk(il +2);
                                                        it = *istk(il +3);
                                                        switch ( Type ) {
                                                                case 'i' : 
                                                                case 'r' : 
                                                                case 'd' :
                                                                        size  = m * n * (it + 1); break; 
                                                                case 'z' :
                                                                        size  = 0;break; /* size is unsued for 'z' in ConvertData;*/
                                                                case 'c' : 
                                                                        size =*istk(il + 4  +1) - *istk(il + 4 ); break;
                                                                case 'b' :
                                                                        size = m*n ; break;
                                                                default:
                                                                        return FALSE_; 
                                                        }
                                                        ConvertData(&Type,size,C2F(intersci).lad[ivar - 1]);
                                                        C2F(intersci).ntypes[ivar - 1] = '$';
                                                }
                                }
                        else 
                                {
                                        /* sciprint("%d: is of type $ \n",ivar);  */
                                }
                }
        return TRUE_; 
}

Here is the call graph for this function:

Here is the caller graph for this function:

int check_row	(	int	posi,
		int	m,
		int	n
	)

Definition at line 2906 of file stack2.c.

References check_prop().

{
  return check_prop("should be a row vector",posi, m != 1);
}

Here is the call graph for this function:

int check_same_dims	(	int	i,
		int	j,
		int	m1,
		int	n1,
		int	m2,
		int	n2
	)

Definition at line 2962 of file stack2.c.

References ArgsPosition(), FALSE_, Get_Iname(), and TRUE_.

{
  if ( m1 == m2 && n1 == n2 ) return TRUE_ ;
  Scierror(999,"%s: %s have incompatible dimensions (%dx%d) # (%dx%d)\r\n",
           Get_Iname(),
           ArgsPosition(i,j),
           m1,n1,m2,n2);
  return FALSE_;
}

Here is the call graph for this function:

int check_scalar	(	int	posi,
		int	m,
		int	n
	)

Definition at line 2916 of file stack2.c.

References check_prop().

{
  return check_prop("should be a scalar",posi, n != 1 || m != 1);
}

Here is the call graph for this function:

int check_square	(	int	posi,
		int	m,
		int	n
	)

Definition at line 2896 of file stack2.c.

References check_prop().

{
  return check_prop("should be square",posi, m != n);
}

Here is the call graph for this function:

int check_vector	(	int	posi,
		int	m,
		int	n
	)

Definition at line 2901 of file stack2.c.

References check_prop().

{
  return check_prop("should be a vector",posi, m != 1 && n != 1);
}

Here is the call graph for this function:

int C2F() checklhs	(	char *	fname,
		integer *	iMin,
		integer *	iMax,
		unsigned long	fname_len
	)

Definition at line 67 of file stack2.c.

References FALSE_, fname_len, get_fname(), and TRUE_.

{
  if ( Lhs < *iMin || Lhs > *iMax) 
    {
      Scierror(78,"%s: wrong number of lhs arguments\r\n",get_fname(fname,fname_len));
      return FALSE_;
    }
  return TRUE_;
} 

Here is the call graph for this function:

int C2F() convert2sci

(

integer *

ix

)

Definition at line 2749 of file stack2.c.

References C2F, FALSE_, ix, mvfromto(), Rhs, Top, and TRUE_.

Referenced by mklistfromvars(), mkmlistfromvars(), and mktlistfromvars().

{
  integer ix1 = Top - Rhs + *ix;
  if (! C2F(mvfromto)(&ix1, ix)) return FALSE_;
  C2F(intersci).ntypes[*ix - 1] = '$';
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

void ConvertData	(	char *	type,
		int	size,
		int	l
	)

Definition at line 2844 of file stack2.c.

References C2F, cstk, cvstr1(), F77ToSci(), iadr, int2db(), istk, sstk, stk, z2double(), and zstk.

Referenced by Check_references().

{
  int zero=0,mu=-1; int laddr; int prov,m,n,it;
  double wsave;
  switch (type[0]) {
  case 'c' :
    C2F(cvstr1)(&size,(int *) cstk(l),cstk(l),&zero,size);
    break;
  case 'r'  :
    C2F(rea2db)(&size,sstk(l),&mu,(double *)sstk(l),&mu);
    break;
  case 'i' :
    C2F(int2db)(&size,istk(l),&mu,(double *)istk(l),&mu);
    break;
  case 'z' :
    if (*istk( iadr(iadr(l))-2 ) == 133 ){  /* values @ even adress */
      prov=*istk( iadr(iadr(l))-1 );
      m=*istk(prov);n=*istk(prov+1);it=1;
      laddr=iadr(l);       wsave=*stk(laddr);   
      /* make header */
      *istk( iadr(iadr(l))-2 ) = 1;
      *istk( iadr(iadr(l))-1 ) = m;
      *istk( iadr(iadr(l)) ) = n;
      *istk( iadr(iadr(l))+1 ) = it;
      /* convert values */
      z2double(stk(laddr),stk(laddr+1),m*n, m*n);
      *stk(laddr+1)=wsave;
    } else
      {
        F77ToSci((double *) zstk(l), size, size);
      }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() copyvarfromsciptr	(	integer	lw,
		integer	n,
		integer	l
	)

Definition at line 3072 of file stack2.c.

References C2F, createdata(), FALSE_, l, Lstk, Rhs, stk, Top, TRUE_, and unsfdcopy().

{
  int ret,un=1;
  if ((ret=C2F(createdata)(&lw, n))==FALSE_) return ret;
  C2F(unsfdcopy)(&n,stk(l),&un,stk(*Lstk(lw + Top - Rhs)),&un);
  return TRUE_; 
}

Here is the call graph for this function:

int C2F() createcvar	(	integer *	lw,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lc,
		unsigned long	type_len
	)

Definition at line 522 of file stack2.c.

References C2F, cremat(), FALSE_, Get_Iname(), iadr, intersiz, Lstk, Max, Nbvars, nlgh, Rhs, Top, and TRUE_.

Referenced by __PARAMS(), and createptr().

{
  unsigned char Type = *typex ;
  integer lw1;
  char *fname = Get_Iname();
  if (*lw > intersiz) {
    Scierror(999,"%s: (createcvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createcvar! (1rst argument)\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type )  {
  case 'd' : 
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, lc, nlgh))  return FALSE_;
    C2F(intersci).ntypes[*lw - 1] = Type;
    C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
    C2F(intersci).lad[*lw - 1] = *lr;
    break;
  case 'r' : 
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, lc, nlgh))  return FALSE_;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    C2F(intersci).ntypes[*lw - 1] = Type;
    C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
    C2F(intersci).lad[*lw - 1] = *lr;
    break;
  case 'i' : 
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, lc, nlgh))  return FALSE_;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    C2F(intersci).ntypes[*lw - 1] = Type;
    C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
    C2F(intersci).lad[*lw - 1] = *lr;
    break;
  }
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() createcvarfrom	(	integer *	lw,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lc,
		integer *	lar,
		integer *	lac,
		unsigned long	type_len
	)

Definition at line 688 of file stack2.c.

References C2F, cremat(), cx1, dcopy(), FALSE_, Get_Iname(), iadr, int2db(), intersiz, istk, lcs, Lstk, Max, Nbvars, nlgh, Rhs, sstk, stk, Top, and TRUE_.

{
  unsigned char Type = *typex;
  int MN;
  integer lw1, lcs;
  char *fname =     Get_Iname();
  if (*lw > intersiz) {
    Scierror(999,"%s: (createcvarfrom) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  MN = (*m)*(*n);
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createcvarfrom! (1rst argument)\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type ) {
  case 'd' : 
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, lc, nlgh)) return FALSE_;
    if (*lar != -1) C2F(dcopy)(&MN, stk(*lar), &cx1,stk(*lr) , &cx1);
    if (*lac != -1 && *it == 1) C2F(dcopy)(&MN, stk(*lac), &cx1,stk(*lc) , &cx1);
    *lar = *lr;
    *lac = *lc;
    break;
  case 'r' :
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, lc, nlgh)) return FALSE_;
    if (*lar != -1) C2F(rea2db)(&MN, sstk(*lar), &cx1, stk(*lr), &cx1);
    if (*lac != -1 && *it==1) C2F(rea2db)(&MN, sstk(*lac), &cx1, stk(*lc), &cx1);
    *lar = *lr;
    *lac = *lc;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break ;
  case 'i' :
    if (! C2F(cremat)(fname, &lw1, it, m, n, lr, &lcs, nlgh)) return FALSE_;
    if (*lar != -1) C2F(int2db)(&MN, istk(*lar), &cx1, stk(*lr), & cx1);
    if (*lac != -1 && (*it==1)) C2F(int2db)(&MN, istk(*lac), &cx1, stk(*lc), &cx1);
    *lar = *lr;
    *lac = *lc;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break;
  }
  C2F(intersci).ntypes[*lw - 1] = '$';
  C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
  C2F(intersci).lad[*lw - 1] = *lr;
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createcvarfromptr	(	integer *	number,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		double *	iptr,
		double *	iptc,
		unsigned long	type_len
	)

Definition at line 1737 of file stack2.c.

References C2F, cdouble(), cint(), cremat(), FALSE_, Get_Iname(), intersiz, lcs, lrs, Max, Nbvars, nlgh, Rhs, stk, Top, and TRUE_.

{
  unsigned char Type = *typex;
  char *fname = Get_Iname();
  integer lw1, lcs, lrs, ix1;

  Nbvars = Max(Nbvars,*number);
  if (*number > intersiz) {
    Scierror(999,"%s: createcvarfromptr: too many arguments on the stack, enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  lw1 = *number + Top - Rhs;
  switch ( Type ) {
  case 'd' : 
    if (! C2F(cremat)(fname, &lw1, it, m, n, &lrs, &lcs, nlgh)) 
      return FALSE_;
    ix1 = *m * *n;
    C2F(cdouble)(&ix1, (double **) iptr, stk(lrs));
    if (*it == 1) {
      ix1 = *m * *n;
      C2F(cdouble)(&ix1,(double **) iptc, stk(lcs));
    }
    break;
  case 'i' :
    if (! C2F(cremat)(fname, &lw1, it, m, n, &lrs, &lcs, nlgh)) 
      return FALSE_;
    ix1 = *m * *n;
    C2F(cint)(&ix1, (int **) iptr, stk(lrs));
    if (*it == 1) {
      ix1 = *m * *n;
      C2F(cint)(&ix1,(int **) iptc, stk(lcs));
    }
    break;
  default :
    Scierror(999,"%s: createcvarfromptr was called with bad second argument!\r\n",fname);
    return FALSE_;
  }
  /*     this object will be copied with a vcopyobj in putlhsvar */
  C2F(intersci).ntypes[*number - 1] = '$';
  return  TRUE_;
} 

Here is the call graph for this function:

int C2F() createdata	(	integer *	lw,
		integer	n
	)

Definition at line 3042 of file stack2.c.

References C2F, credata(), FALSE_, Get_Iname(), intersiz, Lstk, Max, Nbvars, nlgh, Rhs, Top, and TRUE_.

Referenced by CopyVarFromlistentry(), and copyvarfromsciptr().

{
  integer lw1;
  char *fname = Get_Iname();
  if (*lw > intersiz) {
    Scierror(999,"%s: (createdata) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_ ;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createdata! (1rst argument)\r\n",
             fname);
    return FALSE_ ;
  }
  if (! C2F(credata)(fname, &lw1, n, nlgh))    return FALSE_;
  C2F(intersci).ntypes[*lw - 1] = '$';
  C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
  C2F(intersci).lad[*lw - 1] = *Lstk(lw1);
  return TRUE_; 
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() createlist	(	integer *	lw,
		integer *	nel
	)

Definition at line 571 of file stack2.c.

References C2F, crelist(), FALSE_, Get_Iname(), intersiz, Lstk, Max, Nbvars, nel, Rhs, Top, and TRUE_.

{
  char *fname = Get_Iname();
  integer lr, lw1;
  if (*lw > intersiz) {
    Scierror(999,"%s: (createlist) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createlist! (1rst argument)\r\n",fname);
    return FALSE_;
  }
  C2F(crelist)(&lw1, nel, &lr);
  C2F(intersci).ntypes[*lw - 1] = '$';
  C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
  C2F(intersci).lad[*lw - 1] = lr;
  return TRUE_;
} 

Here is the call graph for this function:

int C2F() createlistcvarfrom	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lc,
		integer *	lar,
		integer *	lac,
		unsigned long	type_len
	)

Definition at line 860 of file stack2.c.

References C2F, cx1, dcopy(), FALSE_, Get_Iname(), iadr, int2db(), intersiz, istk, lad, listcremat(), nlgh, Rhs, sstk, stk, Top, and TRUE_.

{
  integer ix1;
  int mn = (*m)*(*n);
  unsigned char Type = *typex;
  char *fname = Get_Iname();

  if (*lnumber > intersiz) {
    Scierror(999,"%s: (createlistcvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname) ;
    return FALSE_;
  }

  switch ( Type ) { 
  case 'd' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],it, m, n, lr, lc, nlgh)) 
      return FALSE_;
    if (*lar != -1) C2F(dcopy)(&mn,  stk(*lar), &cx1, stk(*lr), &cx1);
    if (*lac != -1 && *it==1) C2F(dcopy)(&mn, stk(*lac), &cx1,stk(*lc) , &cx1);
    *lar = *lr;
    *lac = *lc;
    break;
  case 'r' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          it, m, n, lr, lc, nlgh)) 
      return FALSE_;
    if (*lar != -1) C2F(rea2db)(&mn, sstk(*lar), &cx1, stk(*lr), &cx1);
    if (*lac != -1 && *it==1) C2F(rea2db)(&mn, sstk(*lac), &cx1, stk(*lc), & cx1);
    *lar = *lr;
    *lac = *lc;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break; 
  case 'i' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          it, m, n, lr, lc, nlgh)) 
      return FALSE_;
    if (*lar != -1) C2F(int2db)(&mn,istk(*lar), &cx1, stk(*lr), &cx1);
    if (*lac != -1 && *it==1) C2F(int2db)(&mn, istk(*lac), &cx1, stk(*lc), &cx1);
    *lar = *lr;
    *lac = *lc;
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break;
  default :
    Scierror(999,"%s:  createlistcvar called with bad third argument!\r\n",fname);
    return FALSE_;
  }
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createlistcvarfromptr	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		void *	iptr,
		void *	iptc,
		unsigned long	type_len
	)

Definition at line 1039 of file stack2.c.

References C2F, cdouble(), cfloat(), cint(), FALSE_, Get_Iname(), intersiz, lad, listcremat(), nlgh, Rhs, stk, Top, and TRUE_.

{
  unsigned Type = *typex;
  integer lr,lc, ix1;
  char *fname = Get_Iname();
  if (*lnumber > intersiz) {
    Scierror(999,"%s: (createlistvarfromptr) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type ) {
  case 'd' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1= (*m)*(*n);
    C2F(cdouble) (&ix1,(double **) iptr, stk(lr));
    if ( *it == 1) C2F(cdouble) (&ix1,(double **) iptc, stk(lc));
    break;
  case 'r' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1= (*m)*(*n);
    C2F(cfloat) (&ix1,(float **) iptr, stk(lr));
    if ( *it == 1)     C2F(cfloat) (&ix1,(float **) iptc, stk(lc));
    break;
  case 'i' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1 = *m * *n;
    C2F(cint)(&ix1,(int **) iptr, stk(lr));
    if ( *it == 1)     C2F(cint)(&ix1,(int **) iptc, stk(lc));
    break;
  default :
    Scierror(999,"%s: (createlistcvarfromptr) bad third argument!\r\n",fname);
    return FALSE_;
    break;
  }
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createlistvarfrom	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lar,
		unsigned long	type_len
	)

Definition at line 757 of file stack2.c.

References C2F, cadr, cstk, cvstr1(), cx0, cx1, dcopy(), FALSE_, Get_Iname(), iadr, icopy(), int2db(), intersiz, istk, lad, listcrebmat(), listcrehmat(), listcreimat(), listcremat(), listcrepointer(), listcrestring(), nlgh, Rhs, sstk, stk, Top, tpconv(), and TRUE_.

{
  unsigned Type = *typex;
  integer lc, ix1, it = 0, mn = (*m)*(*n),inc=1;
  char *fname = Get_Iname();
  if (*lnumber > intersiz) {
    Scierror(999,"%s: (createlistvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type ) {
  case 'c' :
    *n = 1;
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcrestring)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, lr, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1) C2F(cvstr1)(m, istk(*lr), cstk(*lar), &cx0,  *m * *n + 1);
    *lar = *lr;
    *lr = cadr( *lr);
    break;
  case 'd' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, lr, &lc, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1) C2F(dcopy)(&mn, stk(*lar), &cx1,stk(*lr) , &cx1);
    *lar = *lr;
    break;
  case 'r' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, lr, &lc, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1)     C2F(rea2db)(&mn, sstk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    *lr = iadr(*lr);
    break;
  case 'i' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, lr, &lc, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1)     C2F(int2db)(&mn, istk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    *lr = iadr(*lr);
    break;
  case 'b' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcrebmat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1]
                           , m, n, lr, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1) C2F(icopy)(&mn, istk(*lar), &cx1, istk(*lr), &cx1);
    *lar = *lr;
    break;
  case 'I' : 
    it = *lr ; /* it gives the type on entry */
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcreimat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, lr, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1) 
      C2F(tpconv)(&it,&it,&mn,istk(*lar), &inc,istk(*lr), &inc);
    *lar = *lr;
    break;
  case 'p' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcrepointer)(fname, &ix1, number, 
                              &C2F(intersci).lad[*lnumber - 1], lr, nlgh)) 
      {
        return FALSE_;
      }
    if (*lar != -1) *stk(*lr)= *stk(*lar);
    *lar = *lr;
    break;
  case 'h' :
    ix1 = *lnumber + Top - Rhs;
    if (! C2F(listcrehmat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                           m, n, lr, nlgh)) {
      return FALSE_;
    }
    if (*lar != -1) C2F(dcopy)(&mn, stk(*lar), &cx1,stk(*lr) , &cx1);
    *lar = *lr;
    break;
  default :
    Scierror(999,"%s: (createlistvar) bad third argument!\r\n",fname);
    return FALSE_;
    break;
  }
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createlistvarfromptr	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	m,
		integer *	n,
		void *	iptr,
		unsigned long	type_len
	)

Definition at line 933 of file stack2.c.

References C2F, cbool(), cdouble(), cfloat(), cint(), cre_listsmat_from_str(), cre_listsparse_from_ptr(), FALSE_, Get_Iname(), intersiz, iptr, istk, lad, listcrebmat(), listcreimat(), listcremat(), listcrepointer(), listcrestring(), nlgh, Rhs, stk, Top, tpconv(), and TRUE_.

{
  unsigned Type = *typex;
  integer lc, ix1, it = 0, lr,inc=1;
  char *fname = Get_Iname();
  if (*lnumber > intersiz) {
    Scierror(999,"%s: (createlistvarfromptr) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }

  ix1 = *lnumber + Top - Rhs;  /* factorization of this term (Bruno 9 march 2005, bugfix ) */
  switch ( Type ) {
  case 'c' :
    *n = 1;
    if (! C2F(listcrestring)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, &lr, nlgh)) {
      return FALSE_;
    }
    C2F(cchar)(m,(char **) iptr, istk(lr));
    break;
  case 'd' :
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1= (*m)*(*n);
    C2F(cdouble) (&ix1,(double **) iptr, stk(lr));
    break;
  case 'r' :
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1= (*m)*(*n);
    C2F(cfloat) (&ix1,(float **) iptr, stk(lr));
    break;
  case 'i' :
    if (! C2F(listcremat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, &lr, &lc, nlgh)) {
      return FALSE_;
    }
    ix1 = *m * *n;
    C2F(cint)(&ix1,(int **) iptr, stk(lr));
    break;
  case 'b' :
    if (! C2F(listcrebmat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1]
                           , m, n, &lr, nlgh)) {
      return FALSE_;
    }
    ix1 = *m * *n;
    C2F(cbool)(&ix1,(int **) iptr, istk(lr));
    break;
  case 'S' : 
    if ( !cre_listsmat_from_str(fname,&ix1, number, &C2F(intersci).lad[*lnumber - 1]
                                , m, n, (char **) iptr, nlgh)) /* XXX */
      return FALSE_;
    break;
  case 's' :
    if ( !cre_listsparse_from_ptr(fname,&ix1,number,
                              &C2F(intersci).lad[*lnumber - 1]
                              , m, n, (SciSparse *) iptr, nlgh))
      return FALSE_;
    break;
  case 'I' :
    it = ((SciIntMat *) iptr)->it;
    if (! C2F(listcreimat)(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1],
                          &it, m, n, &lr, nlgh)) {
      return FALSE_;
    }
    ix1= (*m)*(*n);
    C2F(tpconv)(&it,&it,&ix1,((SciIntMat *) iptr)->D, &inc,istk(lr), &inc);
    break;
  case 'p' :
    if (! C2F(listcrepointer)(fname, &ix1, number, 
                              &C2F(intersci).lad[*lnumber - 1],&lr,nlgh)) 
      {
        return FALSE_;
      }
    *stk(lr) = (double) ((unsigned long int) iptr);
    break;
  default :
    Scierror(999,"%s: (createlistvarfromptr) bad third argument!\r\n",fname);
    return FALSE_;
    break;
  }
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createreference	(	int	number,
		int	pointed
	)

Definition at line 3140 of file stack2.c.

References C2F, CreateData, GetRawData(), iadr, istk, Lstk, offset, pointed, Rhs, and Top.

{
  int offset; int point_ed; int *header;
  CreateData( number, 4*sizeof(int) );
  header =  GetRawData(number);
  offset = Top -Rhs;
  point_ed = offset + pointed;
  header[0]= - *istk( iadr(*Lstk( point_ed )) );  /* reference : 1st entry (type) is opposite */
  header[1]= *Lstk(point_ed);  /* pointed adress */
  header[2]= point_ed; /* pointed variable */
  header[3]= *Lstk(point_ed + 1)- *Lstk(point_ed);  /* size of pointed variable */
  C2F(intersci).ntypes[number-1]= '-';
  return 1;
}

Here is the call graph for this function:

int C2F() createreffromname	(	int	number,
		char *	name
	)

Definition at line 3171 of file stack2.c.

References C2F, CreateData, fin, GetData(), iadr, istk, Lstk, name, and objptr().

{
  int *header; int lw; int fin;
  CreateData(number, 4*sizeof(int));
  header = (int *) GetData(number);
  if (C2F(objptr)(name,&lw,&fin,strlen(name))) {
    header[0]= - *istk( iadr(*Lstk(fin))); /* type of reference = - type of pointed variable */
    header[1]= lw; /* pointed adress */
    header[2]= fin; /* pointed variable */
    header[3]= *Lstk(fin+1)- *Lstk(fin);  /*size of pointed variable */
    return 1;
  }
  else
    {  
      Scierror(999,"CreateRefFromName: variable %s not found\r\n",name);
      return 0;
    }
}

Here is the call graph for this function:

int C2F() createvar	(	integer *	lw,
		char *	typex,
		integer *	m,
		integer *	n,
		integer *	lr,
		unsigned long	type_len
	)

Definition at line 406 of file stack2.c.

References C2F, cadr, crebmat(), crehmat(), creimat(), crelist(), cremat(), cremlist(), crepointer(), cresmat2(), cretlist(), cstk, FALSE_, Get_Iname(), iadr, intersiz, it, ix, lcs, Lstk, Max, Nbvars, nlgh, Rhs, sadr, Top, and TRUE_.

Referenced by createstkptr(), createvarfromptr(), lasterror(), and mxCreateData().

{
  integer ix1, ix, it=0, lw1, lcs, IT;
  unsigned char Type = *typex;
  char *fname = Get_Iname();
  if (*lw > intersiz) {
    Scierror(999,"%s: (createvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_ ;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createvar! (1rst argument)\r\n",
             fname);
    return FALSE_ ;
  }
  switch (Type ) 
    {
    case 'c' : 
      ix1 = *m * *n;
      if (! C2F(cresmat2)(fname, &lw1, &ix1, lr, nlgh)) return FALSE_; 
      *lr = cadr(*lr);
      for (ix = 0; ix < (*m)*(*n) ; ++ix) *cstk(*lr+ix)= ' ';
      *cstk(*lr+ (*m)*(*n) )= '\0';
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'd' : 
      if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh))    return FALSE_;
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'z' : 
      IT = 1;
      if (!(*Lstk(lw1) % 2) ) *Lstk(lw1) = *Lstk(lw1)+1;
      if (! C2F(cremat)(fname, &lw1, &IT, m, n, lr, &lcs, nlgh))    return FALSE_;
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      *lr = sadr(*lr);
      break;
    case 'l' : 
      C2F(crelist)(&lw1, m, lr);
      C2F(intersci).ntypes[*lw - 1] = '$';
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 't' : 
      C2F(cretlist)(&lw1, m, lr);
      C2F(intersci).ntypes[*lw - 1] = '$';
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'm' : 
      C2F(cremlist)(&lw1, m, lr);
      C2F(intersci).ntypes[*lw - 1] = '$';
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'r' : 
      if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh)) return FALSE_;
      *lr = iadr(*lr);
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break ;
    case 'i' :
      if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh)) return FALSE_;
      *lr = iadr(*lr) ;
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break ;
    case 'b' :
      if (! C2F(crebmat)(fname, &lw1, m, n, lr, nlgh))  return FALSE_; 
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'p' : 
      if (! C2F(crepointer)(fname, &lw1, lr, nlgh))    return FALSE_;
      C2F(intersci).ntypes[*lw - 1] = '$';
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'I' : 
      it = *lr ; /* on entry lr gives the int type */ 
      if (! C2F(creimat)(fname, &lw1, &it, m, n, lr, nlgh))    return FALSE_;
      C2F(intersci).ntypes[*lw - 1] = '$';
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    case 'h' : 
      if (! C2F(crehmat)(fname, &lw1, m, n, lr, nlgh))    return FALSE_;
      C2F(intersci).ntypes[*lw - 1] = Type;
      C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
      C2F(intersci).lad[*lw - 1] = *lr;
      break;
    }
  return TRUE_; 
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() createvarfrom	(	integer *	lw,
		char *	typex,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lar,
		unsigned long	type_len
	)

Definition at line 602 of file stack2.c.

References C2F, cadr, crebmat(), crehmat(), creimat(), cremat(), crepointer(), cresmat2(), cstk, cvstr1(), cx0, cx1, dcopy(), FALSE_, Get_Iname(), iadr, icopy(), int2db(), intersiz, istk, lcs, Lstk, M, Max, N, Nbvars, nlgh, Rhs, sstk, stk, Top, tpconv(), and TRUE_.

{
  int M=*m,N=*n,MN=M*N;
  unsigned char Type = *typex;
  integer inc=1;
  integer it=0, lw1, lcs;
  char *fname = Get_Iname();
  if (*lw > intersiz) {
    Scierror(999,"%s: (createvarfrom) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  Nbvars = Max(*lw,Nbvars);
  lw1 = *lw + Top - Rhs;
  if (*lw < 0) {
    Scierror(999,"%s: bad call to createvarfrom! (1rst argument)\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type ) {
  case 'c' :
    if (! C2F(cresmat2)(fname, &lw1, &MN, lr, nlgh)) return FALSE_;
    if (*lar != -1)  C2F(cvstr1)(&MN, istk(*lr), cstk(*lar), &cx0,  MN + 1);
    *lar = *lr;
    *lr = cadr(*lr);
    M=MN; N= 1;
    break;
  case 'd' :
    if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh))  return FALSE_;
    if (*lar != -1)  C2F(dcopy)(&MN, stk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    break;
  case 'r' :
    if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh)) return FALSE_;
    if (*lar != -1)   C2F(rea2db)(&MN, sstk(*lar), &cx1, stk(*lr), & cx1);
    *lar = *lr;
    *lr = iadr(*lr);
    break;
  case 'i' :
    if (! C2F(cremat)(fname, &lw1, &it, m, n, lr, &lcs, nlgh)) return FALSE_;
    if (*lar != -1) C2F(int2db)(&MN,istk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    *lr = iadr(*lr);
    break;
  case 'b' :
    if (! C2F(crebmat)(fname, &lw1, m, n, lr, nlgh)) return FALSE_;
    if (*lar != -1) C2F(icopy)(&MN, istk(*lar), &cx1, istk(*lr), &cx1);
    *lar = *lr;
    break;
  case 'I' :
    it = *lr;
    if (! C2F(creimat)(fname, &lw1, &it, m, n, lr,  nlgh))  return FALSE_;
    if (*lar != -1) 
      C2F(tpconv)(&it,&it,&MN,istk(*lar), &inc,istk(*lr), &inc);
    *lar = *lr;
    break;
  case 'p' :
    MN=1;
    if (! C2F(crepointer)(fname, &lw1, lr, nlgh))    return FALSE_;
    if (*lar != -1)  C2F(dcopy)(&MN, stk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    break;
  case 'h' :
    if (! C2F(crehmat)(fname, &lw1, m, n, lr, nlgh))  return FALSE_;
    if (*lar != -1)  C2F(dcopy)(&MN, stk(*lar), &cx1, stk(*lr), &cx1);
    *lar = *lr;
    break;
  }
  C2F(intersci).ntypes[*lw - 1] = '$';
  C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
  C2F(intersci).lad[*lw - 1] = *lr;
  return TRUE_;
}

Here is the call graph for this function:

int C2F() createvarfromptr	(	integer *	number,
		char *	typex,
		integer *	m,
		integer *	n,
		void *	iptr,
		unsigned long	type_len
	)

Definition at line 1671 of file stack2.c.

References C2F, cre_smat_from_str(), cre_sparse_from_ptr(), createvar(), cstk, dcopy(), FALSE_, Get_Iname(), icopy(), istk, Lstk, Max, Nbvars, nlgh, Rhs, sstk, stk, Top, tpconv(), TRUE_, and type_len.

Referenced by lasterror(), and mxCreateString().

{
  static int un=1;
  unsigned char Type = *typex;
  int MN= (*m)*(*n),lr,it,lw1;
  char *fname = Get_Iname();
  lw1 = *number + Top - Rhs;
  switch ( Type ) 
    {
    case 'd' :
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      C2F(dcopy)(&MN,*((double **) iptr),&un, stk(lr),&un);
      break;
    case 'i' :
    case 'b' :
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      C2F(icopy)(&MN,*((int **) iptr), &un, istk(lr), &un);
      break;
    case 'r' :
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      C2F(rcopy)(&MN,*((float **)iptr), &un, sstk(lr), &un);
      break;
    case 'c' :
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      strcpy(cstk(lr),*((char **) iptr));
      break;
    case 'I' :
      /* on entry lr must gives the int type */
      it = lr = ((SciIntMat *) iptr)->it;
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      C2F(tpconv)(&it,&it,&MN,((SciIntMat *) iptr)->D, &un,istk(lr), &un);
      break;
    case 'p' :
      if ( C2F(createvar)(number, typex, m, n, &lr, type_len) == FALSE_ ) return FALSE_;
      *stk(lr) = (double) ((unsigned long int) iptr);
      break;
    case 'S' :
      /* special case: not taken into account in createvar */
      Nbvars = Max(*number,Nbvars);
      if ( !cre_smat_from_str(fname,&lw1, m, n, (char **) iptr, nlgh)) 
        return FALSE_;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
      C2F(intersci).ntypes[*number - 1] = '$';
      break;
    case 's' :
      /* special case: not taken into account in createvar */
      Nbvars = Max(*number,Nbvars);
      if ( !cre_sparse_from_ptr(fname,&lw1, m, n, (SciSparse *) iptr, nlgh))
        return FALSE_;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
      C2F(intersci).ntypes[*number - 1] = '$';
      break;
    default :
      Scierror(999,"%s: createvarfromptr was called with bad second argument!\r\n",fname);
      return FALSE_;
    }
  /*     this object will be copied with a vcopyobj in putlhsvar */
  return TRUE_; 
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() creatework	(	integer *	number,
		integer *	m,
		integer *	lr
	)

Definition at line 1094 of file stack2.c.

References Bot, C2F, cremat(), FALSE_, Get_Iname(), iadr, intersiz, lcs, Lstk, Max, Nbvars, nlgh, Rhs, sadr, Top, and TRUE_.

{
  int n,it=0,lw1,lcs,il;
  char *fname = Get_Iname();
  if (*number > intersiz) {
    Scierror(999,"%s: (creatework) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_ ;
  }
  Nbvars = Max(*number,Nbvars);
  lw1 = *number + Top - Rhs;
  if (lw1 < 0) {
    Scierror(999,"%s: bad call to creatework! (1rst argument)\r\n",
             fname);
    return FALSE_ ;
  }
  il = iadr(*Lstk(lw1));
  *m = *Lstk(Bot ) - sadr(il+4);
  n = 1;
  if (! C2F(cremat)(fname, &lw1, &it, m, &n, lr, &lcs, nlgh))    return FALSE_;
  return TRUE_; 
}

Here is the call graph for this function:

int C2F() elementtype	(	integer *	lnumber,
		integer *	number
	)

Definition at line 1447 of file stack2.c.

References FALSE_, Get_Iname(), iadr, ili, istk, ix, Lstk, Rhs, sadr, and Top.

{
  integer il,lw,itype,n,ix,ili;
  char *fname = Get_Iname();

  if (*lnumber > Rhs) {
    Scierror(999,"%s: bad call to elementtype! \r\n",fname);
    return FALSE_;
  }

  lw = *lnumber + Top - Rhs; /*index of the variable numbered *lnumber in the stack */
  il = iadr(*Lstk(lw)); 
  if (*istk(il) < 0) il = iadr(*istk(il + 1));
  itype = *istk(il ); /* type of the variable numbered *lnumber */
  if (itype < 15 || itype > 17) { /* check if it is really a list */
    Scierror(210,"%s: Argument %d: wrong type argument, expecting a list\r\n",fname,*lnumber);
    return FALSE_;
  }
  n = *istk(il + 1);/* number of elements in the list */
  itype = 0; /*default answer if *number is not a valid element index */
  if (*number<=n && *number>0) {
    ix = sadr(il + 3 + n); /* adress of the first list element */
    if (*istk(il + 1+ *number) < *istk(il + *number + 2)) { /* the required element is defined */
      ili = iadr(ix + *istk(il + 1+ *number) - 1); /* adress of the required element */
      itype = *istk(ili);
    }
  }
  return itype;
}

Here is the call graph for this function:

int C2F() errorinfo	(	char *	fname,
		integer *	info,
		unsigned long	fname_len
	)

Definition at line 2373 of file stack2.c.

References fname_len, and get_fname().

Referenced by C2F(), intdsyev(), and intzgeesx().

{
  Scierror(998,"%s: internal error, info=%d\r\n",get_fname(fname,fname_len),*info);
  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() findopt	(	char *	str,
		rhs_opts	opts[]
	)

Definition at line 133 of file stack2.c.

References i, pos, and rhs_opt_find().

{
  int i, pos;

  pos = 0;
  i = rhs_opt_find(str,opts);
  if ( i>=0 ) 
    if (opts[i].position>0) 
      pos = opts[i].position;
  
  return(pos);
}

Here is the call graph for this function:

integer C2F() firstopt

(

)

Definition at line 115 of file stack2.c.

References Infstk, Rhs, and Top.

{
  integer k;
  for (k = 1; k <= Rhs ; ++k) 
    if (*Infstk(k + Top - Rhs )==1)
      return k;
  return(Rhs+1);
}

static char* Get_Iname

(

)

[static]

Definition at line 2792 of file stack2.c.

References C2F, cvname(), cx1, i, nlgh, and nsiz.

Referenced by check_dim_prop(), check_dims(), check_length(), check_list_one_dim(), check_list_prop(), check_one_dim(), check_prop(), check_same_dims(), createcvar(), createcvarfrom(), createcvarfromptr(), createdata(), createlist(), createlistcvarfrom(), createlistcvarfromptr(), createlistvarfrom(), createlistvarfromptr(), createvar(), createvarfrom(), createvarfromptr(), creatework(), elementtype(), getlistrhscvar(), getlistrhsvar(), getmatdims(), getrhscvar(), getrhsvar(), and setworksize().

{
  int i;
  C2F(cvname)(&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], Fname, &cx1, nlgh);
  for (i=0 ; i < nlgh ; i++) if (Fname[i]==' ') { Fname[i]='\0'; break;} 
  Fname[nlgh]='\0'; 
  return Fname;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int get_optionals	(	char *	fname,
		rhs_opts	opts[]
	)

Definition at line 274 of file stack2.c.

References Error, GetRhsVar, i, isopt(), IsOpt, rhs_opts__::l, rhs_opts__::m, rhs_opts__::n, name, nlgh, NULL, NumOpt, rhs_opts__::position, Rhs, rhs_opt_find(), rhs_opt_print_names(), sciprint(), and rhs_opts__::type.

Referenced by intex2c(), sci_champ_G(), sci_drawaxis(), sci_fec(), sci_grayplot(), sci_matplot(), sci_param3d(), sci_param3d1(), sci_plot2d(), sci_plot2d1_G(), sci_plot3d(), sci_xsetech(), and sci_xtitle().

{
  int k,i=0;
  char name[nlgh+1];
  int nopt = NumOpt(); /* optional arguments on the stack */

  /* reset first field since opts is declared static in calling function */
  /* this could be avoided with ansi compilers by removing static in the 
   * opts declaration */

  while ( opts[i].name != NULL )
    {
      opts[i].position = -1;
      i++;
    }

  /* Walking through last arguments */

  for ( k = Rhs - nopt + 1; k <= Rhs ;k++)
    {
      if ( IsOpt(k,name) == 0  ) 
        {
          Scierror(999,"%s: optional arguments name=val must be at the end\r\n",fname);
          return 0;
        }
      else 
        {
          int isopt = rhs_opt_find(name,opts);
          if ( isopt >= 0 ) 
            {
              rhs_opts *ro = &opts[isopt];
              ro->position = k;
              if (ro->type[0] != '?')
                GetRhsVar(ro->position, ro->type,&ro->m,&ro->n,&ro->l);
            }
          else 
            {
              sciprint("%s: unrecognized optional arguments %s\r\n",fname,name);
              rhs_opt_print_names(opts) ;
              Error(999); 
              return(0);
            }
        }
    }
  return 1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* GetData

(

int

lw

)

Definition at line 3080 of file stack2.c.

References C2F, Lstk, Rhs, stk, and Top.

Referenced by __PARAMS(), C2F(), createreffromname(), empty(), int_objfprintfMat(), intcpass2(), intdiffobjs(), intgetscicosvarsc(), intscicosimc(), intspvm_bcast(), intspvm_f772sci(), intspvm_sci2f77(), intspvm_send(), mexGetVariable(), mxCreateLogicalMatrix(), mxGetCell(), mxGetField(), mxGetFieldByNumber(), sciReturnUserData(), and set_user_data_property().

             : header = (int *) GetData(lw); header[0] = type of variable lw etc */
{
  int lw1 = lw + Top - Rhs ;
  int l1 = *Lstk(lw1);
  int *loci = (int *) stk(l1);
  if (loci[0] < 0) 
    {
      l1 = loci[1];
      loci = (int *) stk(l1);
    }
  C2F(intersci).ntypes[lw - 1] = '$';
  C2F(intersci).iwhere[lw - 1] = l1;
  C2F(intersci).lad[lw - 1] = l1;
  return loci;
}

Here is the caller graph for this function:

void* GetDataFromName

(

char *

name

)

Definition at line 3125 of file stack2.c.

References C2F, fin, iadr, istk, Lstk, and objptr().

Referenced by Java_javasci_SciBooleanArray_getColFromScilab(), Java_javasci_SciBooleanArray_getRowFromScilab(), Java_javasci_SciComplexArray_getColFromScilab(), Java_javasci_SciComplexArray_getRowFromScilab(), Java_javasci_SciDoubleArray_getColFromScilab(), Java_javasci_SciDoubleArray_getRowFromScilab(), Java_javasci_Scilab_receiveDataByName(), Java_javasci_Scilab_TypeVar(), Java_javasci_SciStringArray_getColFromScilab(), and Java_javasci_SciStringArray_getRowFromScilab().

             :  header = (int *) GetDataFromName("pipo"); header[0] = type of variable pipo etc... */
{
  void *header; int lw; int fin;
 if (C2F(objptr)(name,&lw,&fin,strlen(name))) {
    header = istk( iadr(*Lstk(fin)));  
    return (void *) header;
  }
 else
    {  
      Scierror(999,"GetDataFromName: variable %s not found\r\n",name);
      return (void *) 0;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int GetDataSize

(

int

lw

)

Definition at line 3097 of file stack2.c.

References Lstk, Rhs, stk, and Top.

Referenced by set_user_data_property().

{
  int lw1 = lw + Top - Rhs ;
  int l1 = *Lstk(lw1);
  int *loci = (int *) stk(l1);
  int n =  *Lstk(lw1+1)-*Lstk(lw1);
  if (loci[0] < 0) 
    {
      l1 = loci[1];
      loci = (int *) stk(l1);
      n=loci[3];
    }
  return n;
}

Here is the caller graph for this function:

int C2F() getlistrhscvar	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lc,
		unsigned long	type_len
	)

Definition at line 1619 of file stack2.c.

References C2F, FALSE_, Get_Iname(), iadr, intersiz, istk, Max, Nbvars, nlgh, Rhs, sstk, stk, Top, and TRUE_.

{
  integer ix1, topk= Top, lw;
  char *fname = Get_Iname();
  unsigned  char    Type = * typex;

  Nbvars = Max(Nbvars,*lnumber);
  lw = *lnumber + Top - Rhs;
  if (*lnumber > Rhs) {
    Scierror(999,"%s: bad call to getlistrhscvar! (1rst argument)\r\n",fname);
    return FALSE_;
  }
  if (*lnumber > intersiz) {
    Scierror(999,"%s: (getlistrhscvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  switch ( Type ) {
  case 'd' :
    if (! C2F(getlistmat)(fname, &topk, &lw, number, it, m, n, lr, lc, nlgh)) return FALSE_;
    break;
  case 'r' :
    if (! C2F(getlistmat)(fname, &topk, &lw, number, it, m, n, lr, lc, nlgh)) 
      return FALSE_;
    ix1 = *m * *n * (*it + 1);
    C2F(simple)(&ix1, stk(*lr), sstk(iadr(*lr)));
    *lr  = iadr(*lr);
    *lc = *lr + *m * *n;
    break;
  case 'i' :
    if (! C2F(getlistmat)(fname, &topk, &lw, number, it, m, n, lr, lc, nlgh)) 
      return FALSE_;
    ix1 = *m * *n * (*it + 1);
    C2F(entier)(&ix1, stk(*lr), istk(iadr(*lr)));
    *lr = iadr(*lr) ;
    *lc = *lr + *m * *n;
    break;
  default :
    Scierror(999,"%s: getlistrhscvar was called with  bad third argument!\r\n",fname);
    return FALSE_;
  }
  /* can't perform back data conversion with lists */
  C2F(intersci).ntypes[*number - 1] = '$';
  return TRUE_;
}

Here is the call graph for this function:

int C2F() getlistrhsvar	(	integer *	lnumber,
		integer *	number,
		char *	typex,
		integer *	m,
		integer *	n,
		integer *	lr,
		unsigned long	type_len
	)

Definition at line 1490 of file stack2.c.

References C2F, cadr, cstk, cx1, sciintmat::D, double2z(), FALSE_, Get_Iname(), getlistbmat(), getlistimat(), getlistpointer(), getlistsimat(), getlistsparse(), getlistwsmat(), scisparse::I, iadr, scisparse::icol, icol, ierr, il1, in2str(), intersiz, istk, sciintmat::it, scisparse::it, sciintmat::l, lr1, sciintmat::m, scisparse::m, m1, Max, scisparse::mnel, mnel, sciintmat::n, scisparse::n, n1, Nbvars, scisparse::nel, nlgh, scisparse::R, Rhs, sadr, ScilabMStr2CM(), SciToF77(), sstk, stk, Top, and TRUE_.

Referenced by getrhssys().

{
  int lr1;
  char **items;
  int il1,ild1,nn,ierr=0;
  char *fname = Get_Iname();
  integer m1, n1, lc, it, lw, topk = Top, ix1,ix2;
  unsigned char Type = *typex;   
  integer mnel,icol;
  SciSparse *Sp;
  SciIntMat *Im;

  Nbvars = Max(Nbvars,*lnumber);
  lw = *lnumber + Top - Rhs;
  if (*lnumber > Rhs) {
    Scierror(999,"%s: bad call to getlistrhsvar! (1rst argument)\r\n",fname);
    return FALSE_;
  }
  if (*lnumber > intersiz) {
    Scierror(999,"%s: (getlistrhsvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }

  switch ( Type ) { 
  case 'c' : 
    *n = 1;
    if (! C2F(getlistsimat)(fname, &topk, &lw, number, &m1, &n1, &cx1, &cx1,lr, m, nlgh)) 
      return FALSE_;
    ix2 = *m * *n;
    C2F(in2str)(&ix2, istk(*lr), cstk(cadr(*lr)), ix2 + 1);
    *lr = cadr(*lr);
    break;
  case 'd' : 
    if (! C2F(getlistmat)(fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
      return FALSE_;
    break;
  case 'r' :
    if (! C2F(getlistmat)(fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
      return FALSE_;
    ix1 = *m * *n;
    C2F(simple)(&ix1, stk(*lr), sstk(iadr(*lr)));
    *lr = iadr(*lr);
    break;
  case 'i' :
    if (! C2F(getlistmat)(fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
      return FALSE_;
    ix1 = *m * *n;
    C2F(entier)(&ix1, stk(*lr), istk(iadr(*lr)));
    *lr = iadr(*lr);
    break;
  case 'b' :
    if (! C2F(getlistbmat)(fname, &topk, &lw, number, m, n, lr, nlgh)) 
      return FALSE_;
    *lr = *lr;
    break;
  case 'z' :
    if (! C2F(getlistmat)(fname, &topk, &lw,number, &it, m, n, lr, &lc, nlgh)) return FALSE_;
    ix2 = *m * *n;
    if ((it != 1) && (ix2 !=0)){
      Scierror(999,"%s: argument %d >(%d) should be a complex matrix\r\n",
               fname, Rhs + (lw -topk) , *number);
      return FALSE_;
    };
      if (!(*lr % 2) ) {  /* bad adress (lr is even) shift up the stack */
        double2z(stk(*lr), stk(*lr)-1, ix2, ix2);
        ix2=2*ix2;
        *istk(iadr(*lr)-4)=133;
        *istk(iadr(*lr)-3)=iadr(*lr + ix2);
        *istk( iadr(*lr + ix2) )= *m;
        *istk( iadr(*lr + ix2) +1 )= *n;
        *lr = sadr(*lr-1); 
      } else
        {
      SciToF77(stk(*lr), ix2, ix2);
      *lr = sadr(*lr);
        }
    break;
  case 'S' :
    if (! C2F(getlistwsmat)(fname,&topk,&lw,number,m,n,&il1,&ild1, nlgh)) return FALSE_;
    nn= (*m)*(*n);
    ScilabMStr2CM(istk(il1),&nn,istk(ild1),&items,&ierr);
    if ( ierr == 1) return FALSE_;
    Type = '$';
    /*
     * Warning : lr must have the proper size when calling getrhsvar 
     * char **Str1; .... GetRhsVar(...., &lr) 
     */
    *((char ***) lr) = items ;
    break;
  case 's' :
    /* sparse matrices */ 
    Sp = (SciSparse *) lr ;
    if (! C2F(getlistsparse)(fname,&topk,&lw,number,&it,m,n,&(Sp->nel),&mnel,&icol,&lr1,&lc,nlgh))
      return FALSE_;
    Sp->m = *m ; Sp->n = *n ; Sp->it = it; 
    Sp->mnel = istk(mnel);
    Sp->icol = istk(icol);
    Sp->R = stk(lr1);
    Sp->I = stk(lc);
    Type = '$';
    break;
  case 'I' :
    /* int matrices */ 
    Im = (SciIntMat *) lr ;
    if (! C2F(getlistimat)(fname,&topk,&lw,number,&it,m,n,&lr1,nlgh))
      return FALSE_;
    Im->m = *m ; Im->n = *n ; Im->it = it; Im->l = lr1;
    Im->D = istk(lr1);
    Type = '$';
    break;
  case 'p' :
    if (! C2F(getlistpointer)(fname, &topk, &lw, number, lr,  nlgh))
      return FALSE_;
    break;
  default :
    Scierror(999,"%s: getlistrhsvar was called with bad third argument (%c)\r\n",fname,Type);
    return FALSE_;
  }
  /* can't perform back data conversion with lists */
  C2F(intersci).ntypes[*number - 1] = '$';
  return TRUE_ ; 
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() getmatdims	(	integer *	number,
		integer *	m,
		integer *	n
	)

Definition at line 1156 of file stack2.c.

References FALSE_, Get_Iname(), iadr, istk, Lstk, Rhs, Top, TRUE_, and typ.

{
  char *fname = Get_Iname();
  integer il,lw,typ;

  lw = *number + Top - Rhs;
  if ( *number > Rhs) {
    Scierror(999,"%s: bad call to getmatdims! (1rst argument)\r\n",fname);
    return FALSE_;
  }

  il = iadr(*Lstk(lw));
  if (*istk(il ) < 0) il = iadr(*istk(il +1));
  typ = *istk(il );
  if (typ > 10) {
    Scierror(201,"%s: argument %d should be a matrix\r\n", fname,*number);
    return  FALSE_;    
  }
  *m = *istk(il + 1);
  *n = *istk(il + 2);
  return TRUE_;
}

Here is the call graph for this function:

integer C2F() getopcode	(	char *	string,
		unsigned long	string_len
	)

Definition at line 2060 of file stack2.c.

References op, and string_len.

Referenced by scistring().

{
  unsigned char ch = string[0];
  integer op = 0;
  if (  string_len >= 2) {
    /*     .op  or op. */
    if ( ch  == '.') ch = string[1];
    op += 51;
  }
  switch ( ch ) 
    {
    case  '*'  :  op += 47; break;
    case  '+'  :  op += 45; break;
    case  '-'  :  op += 46; break;
    case  '\'' :  op += 53; break;
    case  '/'  :  op += 48; break;
    case  '\\' :  op += 49; break;
    case  '^'  :  op += 62; break;
    }
  return op;
}

Here is the caller graph for this function:

void* GetRawData

(

int

lw

)

Definition at line 3113 of file stack2.c.

References C2F, Lstk, Rhs, stk, and Top.

Referenced by changetoref(), createreference(), mexGetArray(), mexGetVariablePtr(), and mxDuplicateArray().

{
  int lw1 = lw + Top - Rhs ;
  int l1 = *Lstk(lw1);
  int *loci = (int *) stk(l1);
  C2F(intersci).ntypes[lw - 1] = '$';
  C2F(intersci).iwhere[lw - 1] = l1;
  /*  C2F(intersci).lad[lw - 1] = l1;  to be checked */
  return loci;
}

Here is the caller graph for this function:

int C2F() getrhscvar	(	integer *	number,
		char *	typex,
		integer *	it,
		integer *	m,
		integer *	n,
		integer *	lr,
		integer *	lc,
		unsigned long	type_len
	)

Definition at line 1398 of file stack2.c.

References C2F, FALSE_, Get_Iname(), getmat(), iadr, intersiz, istk, Lstk, Max, Nbvars, nlgh, Rhs, sstk, stk, Top, and TRUE_.

{
  integer ix1, lw, topk;
  unsigned char Type = *typex;
  char *fname = Get_Iname();
  
  Nbvars = Max(Nbvars,*number);
  lw = *number + Top - Rhs;
  if (*number > Rhs) {
    Scierror(999,"%s: bad call to getrhscvar! (1rst argument)\r\n", fname);
    return FALSE_;
  }
  if (*number > intersiz) {
    Scierror(999,"%s: (getrhscvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }
  topk = Top;
  switch ( Type ) {
  case 'd' :
    if (! C2F(getmat)(fname, &topk, &lw, it, m, n, lr, lc, nlgh)) return FALSE_;
    break;
  case 'r' :
    if (! C2F(getmat)(fname, &topk, &lw, it, m, n, lr, lc, nlgh)) return FALSE_;
    ix1 = *m * *n * (*it + 1);
    C2F(simple)(&ix1, stk(*lr), sstk(iadr(*lr)));
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break;
  case 'i' :
    if (! C2F(getmat)(fname, &topk, &lw, it, m, n, lr, lc, nlgh)) return FALSE_;
    ix1 = *m * *n * (*it + 1);
    C2F(entier)(&ix1, stk(*lr), istk(iadr(*lr)));
    *lr = iadr(*lr);
    *lc = *lr + *m * *n;
    break;
  }
  C2F(intersci).ntypes[*number - 1] = Type;
  C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
  C2F(intersci).lad[*number - 1] = *lr;
  return TRUE_;
}

Here is the call graph for this function:

int C2F() getrhssys	(	integer *	lw,
		integer *	n,
		integer *	m,
		integer *	p,
		integer *	ptra,
		integer *	ptrb,
		integer *	ptrc,
		integer *	ptrd,
		integer *	ptrx0,
		double *	hx
	)

Definition at line 2287 of file stack2.c.

References C2F, cx2, cx4, FALSE_, getlistrhsvar(), getrhsvar(), iadr, istk, ix, L, ma, mb, md, na, nb, nc, nd, sadr, stk, and TRUE_.

{
  integer cx2 = 2, cx3 = 3, cx4 = 4, cx5 = 5, cx6 = 6;
  integer ix1, junk, msys, nsys, ix, icord;
  integer ma, na, mb, nb, mc, nc, il, md, nd;
  integer mx0, nx0, ptrsys, itimedomain;
  static integer iwork[23] = { 10,1,7,0,1,4,5,6,7,8,10,12,21,28,28,-10,-11,
                               -12,-13,-33,0,13,29 };
  if (! C2F(getrhsvar)(lw, "t", &msys, &nsys, &ptrsys, 1L)) return FALSE_;
  il = iadr(ptrsys) - msys - 1;
  /*     syslin tlist=[ chain, (A,B,C,D,X0) ,chain or scalar ]
   *                     10     1 1 1 1 1      10       1    
   */
  junk = il + msys + iadr(*istk(il));
  if ( *istk(junk) != 10) return FALSE_;
  if ( *istk(il + msys + iadr(*istk(il + 1))) != 1) return FALSE_;
  if ( *istk(il + msys + iadr(*istk(il + 2))) != 1) return FALSE_;
  if ( *istk(il + msys + iadr(*istk(il + 3))) != 1) return FALSE_;
  if ( *istk(il + msys + iadr(*istk(il + 4))) != 1) return FALSE_;
  if ( *istk(il + msys + iadr(*istk(il + 5))) != 1) return FALSE_;
  itimedomain = *istk(il + msys + iadr(*istk(il + 6)));
  switch ( itimedomain ) {
  case 10 :
    /* Sys(7)='c' or 'd' */
    icord = *istk(il + msys + iadr(*istk(il + 6))+ 6);
    switch ( icord ) 
      {
      case 12 :  *hx = 0.; break;
      case 13 :  *hx = 1.; break;
      default : 
        Scierror(999,"invalid time domain\r\n");
        return FALSE_;
      }
    break;
  case 1 : 
    /*     Sys(7)=h */
    ix1 = il + msys + iadr(*istk(il + 6)) + 4;
    *hx = *stk(sadr(ix1));
    break;
  default : 
    Scierror(999,"invalid time domain\r\n");
    return FALSE_;
  }
  for (ix = 0; ix < 23; ++ix) 
    {
      if (iwork[ix] != *istk(junk + ix)) {
        Scierror(999,"invalid system\r\n");
        return FALSE_;
      }
    }
  if (! C2F(getlistrhsvar)(lw, &cx2, "d", &ma, &na, ptra, 1L)) return FALSE_;
  if (! C2F(getlistrhsvar)(lw, &cx3, "d", &mb, &nb, ptrb, 1L)) return FALSE_;
  if (! C2F(getlistrhsvar)(lw, &cx4, "d", &mc, &nc, ptrc, 1L)) return FALSE_;
  if (! C2F(getlistrhsvar)(lw, &cx5, "d", &md, &nd, ptrd, 1L)) return FALSE_;
  if (! C2F(getlistrhsvar)(lw, &cx6, "d", &mx0, &nx0, ptrx0, 1L))  return FALSE_;
  if (ma != na) {
    Scierror(999,"A matrix non square!\r\n");
    return FALSE_;
  }
  if (ma != mb && mb != 0) {
    Scierror(999,"Invalid A,B matrices\r\n");
    return FALSE_;
  }
  if (ma != nc && nc != 0) {
    Scierror(999,"Invalid A,C matrices\r\n");
    return FALSE_;
  }
  if (mc != md && md != 0) {
    Scierror(999,"Invalid C,D matrices\r\n");
    return FALSE_;
  }
  if (nb != nd && nd != 0) {
    Scierror(999,"Invalid B;D matrices\r\n");
    return FALSE_;
  }
  *n = ma;
  *m = nb;
  *p = mc;
  return TRUE_;
}

Here is the call graph for this function:

int C2F() getrhsvar	(	integer *	number,
		char *	typex,
		integer *	m,
		integer *	n,
		integer *	lr,
		unsigned long	type_len
	)

Definition at line 1195 of file stack2.c.

References C2F, cadr, cstk, cx1, sciintmat::D, double2z(), FALSE_, Get_Iname(), getbmat(), getexternal(), gethmat(), getilist(), getimat(), getmat(), getpointer(), getsmat(), getsparse(), getwsmat(), scisparse::I, iadr, scisparse::icol, icol, ierr, il1, in2str(), intersiz, istk, sciintmat::it, scisparse::it, sciintmat::l, lr1, Lstk, sciintmat::m, scisparse::m, m1, Max, scisparse::mnel, mnel, sciintmat::n, scisparse::n, n1, Nbvars, scisparse::nel, nlgh, nsiz, NULL, overloadtype(), scisparse::R, Rhs, sadr, ScilabMStr2CM(), SciToF77(), setfeval(), sstk, stk, Top, and TRUE_.

Referenced by getrhssys(), GetScalarDouble(), and GetScalarInt().

{
  int ierr=0,il1,ild1,nn;
  int lrr;
  char *fname = Get_Iname();
  char **items, namex[nlgh+1];
  unsigned char Type = *(unsigned char *) typex;
  integer topk,ltype, m1, n1, lc,lr1, it=0, lw, ile, ils, ix1,ix2;
  integer mnel,icol;
  SciSparse *Sp;
  SciIntMat *Im;
  /* we accept a call to getrhsvar after a createvarfromptr call */
  if ( *number > Rhs && *number > Nbvars ) {
    Scierror(999,"%s: bad call to getrhsvar! (1rst argument)\r\n",fname);
    return FALSE_;
  }

  Nbvars = Max(Nbvars,*number);
  lw = *number + Top - Rhs;

  if (*number > intersiz) {
    Scierror(999,"%s: (getrhsvar) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_;
  }

  if (  C2F(overloadtype)(&lw,fname,&Type) == 0) return FALSE_;
  
  topk = Top;
  switch ( Type ) 
    {
    case 'c' : 
      *n = 1;
      if (! C2F(getsmat)(fname,&topk,&lw,&m1,&n1,&cx1,&cx1,lr,m, nlgh))
        return FALSE_;
      ix2 = *m * *n;
      /* in case where ix2 is 0 in2str adds the \0 char after the end of
         the storage of the variable, so it writes over the next variable 
         tp avoid this pb we shift up by one the location where the 
         data is written*/
      lrr=*lr;
      if (ix2==0) lrr--;

      C2F(in2str)(&ix2, istk(*lr), cstk(cadr(*lr)), ix2 + 1);
      *lr = cadr(*lr);
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;

    case 'd' :
      if (! C2F(getmat)(fname, &topk, &lw, &it, m, n, lr, &lc, nlgh)) return FALSE_;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break ;
    case 'z' :
      if (! C2F(getmat)(fname, &topk, &lw, &it, m, n, lr, &lc, nlgh)) return FALSE_;
      ix2 = *m * *n;
      if ((it != 1) && (ix2 !=0)) {
        Scierror(999," Waiting for a complex argument (z)"); return FALSE_;
      };
      if (!(*lr % 2) ) {  /* bad adress (lr is even) shift up the stack */
        double2z(stk(*lr), stk(*lr)-1, ix2, ix2);
        *istk(iadr(*lr)-4)=133;
        *istk(iadr(*lr)-3)=iadr(*lr + 2*ix2-1);
        *istk( iadr(*lr + 2*ix2-1) )= *m;
        *istk( iadr(*lr + 2*ix2-1) +1 )= *n;
        C2F(intersci).ntypes[*number - 1] = Type ;
        C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
        C2F(intersci).lad[*number - 1] = *lr-1;
        *lr = sadr(*lr-1);
      }
      else {
        SciToF77(stk(*lr), ix2, ix2);
        C2F(intersci).ntypes[*number - 1] = Type ;
        C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
        C2F(intersci).lad[*number - 1] = *lr;
        *lr = sadr(*lr);
      };
      break ;
    case 'r' :
      if (! C2F(getmat)(fname, &topk, &lw, &it, m, n, lr, &lc, nlgh))  return FALSE_;
      ix1 = *m * *n;
      C2F(simple)(&ix1, stk(*lr), sstk(iadr(*lr)));
      *lr = iadr(*lr);
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'i' :
      if (! C2F(getmat)(fname, &topk, &lw, &it, m, n, lr, &lc, nlgh)) return FALSE_;
      ix1 = *m * *n;
      C2F(entier)(&ix1, stk(*lr), istk(iadr(*lr)));
      *lr = iadr(*lr) ;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'b' : 
      if (! C2F(getbmat)(fname, &topk, &lw, m, n, lr, nlgh))  return FALSE_;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'l' :    case 't' :    case 'm' :
      *n = 1;
      if (! C2F(getilist)(fname, &topk, &lw, m, n, lr, nlgh))  return FALSE_;
      /* No data conversion for list members ichar(type)='$' */
      Type = '$' ;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'S' :
      if (! C2F(getwsmat)(fname,&topk,&lw,m,n,&il1,&ild1, nlgh)) return FALSE_;
      nn= (*m)*(*n);
      ScilabMStr2CM(istk(il1),&nn,istk(ild1),&items,&ierr);
      if ( ierr == 1) return FALSE_;
      Type = '$';
      /*
       * Warning : lr must have the proper size when calling getrhsvar 
       * char **Str1; .... GetRhsVar(...., &lr) 
       */
      *((char ***) lr) = items ;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 's' :
      /* sparse matrices */ 
      Sp = (SciSparse *) lr ;
      if (! C2F(getsparse)(fname,&topk,&lw,&it,m,n,&(Sp->nel),&mnel,&icol,&lr1,&lc,nlgh))
        return FALSE_;
      Sp->m = *m ; Sp->n = *n ; Sp->it = it; 
      Sp->mnel = istk(mnel);
      Sp->icol = istk(icol);
      Sp->R = stk(lr1);
      Sp->I = (it==1) ? stk(lc): NULL;
      Type = '$';
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'I' :
      /* int matrices */ 
      Im = (SciIntMat *) lr ;
      if (! C2F(getimat)(fname,&topk,&lw,&it,m,n,&lr1,nlgh))
        return FALSE_;
      Im->m = *m ; Im->n = *n ; Im->it = it; Im->l = lr1;
      Im->D = istk(lr1);
      Type = '$';
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'f' :
      /* XXXXXX : gros bug ici car getexternal a besoin de savoir 
         pour quelle fonction on recupere un external 
         or ici on presuppose que c'est setfeval 
         de plus on ne sait pas exactement de quel type d'external il s'agit
      */
         
      /*      int function getrhsvar(number,type,m,n,lr) */
      *lr = *Lstk(lw);
      ils = iadr(*lr) + 1;
      *m = *istk(ils);
      ile = ils + *m * nsiz + 1;
      *n = *istk(ile);
      if (! C2F(getexternal)(fname, &topk, &lw, namex, &ltype, C2F(setfeval), nlgh, 
                             nlgh)) {
        return FALSE_;
      }
      Type = '$';
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'p' : 
      if (! C2F(getpointer)(fname, &topk, &lw,lr, nlgh)) return FALSE_;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break;
    case 'h' :
      if (! C2F(gethmat)(fname, &topk, &lw, m, n, lr, nlgh)) return FALSE_;
      C2F(intersci).ntypes[*number - 1] = Type ;
      C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
      C2F(intersci).lad[*number - 1] = *lr;
      break ;
    }
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

integer C2F() gettype

(

integer *

lw

)

Definition at line 178 of file stack2.c.

References iadr, istk, and Lstk.

{
  integer il;
  il = iadr(*Lstk(*lw ));
  if (*istk(il ) < 0) il = iadr(*istk(il +1));
  return *istk(il);
}

int C2F() in2str	(	integer *	n,
		integer *	line,
		char *	str,
		unsigned long	str_len
	)

Definition at line 2778 of file stack2.c.

References C2F, codetoascii(), and str_len.

Referenced by getlistrhsvar(), getrhsvar(), mxgetstring(), and mxGetString().

{
  C2F(codetoascii)(n,line, str, str_len);
  str[*n] = '\0';
  return 0;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

static void intersci_pop

(

void

)

[static]

Definition at line 3232 of file stack2.c.

References C2F, FREE, i, inter_s_::iwhere, iwhere, L_intersci, inter_s_::lad, lad, inter_s_::lhsvar, lhsvar, inter_l::nbvars, Nbvars, inter_l::next, inter_s_::ntypes, ntypes, NULL, and inter_l::state.

Referenced by scibuiltin(), and scifunction().

{
  int i;
  intersci_list *loc = L_intersci;
  if ( loc == NULL ) return ;
  Nbvars =  loc->nbvars;
  for ( i = 0 ; i <  Nbvars ; i++ ) 
    {
      C2F(intersci).iwhere[i] =   loc->state[i].iwhere ;
      C2F(intersci).ntypes[i] =   loc->state[i].ntypes ;
      C2F(intersci).lad[i] =   loc->state[i].lad    ;
      C2F(intersci).lhsvar[i] =   loc->state[i].lhsvar ;
    }
  L_intersci = loc->next ;
  FREE(loc->state);
  FREE(loc);
}

Here is the caller graph for this function:

static int intersci_push

(

void

)

[static]

Definition at line 3209 of file stack2.c.

References C2F, i, iwhere, inter_s_::iwhere, L_intersci, inter_s_::lad, inter_s_::lhsvar, MALLOC, inter_l::nbvars, Nbvars, inter_l::next, inter_s_::ntypes, NULL, and inter_l::state.

Referenced by scibuiltin(), and scifunction().

{
  int i;
  intersci_list *loc;
  intersci_state *new ;
  new = MALLOC( Nbvars * sizeof(intersci_state) );
  if (new == 0 ) return 0;
  loc = MALLOC( sizeof(intersci_list) );
  if ( loc == NULL ) return 0;
  loc->next = L_intersci;
  loc->state = new; 
  loc->nbvars =  Nbvars;
  for ( i = 0 ; i <  Nbvars ; i++ ) 
    {
      loc->state[i].iwhere = C2F(intersci).iwhere[i];
      loc->state[i].ntypes = C2F(intersci).ntypes[i];
      loc->state[i].lad    = C2F(intersci).lad[i];
      loc->state[i].lhsvar = C2F(intersci).lhsvar[i];
    }
  L_intersci = loc;
  return 1;
}

Here is the caller graph for this function:

int C2F() isopt	(	integer *	k,
		char *	namex,
		unsigned long	name_len
	)

Definition at line 85 of file stack2.c.

References C2F, FALSE_, i1, isoptlw(), name_len, nlgh, Rhs, Top, and TRUE_.

Referenced by get_optionals().

{
  integer i1 =  *k + Top - Rhs;
  if ( C2F(isoptlw)(&Top, &i1, namex, name_len) == FALSE_) return FALSE_ ;
  /* add a '\0' at the end of the string removing trailing blanks */
  for ( i1 = nlgh-1 ; i1 >=0 ; i1--) { if ( namex[i1] != ' ') break ;} 
  namex[i1+1]='\0';
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() isoptlw	(	integer *	topk,
		integer *	lw,
		char *	namex,
		unsigned long	name_len
	)

Definition at line 102 of file stack2.c.

References C2F, cvname(), cx1, FALSE_, Infstk, name_len, nsiz, and TRUE_.

Referenced by isopt().

{
  if (*Infstk(*lw ) != 1) return FALSE_ ;
  C2F(cvname)(&C2F(vstk).idstk[(*lw) * nsiz - nsiz], namex, &cx1, name_len);
  return TRUE_;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() isref

(

integer *

number

)

Definition at line 376 of file stack2.c.

References FALSE_, iadr, istk, Lstk, number, Rhs, Top, and TRUE_.

Referenced by IsRef().

{
  integer il,lw;
  lw = *number + Top - Rhs;
  if ( *number > Rhs) {
    Scierror(999,"isref: bad call to isref! (1rst argument)\r\n");
    return FALSE_;
  }
  il = iadr(*Lstk(lw));
  if ( *istk(il) < 0) 
    return TRUE_ ; 
  else 
    return FALSE_ ; 
}

Here is the caller graph for this function:

int IsRef

(

int

number

)

Definition at line 372 of file stack2.c.

References C2F, and isref().

Referenced by intspvm_f772sci(), intspvm_recv(), and intspvm_sci2f77().

                      { 
  return C2F(isref)(&number);
}

Here is the call graph for this function:

Here is the caller graph for this function:

integer C2F() maxvol	(	integer *	lw,
		char *	lw_type,
		unsigned long	type_len
	)

Definition at line 2394 of file stack2.c.

References Bot, cadr, iadr, Lstk, Rhs, sadr, and Top.

Referenced by intdsyev().

{
  unsigned char Type =  *(unsigned char *)lw_type ;
  /* I like this one a lot: a kind of free jazz pattern  */
  integer m = *Lstk(Bot) - sadr(iadr(*Lstk(*lw + Top - Rhs)) +4);
  switch ( Type ) 
    {
    case 'd' : return m; break;
    case 'i' : return iadr(m);break;
    case 'r' : return iadr(m);break;
    case 'c' : return cadr(m);break;
    case 'z' : return sadr(m)-3;break;
    }
  /* should never get there */
  return m; 
}

Here is the caller graph for this function:

int C2F() mklistfromvars	(	integer *	pos,
		integer *	n
	)

Definition at line 1786 of file stack2.c.

References C2F, convert2sci(), mklist(), Rhs, Top, and TRUE_.

{
  integer tops =  Top;
  int k;
  for ( k= *pos; k < *pos+*n; k++) C2F(convert2sci)(&k);
  Top = Top - Rhs + *pos - 1 + *n;
  C2F(mklist)(n);
  Top = tops;
  C2F(intersci).ntypes[*pos - 1] = '$';
  return  TRUE_;
} 

Here is the call graph for this function:

int C2F() mkmlistfromvars	(	integer *	pos,
		integer *	n
	)

Definition at line 1819 of file stack2.c.

References C2F, convert2sci(), Rhs, Top, TRUE_, and type.

Referenced by __PARAMS().

{
  integer type=17;
  integer tops =  Top;
  int k;
  for ( k= *pos; k < *pos+*n; k++) C2F(convert2sci)(&k);
  Top = Top - Rhs + *pos - 1 + *n;
  C2F(mklistt)(n,&type);
  Top = tops;
  C2F(intersci).ntypes[*pos - 1] = '$';
  return  TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() mktlistfromvars	(	integer *	pos,
		integer *	n
	)

Definition at line 1802 of file stack2.c.

References C2F, convert2sci(), Rhs, Top, TRUE_, and type.

{
  integer type=16;
  integer tops =  Top;
  int k;
  for ( k= *pos; k < *pos+*n; k++) C2F(convert2sci)(&k);
  Top = Top - Rhs + *pos - 1 + *n;
  C2F(mklistt)(n,&type);
  Top = tops;
  C2F(intersci).ntypes[*pos - 1] = '$';
  return  TRUE_;
} 

Here is the call graph for this function:

static int C2F() mvfromto	(	integer *	itopl,
		integer *	ix
	)			[static]

Definition at line 2571 of file stack2.c.

References abs, C2F, cadr, crebmat(), crehmat(), cremat(), cresmat2(), cx1, dcopy(), FALSE_, iadr, icopy(), ilp, istk, ix, L, l, lad, lcs, lrs, Lstk, pointed, Rhs, size, stk, Top, TRUE_, unsfdcopy(), vcopyobj(), and z2double().

Referenced by convert2sci(), and putlhsvar().

{
  integer ix1=0;
  integer m=0;
  integer n=0;
  integer it=0;
  integer lcs=0;
  integer lrs=0;
  integer l=0;
  integer size=0;
  integer pointed=0;
  unsigned long int ilp=0;
  unsigned char Type;
  double wsave;

  Type = (unsigned char)C2F(intersci).ntypes[*ix - 1];
  if ( Type != '$') 
    {
      /* int iwh = *ix + Top - Rhs;
         ilp = iadr(*Lstk(iwh)); */ 
      int iwh = C2F(intersci).iwhere[*ix - 1];
      ilp = iadr(iwh); 
      if ( *istk(ilp) < 0)  ilp = iadr(*istk(ilp +1));
      m =*istk(ilp +1);
      n =*istk(ilp +2);
      it = *istk(ilp +3);
    }

  switch ( Type ) {
  case 'i' : 
    if (! C2F(cremat)("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L)) {
      return FALSE_;
    }
    ix1 = m * n * (it + 1);
    C2F(stacki2d)(&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
    C2F(intersci).lad[*ix - 1] = iadr(lrs);
    break ;
  case 'r' :
    if (! C2F(cremat)("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L)) {
      return FALSE_;
    }
    ix1 = m * n * (it + 1);
    C2F(stackr2d)(&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
    C2F(intersci).lad[*ix - 1] = iadr(lrs);
    break;
  case 'd' :
    if (! C2F(cremat)("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L)) {
      return FALSE_;
    }
    /* no copy if the two objects are the same 
     * the cremat above is kept to deal with possible size changes 
     */
    if (C2F(intersci).lad[*ix - 1] != lrs) {
      ix1 = m * n * (it + 1);
      l=C2F(intersci).lad[*ix - 1];
      if (abs(l-lrs)<ix1)
        C2F(unsfdcopy)(&ix1, stk(l), &cx1, stk(lrs), &cx1);
      else
        C2F(dcopy)(&ix1, stk(l), &cx1, stk(lrs), &cx1);
      C2F(intersci).lad[*ix - 1] = lrs;
    }
    break;
  case 'z' :
    if ( *istk(ilp) == 133 ) {
      wsave=*stk(C2F(intersci).lad[*ix - 1]); 
      n=*istk(m+1);
          m=*istk(m);
          it=1;
      if (! C2F(cremat)("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L)) {
      return FALSE_;  }
      z2double(stk(C2F(intersci).lad[*ix - 1]),stk(lrs),m*n, m*n);
      *stk(lrs)=wsave;
      C2F(intersci).lad[*ix - 1] = lrs;
      }
    else { 
      if (! C2F(cremat)("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L)) {
        return FALSE_;
      }
    z2double(stk(C2F(intersci).lad[*ix - 1]), stk(lrs), m*n, m*n);
    C2F(intersci).lad[*ix - 1] = lrs;
    }
    break;
  case 'c' : 
    m = *istk(ilp + 4  +1) - *istk(ilp + 4 );
    n = 1;
    ix1 = m * n;
    if (! C2F(cresmat2)("mvfromto", itopl, &ix1, &lrs, 8L)) {
      return FALSE_;
    }
    C2F(stackc2i)(&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
    C2F(intersci).lad[*ix - 1] = cadr(lrs);
    break;
  
  case 'b' :
    if (! C2F(crebmat)("mvfromto", itopl, &m, &n, &lrs, 8L)) {
      return FALSE_;
    }
    ix1 = m * n;
    C2F(icopy)(&ix1, istk(C2F(intersci).lad[*ix - 1]), &cx1,istk(lrs), &cx1);
    C2F(intersci).lad[*ix - 1] = lrs;
    break;
  case '-' :
    /*    reference  '-' = ascii(45) */
    ilp = iadr(*Lstk(*ix));
    size = *istk(ilp+3);
    pointed = *istk(ilp+2);
    if (! C2F(cremat)("mvfromto", itopl, (it=0 ,&it), (m=1, &m), &size, &lrs, &lcs, 8L)) {
      return FALSE_;
    }
    if ( C2F(vcopyobj)("mvfromto", &pointed, itopl, 8L) == FALSE_) 
          return FALSE_;
    break;
  case 'h' :
    if (! C2F(crehmat)("mvfromto", itopl, &m, &n, &lrs, 8L)) {
      return FALSE_;
    }
    /* no copy if the two objects are the same 
     * the cremat above is kept to deal with possible size changes 
     */
    if (C2F(intersci).lad[*ix - 1] != lrs) {
      ix1 = m * n;
      l=C2F(intersci).lad[*ix - 1];
      if (abs(l-lrs)<ix1)
        C2F(unsfdcopy)(&ix1, stk(l), &cx1, stk(lrs), &cx1);
      else
        C2F(dcopy)(&ix1, stk(l), &cx1, stk(lrs), &cx1);
      C2F(intersci).lad[*ix - 1] = lrs;
    }
    break;
  case 'p' :   case '$' :
    /*     special case */
    if (Top - Rhs + *ix != *itopl) 
      {
        ix1 = Top - Rhs + *ix;
        if ( C2F(vcopyobj)("mvfromto", &ix1, itopl, 8L) == FALSE_) 
          return FALSE_;
      }
  }
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

integer C2F() numopt

(

void

)

Definition at line 154 of file stack2.c.

References Infstk, Rhs, and Top.

{
  integer k, ret=0;
  for (k = 1; k <= Rhs ; ++k) 
    if ( *Infstk(k + Top - Rhs) == 1 ) ret++;
  return ret;
} 

integer C2F() ogettype

(

integer *

lw

)

Definition at line 260 of file stack2.c.

References iadr, istk, and Lstk.

{
  return  *istk(iadr(*Lstk(*lw )) );
}

integer C2F() overload	(	integer *	lw,
		char *	fname,
		unsigned long	l
	)

Definition at line 248 of file stack2.c.

References C2F, and l.

Referenced by overloadtype(), sci_copy(), sci_delete(), sci_draw(), sci_get(), and sci_set().

{
  C2F(putfunnam)(fname,lw,l);
  C2F(com).fun=-1;
  return 0;
}

Here is the caller graph for this function:

integer C2F() overloadtype	(	integer *	lw,
		char *	fname,
		char *	typ
	)

Definition at line 193 of file stack2.c.

References C2F, iadr, istk, Lstk, overload(), and typ.

Referenced by getrhsvar().

{
  integer il=0;
  integer ityp=0;
  il = iadr(*Lstk(*lw ));
  if (*istk(il ) < 0) il = iadr(*istk(il +1));
  switch (*typ) {
  case 'c' : /* string */
  case 'S' : /* string Matrix */
    ityp=10;
    break;
  case 'd' :  case 'i' :  case 'r' :  case 'z' :   /* numeric */
    ityp=1;
    break ;
  case 'b' : /* boolean */
    ityp=4;
    break;
  case 'h' : /* handle */
    ityp=9;
    break;
  case 'l' : /* list */
    ityp=15;
    break;
  case 't' : /* tlist */
    ityp=16;
    break;
  case 'm' : /* mlist */
    ityp=17;
    break;
  case 'f' : /* external */
    ityp=13;
    break;
  case 'p' : /* pointer */
    ityp=128;
    break;
  case 's' : /* sparse */
    ityp= 5;
    break;
  case 'I' : /* int matrix */
    ityp=8;
    break;

  }
  if (*istk(il ) != ityp) {
    return C2F(overload)(lw,fname,strlen(fname));
  }
  return 1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() putlhsvar

(

)

Definition at line 2475 of file stack2.c.

References Bot, C2F, Check_references(), err, err1, FALSE_, fun, iadr, intersiz, istk, ix, L, Lhs, LhsVar, Lstk, Max, mvfromto(), Nbvars, objvide(), Rhs, Top, and TRUE_.

Referenced by __PARAMS(), C2F(), endmex(), getversion_no_rhs(), getversion_two_rhs(), gw_cscicos(), gw_graphics(), gw_linear_algebra(), gw_special_functions2(), InterfaceWindowsClipboard(), intopenxls(), intreadxls(), lasterror(), NoRhs(), OneLhs(), OneRhs_gettext(), ReturnValueSetenv(), sci_clc(), sci_gateway(), sci_raise_window(), sci_tohome(), sci_xsnative(), TwoLhs(), and TwoRhs_gettext().

{
  integer ix2, ivar, ibufprec, ix, k, lcres, nbvars1;
  integer plhsk;
  Check_references();
  
  for (k = 1; k <= Lhs; k++)
    {
      plhsk=*Lstk(LhsVar(k)+Top-Rhs);
      if (*istk( iadr(plhsk) ) < 0) {
        if (*Lstk(Bot) > *Lstk(*istk(iadr (plhsk) +2)) )
        LhsVar(k)=*istk(iadr(plhsk)+2);
        /* lcres = 0 */
      }
    }

  if (C2F(iop).err > 0||C2F(errgst).err1> 0)  return TRUE_ ; 
  if (C2F(com).fun== -1 ) return TRUE_ ; /* execution continue with an 
                                            overloaded function */
  if (LhsVar(1) == 0) 
    {
      Top = Top - Rhs + Lhs;
      C2F(objvide)(" ", &Top, 1L);
      Nbvars = 0;
      return TRUE_;
    }
  nbvars1 = 0;
  for (k = 1; k <= Lhs ; ++k) nbvars1 = Max( nbvars1 , LhsVar(k));
  /* check if output variabe are in increasing order in the stack */
  lcres = TRUE_;
  ibufprec = 0;
  for (ix = 1; ix <= Lhs ; ++ix) {
    if (LhsVar(ix) < ibufprec) {
      lcres = FALSE_;
      break;
    } else {
      ibufprec = LhsVar(ix );
    }
  }
  if (! lcres) {
    /* First pass if output variables are not 
     * in increasing order 
     */
    for (ivar = 1; ivar <= Lhs; ++ivar) {
      ix2 = Top - Rhs + nbvars1 + ivar;
      if (! C2F(mvfromto)(&ix2, &LhsVar(ivar))) {
        return FALSE_;
      }
      LhsVar(ivar) = nbvars1 + ivar;
      /* I change type of variable nbvars1 + ivar 
       * in order to just perform a dcopy at next pass 
       */
      if (nbvars1 + ivar > intersiz) {
        Scierror(999,"putlhsvar: intersiz is too small\r\n");
        return FALSE_;
      }
      C2F(intersci).ntypes[nbvars1 + ivar - 1] = '$';
    }
  }
  /*  Second pass */
  for (ivar = 1; ivar <= Lhs ; ++ivar) 
    {
      ix2 = Top - Rhs + ivar;
      if (! C2F(mvfromto)(&ix2, &LhsVar(ivar))) {
        return FALSE_;
      }
    }
  Top = Top - Rhs + Lhs;
  LhsVar(1) = 0;
  Nbvars = 0;
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int Ref2val	(	int	from,
		int	to
	)

Definition at line 2722 of file stack2.c.

References C2F, copyobj(), FALSE_, iadr, istk, Lstk, lwd, Rhs, and Top.

{
  integer il,lw;
  lw = from + Top - Rhs;
  if ( from  > Rhs) {
    Scierror(999,"copyref: bad call to isref! (1rst argument)\r\n");
    return FALSE_;
  }
  il = iadr(*Lstk(lw));
  if ( *istk(il) < 0) 
    {
      int lwd ; 
      /* from contains a reference */ 
      lw= *istk(il+2); 
      lwd = to + Top -Rhs;
      C2F(copyobj)("copyref", &lw, &lwd, strlen("copyref"));
    }
  return 0;
}

Here is the call graph for this function:

int rhs_opt_find	(	char *	name,
		rhs_opts	opts[]
	)

Definition at line 323 of file stack2.c.

References i, NULL, and rep.

Referenced by findopt(), and get_optionals().

{
  int rep=-1,i=0;
  while ( opts[i].name != NULL ) 
    {
      int cmp;
      /* name is terminated by white space and we want to ignore them */
      if ( (cmp=strcmp(name,opts[i].name)) == 0 )
        {
          rep = i ; break;
        }
      else if ( cmp < 0 )
        {
          break;
        }
      else 
        {
          i++;
        }
    }
  return rep;
}

Here is the caller graph for this function:

void rhs_opt_print_names

(

rhs_opts

opts[]

)

Definition at line 346 of file stack2.c.

References i, name, NULL, and sciprint().

Referenced by get_optionals().

{
  int i=0;
  if ( opts[i].name == NULL )
    {
      sciprint("optional argument list is empty\r\n");
      return;
    }
  sciprint("optional arguments list: ");
  while ( opts[i+1].name != NULL ) 
    {
      sciprint("%s, ",opts[i].name);
      i++;
    }
  sciprint("and %s.\r\n",opts[i].name);
  return ;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() scibuiltin	(	integer *	number,
		integer *	ifun,
		integer *	ifin,
		integer *	mlhs,
		integer *	mrhs
	)

Definition at line 2090 of file stack2.c.

References allowptr(), Bot, C2F, callinterf(), cx0, cx1, cx4, Err, error, FALSE_, fin, fun, funs(), iadr, icall, intersci_pop(), intersci_push(), ir, iset(), istk, ix, krec, Lhs, Lstk, nsiz, parse(), pt, ref2val(), Rhs, rstk, Top, and TRUE_.

Referenced by sciops(), and scistring().

{
  integer krec, srhs, slhs, iflagint;
  integer ix, k, intop, il, ir, lw, pt0;
  intop = Top;
  
  if ( intersci_push() == 0 ) 
    {
      Scierror(999,"scifunction: Running out of memory \r\n");
      goto L9999;
    }

  Top = Top - Rhs + *number + *mrhs - 1;
  slhs = Lhs;
  srhs = Rhs;
  Lhs = *mlhs;
  Rhs = *mrhs;
  krec = -1;
  pt0 = C2F(recu).pt;
  goto L90;
  /* ***************************** */
  /*<  60   call  parse >*/
 L60:
  C2F(parse)();
  if (C2F(com).fun == 99) {
    C2F(com).fun = 0;
    goto L200;
  }
  if (Err > 0) {
    goto L9999;
  }
  if (C2F(recu).rstk[C2F(recu).pt - 1] / 100 == 9) {
    ir = C2F(recu).rstk[C2F(recu).pt - 1] - 900;
    if (ir == 1) {
      /*     .     back to matsys */
      k = 13;
    } else if (ir >= 2 && ir <= 9) {
      /*     .     back to matio */
      k = 5;
    } else if (ir == 10) {
      /*     .     end of overloaded function */
      goto L96;
    } else if (ir > 40) {
      /*     .     back to matus2 */
      k = 24;
    } else if (ir > 20) {
      /*     .     back to matusr */
      k = 14;
    } else {
      goto L89;
    }
    iflagint = 0;
    goto L95;
  }
 L89:
  if (Top < Rhs) {
    Scierror(22,"scibuiltin: recursion problems. Sorry....\r\n");
    goto L9999;
  }
  if (Top - Rhs + Lhs + 1 >= Bot) {
    Scierror(18,"scibuiltin: too many names\r\n");
    goto L9999;
  }
  goto L91;
 L90:
  if (Err > 0) {
    goto L9999;
  }
  if (Top - Lhs + 1 > 0) {
    C2F(iset)(&Rhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
  }
 L91:
  k = C2F(com).fun;
  C2F(com).fun = 0;
  if (k == krec) {
    Scierror(22,"scibuiltin: recursion problems. Sorry....\r\n");
    goto L9999;
  }
  if (k == 0) {
    if (C2F(recu).pt > pt0) {
      goto L60;
    }
    goto L200;
  }
  if (k == 2) {
    il = iadr(*Lstk(Top + 1 - Rhs));
    iflagint = *istk(il + 3);
  }
  if (! C2F(allowptr)(&k)) {
    C2F(ref2val)();
  }
 L95:
  C2F(callinterf)(&k, &iflagint);
  if (C2F(recu).icall != 0) {
    goto L60;
  }
  if (C2F(com).fun >= 0) {
    goto L90;
  }
  /*    called interface ask for a sci function to perform the function (fun=-1)*/
  /*     the function name is given in ids(1,pt+1) */
  C2F(ref2val)();
  C2F(com).fun = 0;
  C2F(funs)(&C2F(recu).ids[(C2F(recu).pt + 1)* nsiz - nsiz]);
  if (Err > 0) {
    goto L9999;
  }
  if (C2F(com).fun > 0) {
    goto L91;
  }
  if (C2F(com).fin == 0) {
    integer cx4 = 4;
    C2F(error)(&cx4);
    if (Err > 0) {
      goto L9999;
    }
  }
  ++C2F(recu).pt;
  C2F(com).fin = *Lstk(C2F(com).fin);
  C2F(recu).rstk[C2F(recu).pt - 1] = 910;
  C2F(recu).icall = 5;
  C2F(com).fun = 0;
  /*     *call*  macro */
  goto L60;
 L96:
  --C2F(recu).pt;
  goto L90;
  /* ************************** */
 L200:
  Lhs = slhs;
  Rhs = srhs;
  Top = intop;
  intersci_pop();
  for (ix = 0 ; ix < *mlhs ; ++ix) {
    lw = Top - Rhs + *number + ix ;
    C2F(intersci).ntypes[lw - 1] = '$';
  }
  return TRUE_;
 L9999:
  intersci_pop();
  return FALSE_;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() scifunction	(	integer *	number,
		integer *	ptr,
		integer *	mlhs,
		integer *	mrhs
	)

Definition at line 1853 of file stack2.c.

References allowptr(), Bot, C2F, callinterf(), cx0, cx1, cx4, Err, error, FALSE_, fin, fun, funs(), iadr, intersci_pop(), intersci_push(), ir, iset(), istk, ix, krec, Lhs, Lstk, mrhs, nsiz, parse(), psiz, pt, ref2val(), Rhs, rstk, Top, and TRUE_.

Referenced by scistring().

{
  integer cx26 = 26;
  integer ix1, krec, iflagint, ix, k, intop, il, ir, lw;
  
  if ( intersci_push() == 0 ) 
    {
      Scierror(999,"scifunction: Running out of memory \r\n");
      goto L9999;
    }

  /*     macro execution */
  intop = Top;
  Top = Top - Rhs + *number + *mrhs - 1;
  ++C2F(recu).pt;
  if (C2F(recu).pt > psiz) {
    C2F(error)(&cx26);
    goto L9999;
  }
  C2F(recu).ids[C2F(recu).pt * nsiz - nsiz] = Lhs;
  C2F(recu).ids[C2F(recu).pt * nsiz - (nsiz-1)] = Rhs;
  C2F(recu).rstk[C2F(recu).pt - 1] = 1001;
  Lhs = *mlhs;
  Rhs = *mrhs;
  ++C2F(recu).niv;
  C2F(com).fun = 0;
  C2F(com).fin = *ptr;
  C2F(recu).icall = 5;
  krec = -1;

 L60:
  C2F(parse)();
  if (C2F(com).fun == 99) {
    C2F(com).fun = 0;
    goto L200;
  }
  if (Err > 0)  goto L9999;
  if (C2F(recu).rstk[C2F(recu).pt - 1] / 100 == 9) {
    ir = C2F(recu).rstk[C2F(recu).pt - 1] - 900;
    if (ir == 1) {
      /*     .     back to matsys */
      k = 13;
    } else if (ir >= 2 && ir <= 9) {
      /*     .     back to matio */
      k = 5;
      /*<          elseif(ir.eq.10) then >*/
    } else if (ir == 10) {
      /*     .     end of overloaded function */
      goto L96;
      /*<          elseif(ir.gt.40) then >*/
    } else if (ir > 40) {
      /*     .     back to matus2 */
      k = 24;
    } else if (ir > 20) {
      /*     .     back to matusr */
      k = 14;
    } else {
      goto L89;
    }
    iflagint = 0;
    goto L95;
  }

 L89:
  if (Top < Rhs) {
    Scierror(22,"scifunction: recursion problems. Sorry....\r\n");
    goto L9999;
  }
  if (Top - Rhs + Lhs + 1 >= Bot) {
    Scierror(18,"scifunction: too many names\r\n");
    goto L9999;
  }
  goto L91;
 L90:
  if (Err > 0) {
    goto L9999;
  }
  if (Top - Lhs + 1 > 0) {
    C2F(iset)(&Lhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
  }
 L91:
  k = C2F(com).fun;
  C2F(com).fun = 0;
  if (k == krec) {
    Scierror(22,"scifunction: recursion problems. Sorry....\r\n");
    goto L9999;
  }
  if (k == 0) {
    goto L60;
  }
  if (k == 2) {
    il = iadr( *Lstk(Top + 1 - Rhs));
    iflagint = *istk(il + 3);
  }
 L95:
  if (! C2F(allowptr)(&k)) {
    C2F(ref2val)();
  }
  C2F(callinterf)(&k, &iflagint);
  if (C2F(com).fun >= 0) {
    goto L90;
  }
  /*    called interface ask for a scilab function to perform the function (fun=-1)
   *     the function name is given in ids(1,pt+1) 
   */
  C2F(ref2val)();
  C2F(com).fun = 0;
  C2F(funs)(&C2F(recu).ids[(C2F(recu).pt + 1)* nsiz - nsiz]);
  if (Err > 0) {
    goto L9999;
  }
  if (C2F(com).fun > 0) {
    goto L91;
  }
  if (C2F(com).fin == 0) {
    integer cx4 = 4;
    C2F(error)(&cx4);
    if (Err > 0) {
      goto L9999;
    }
    goto L90;
  }
  ++C2F(recu).pt;
  C2F(com).fin = *Lstk(C2F(com).fin);
  C2F(recu).rstk[C2F(recu).pt - 1] = 910;
  C2F(recu).icall = 5;
  C2F(com).fun = 0;
  /*     *call*  macro */
  goto L60;
 L96:
  --C2F(recu).pt;
  goto L90;
 L200:
  Lhs = C2F(recu).ids[C2F(recu).pt * nsiz -nsiz ];
  Rhs = C2F(recu).ids[C2F(recu).pt * nsiz -(nsiz-1)];
  --C2F(recu).pt;
  --C2F(recu).niv;
  /* + */
  Top = intop;
  ix1 = *mlhs;
  intersci_pop();
  for (ix = 1; ix <= ix1; ++ix) {
    lw = Top - Rhs + *number + ix - 1;
    C2F(intersci).ntypes[lw - 1] = '$';
  }
  return TRUE_;

 L9999:
  Top = intop;
  --C2F(recu).niv;
  intersci_pop();
  return FALSE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() sciops	(	integer *	number,
		integer *	op,
		integer *	mlhs,
		integer *	mrhs
	)

Definition at line 2239 of file stack2.c.

References allops(), C2F, Err, FALSE_, Fin, fun, ix, Lhs, Rhs, scibuiltin(), Top, and TRUE_.

Referenced by scistring().

{
  integer ifin, ifun, srhs= Rhs , slhs= Lhs, ix, intop=Top , lw;

  Fin   = *op;
  Top = Top - Rhs + *number + *mrhs - 1;
  Lhs = *mlhs;
  Rhs = *mrhs;

  while (1) 
    {
      C2F(allops)();
      if (Err > 0) {return FALSE_;} ;
      if (C2F(com).fun == 0) break; 
      Top = intop;
      ifun = C2F(com).fun;
      ifin = C2F(com).fin;
      if (! C2F(scibuiltin)(number, &ifun, &ifin, mlhs, mrhs)) 
        {return FALSE_;} ;
      if (Err > 0) {return FALSE_;} ;
    }
  Lhs = slhs;
  Rhs = srhs;
  Top = intop;
  
  for (ix = 1 ; ix <= *mlhs ; ++ix) {
    lw = Top - Rhs + *number + ix - 1;
    C2F(intersci).ntypes[lw - 1] = '$';
  }
  C2F(com).fun = 0;
  C2F(com).fin = *op;
  C2F(recu).icall = 0;
  return TRUE_;
} 

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() scistring	(	integer *	ifirst,
		char *	thestring,
		integer *	mlhs,
		integer *	mrhs,
		unsigned long	thestring_len
	)

Definition at line 2017 of file stack2.c.

References C2F, cvname(), cx0, FALSE_, fin, fun, funs(), get_fname(), getopcode(), iadr, ifin, ifun, istk, Lstk, nsiz, op, Rhs, scibuiltin(), scifunction(), sciops(), thestring_len, and Top.

Referenced by mexCallSCI().

{
  int ret = FALSE_;
  integer ifin, ifun, tops, moutputs, id[nsiz], lf, op, ile, ils, nnn, ninputs;
  nnn =  thestring_len;
  op = 0;
  if (nnn <= 2) {
    op = C2F(getopcode)(thestring, thestring_len);
  }
  if (op == 0) {
    C2F(cvname)(id, thestring, &cx0, nnn);
    C2F(com).fin = 0;
    tops = Top;
    Top = Top - Rhs + *ifirst + *mrhs - 1;
    C2F(funs)(id);
    Top = tops;
    if (C2F(com).fin == 0) {
      Scierror(999,"scistring: %s is not a Scilab function\r\n", 
               get_fname(thestring,thestring_len));
      return ret;
    }
    if (C2F(com).fun <= 0) {
      lf = *Lstk(C2F(com).fin);
      ils = iadr(lf) + 1;
      moutputs = *istk(ils);
      ile = ils + moutputs * nsiz + 1;
      ninputs = *istk(ile);
      /*  
       *   ninputs=actual number of inputs, moutputs=actual number of outputs
       *   of thestring: checking mlhs=ninputs and mrhs=moutputs not done. 
       */
      ret = C2F(scifunction)(ifirst, &lf, mlhs, mrhs);
    } else {
      ifin = C2F(com).fin;
      ifun = C2F(com).fun;
      ret = C2F(scibuiltin)(ifirst, &ifun, &ifin, mlhs, mrhs);
    }
  } else {
    ret = C2F(sciops)(ifirst, &op, mlhs, mrhs);
  }
  return ret;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int C2F() setworksize	(	integer *	number,
		integer *	size
	)

Definition at line 1125 of file stack2.c.

References C2F, FALSE_, Get_Iname(), iadr, intersiz, istk, Lstk, Max, Nbvars, Rhs, size, Top, and TRUE_.

{
  int lw1;
  char *fname = Get_Iname();
  if (*number > intersiz) {
    Scierror(999,"%s: (creatework) too many arguments in the stack edit stack.h and enlarge intersiz\r\n",
             fname);
    return FALSE_ ;
  }
  Nbvars = Max(*number,Nbvars);
  lw1 = *number + Top - Rhs;
  if (lw1 < 0) {
    Scierror(999,"%s: bad call to setworksize! (1rst argument)\r\n",
             fname);
    return FALSE_ ;
  }
  *istk(iadr(*Lstk(lw1)))=0;
  *Lstk(lw1+1) = *Lstk(lw1) + *size ;
  C2F(intersci).ntypes[*number - 1] = '$';
  C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
  C2F(intersci).lad[*number - 1] = 0; /* not to be used XXXX */ 
  return TRUE_; 
}

Here is the call graph for this function:

void strcpy_tws	(	char *	str1,
		char *	str2,
		int	len
	)

Definition at line 2765 of file stack2.c.

References i, and int.

{
  int i; 
  for ( i =0 ; i  < (int)strlen(str2); i++ ) str1[i]=str2[i];
  for (i = strlen(str2) ; i < len ; i++) str1[i]=' ';
  str1[len-1] ='\0';
}

integer C2F() vartype

(

integer *

number

)

Definition at line 167 of file stack2.c.

References C2F, gettype(), number, Rhs, and Top.

{
  integer ix1=  *number + Top - Rhs;
  return  C2F(gettype)(&ix1);
} 

Here is the call graph for this function:

---

Variable Documentation

char arg_position[56] [static]

Definition at line 2808 of file stack2.c.

integer cx0 = 0 [static]

Definition at line 27 of file stack2.c.

integer cx1 = 1 [static]

Definition at line 26 of file stack2.c.

char Fname[nlgh+1] [static]

Definition at line 2790 of file stack2.c.

intersci_list* L_intersci [static]

Definition at line 3206 of file stack2.c.

Referenced by intersci_pop(), and intersci_push().

char* pos[] = {"first","second","third","fourth"} [static]

Definition at line 2807 of file stack2.c.

Referenced by _SetSelection(), ChangeForName1(), cngrncb(), ComputeC_format(), cre_smat_from_str_i(), CreSmatFromHist(), delbtn(), delete_node(), DoSearch(), drawStringInCell(), findopt(), getBoundsheets(), getouttb(), getStringBox(), getStringHorizontalSpace(), getStringVerticalSpace(), inprd(), InsertFileNamed(), instring(), int_objfscanf(), intreadxls(), isFittingInCell(), main(), OLE_sectorpos(), Replace(), sciGetScreenPosition(), sciSetLegendPos(), sp(), TextPutCh(), xls_open(), and xls_read().

---