int 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;
void C2F(freeptr) (double *ip[])
{
if (ip)
+ {
FREE((char *)(*ip));
+ }
}
/*---------------------------------------
int C2F(isoptlw) (int *topk, int *lw, char *namex, unsigned long name_len)
{
if (*Infstk(*lw) != 1)
+ {
return FALSE;
+ }
C2F(cvname) (&C2F(vstk).idstk[(*lw) * nsiz - nsiz], namex, &cx1, name_len);
return TRUE;
}
for (k = 1; k <= Rhs; ++k)
if (*Infstk(k + Top - Rhs) == 1)
+ {
return k;
+ }
return (Rhs + 1);
}
i = rhs_opt_find(str, opts);
if (i >= 0)
if (opts[i].position > 0)
+ {
return opts[i].position;
+ }
return 0;
}
for (k = 1; k <= Rhs; ++k)
if (*Infstk(k + Top - Rhs) == 1)
+ {
ret++;
+ }
return ret;
}
il = iadr(*Lstk(*lw));
if (*istk(il) < 0)
+ {
il = iadr(*istk(il + 1));
+ }
return *istk(il);
}
il = iadr(*Lstk(*lw));
if (*istk(il) < 0)
+ {
il = iadr(*istk(il + 1));
+ }
switch (*typ)
{
case 'c': /* string */
ro->position = k;
if (ro->type[0] != '?')
+ {
GetRhsVar(ro->position, ro->type, &ro->m, &ro->n, &ro->l);
+ }
}
else
{
}
il = iadr(*Lstk(lw));
if (*istk(il) < 0)
+ {
return TRUE;
+ }
else
+ {
return FALSE;
+ }
}
/*---------------------------------------------------------------------
case 'c':
ix1 = *m * *n;
if (!C2F(cresmat2) (fname, &lw1, &ix1, lr, nlgh))
+ {
return FALSE;
+ }
*lr = cadr(*lr);
// Fill the string with spaces
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);
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;
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;
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);
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);
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;
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;
{
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;
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;
{
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);
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;
}
{
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);
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);
return FALSE;
}
if (*lar != -1)
+ {
C2F(cvstr1) (m, istk(*lr), cstk(*lar), &cx0, *m * *n + 1);
+ }
*lar = *lr;
*lr = cadr(*lr);
break;
return FALSE;
}
if (*lar != -1)
+ {
C2F(dcopy) (&mn, stk(*lar), &cx1, stk(*lr), &cx1);
+ }
*lar = *lr;
break;
case 'r':
return FALSE;
}
if (*lar != -1)
+ {
C2F(rea2db) (&mn, sstk(*lar), &cx1, stk(*lr), &cx1);
+ }
*lar = *lr;
*lr = iadr(*lr);
break;
return FALSE;
}
if (*lar != -1)
+ {
C2F(int2db) (&mn, istk(*lar), &cx1, stk(*lr), &cx1);
+ }
*lar = *lr;
*lr = iadr(*lr);
break;
return FALSE;
}
if (*lar != -1)
+ {
C2F(icopy) (&mn, istk(*lar), &cx1, istk(*lr), &cx1);
+ }
*lar = *lr;
break;
case 'I':
return FALSE;
}
if (*lar != -1)
+ {
C2F(tpconv) (&it, &it, &mn, istk(*lar), &inc, istk(*lr), &inc);
+ }
*lar = *lr;
break;
case 'p':
return FALSE;
}
if (*lar != -1)
+ {
*stk(*lr) = *stk(*lar);
+ }
*lar = *lr;
break;
case 'h':
return FALSE;
}
if (*lar != -1)
+ {
C2F(dcopy) (&mn, stk(*lar), &cx1, stk(*lr), &cx1);
+ }
*lar = *lr;
break;
default:
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);
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);
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;
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;
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;
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: (%s) bad third argument!\n"), fname, "createlistcvarfromptr");
*m = *Lstk(Bot) - sadr(il + 4);
n = 1;
if (!C2F(cremat) (fname, &lw1, &it, m, &n, lr, &lcs, nlgh))
+ {
return FALSE;
+ }
return TRUE;
}
il = iadr(*Lstk(lw));
if (*istk(il) < 0)
+ {
il = iadr(*istk(il + 1));
+ }
typ = *istk(il);
if (typ > sci_strings)
{
}
if (overloadtype(&lw, fname, &Type) == 0)
+ {
return FALSE;
+ }
topk = Top;
switch (Type)
* data is written */
lrr = *lr;
if (ix2 == 0)
+ {
lrr--;
+ }
C2F(in2str) (&ix2, istk(*lr), cstk(cadr(*lr)), ix2 + 1);
*lr = cadr(*lr);
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))
{
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);
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);
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;
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;
case 'S':
/** getwsmat : must be back in stack1.c from xawelm.f */
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
/* 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;
/* 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;
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;
{
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);
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);
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 < sci_list || itype > sci_mlist)
{
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))
{
case 'S':
/** getwsmat : must be back in stack1.c from xawelm.f */
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;
+ }
/*
* Warning : lr must have the proper size when calling getrhsvar
* char **Str1; .... GetRhsVar(...., &lr)
/* 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;
/* 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;
break;
case 'p':
if (!C2F(getlistpointer) (fname, &topk, &lw, number, lr, nlgh))
+ {
return FALSE;
+ }
break;
default:
Scierror(999, _("%s: bad call to %s (third argument %c).\n"), fname, "getlistrhsvar", 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);
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);
{
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;
/* 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;
{
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)
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)
int k;
for (k = *pos; k < *pos + *n; k++)
+ {
C2F(convert2sci) (&k);
+ }
Top = Top - Rhs + *pos - 1 + *n;
C2F(mklist) (n);
Top = tops;
int k;
for (k = *pos; k < *pos + *n; k++)
+ {
C2F(convert2sci) (&k);
+ }
Top = Top - Rhs + *pos - 1 + *n;
C2F(mklistt) (n, &type);
Top = tops;
int k;
for (k = *pos; k < *pos + *n; k++)
+ {
C2F(convert2sci) (&k);
+ }
Top = Top - Rhs + *pos - 1 + *n;
C2F(mklistt) (n, &type);
Top = tops;
goto L200;
}
if (Err > 0)
+ {
goto L97;
+ }
if (isRecursionCallToFunction())
{
goto L91;
L90:
if (Err > 0)
+ {
goto L97;
+ }
/**/
L91:
k = C2F(com).fun;
}
C2F(recu).krec = -1;
if (k == 0)
+ {
goto L60;
+ }
L95:
if (!C2F(allowptr) (&k))
+ {
C2F(ref2val) ();
+ }
C2F(recu).krec = k;
C2F(callinterf) (&k);
C2F(iset) (&Rhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
}
if (C2F(recu).paus > 0)
+ {
goto L91;
+ }
if (C2F(errgst).err1 > 0)
+ {
Top = ireftop;
+ }
goto L90;
}
/* called interface ask for a scilab function to perform the function (fun=-1)
C2F(com).fun = 0;
C2F(funs) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz]);
if (Err > 0)
+ {
goto L97;
+ }
if (C2F(com).fun > 0)
{
if (C2F(isbyref) (&C2F(com).fun) == 0)
+ {
C2F(ref2val) ();
+ }
goto L91;
}
if (Fin == 0)
{
SciError(246);
if (Err > 0)
+ {
goto L97;
+ }
goto L90;
}
++C2F(recu).pt;
{
/* .op or op. */
if (ch == '.')
+ {
ch = string[1];
+ }
op += 51;
}
int C2F(scibuiltin) (int *number, int *ifun, int *ifin, int *mlhs, int *mrhs)
{
int srhs = 0, slhs = 0;
- int ix = 0, k = 0, intop = 0, lw = 0;
+ int ix = 0, k = 0, intop = 0, lw = 0, pt0 = C2F(recu).pt;
int imode = 0, ireftop = 0;
intop = Top;
{
imode = abs(C2F(errgst).errct) / 100000 % 8;
if (imode != 3)
+ {
goto L97;
+ }
}
C2F(com).fun = 0;
goto L200;
}
if (Err > 0)
+ {
goto L97;
+ }
if (isRecursionCallToFunction())
{
goto L91;
L90:
if (Err > 0)
+ {
goto L97;
+ }
/**/
L91:
k = C2F(com).fun;
}
C2F(recu).krec = -1;
if (k == 0)
- goto L60;
+ {
+ if (C2F(recu).pt > pt0)
+ {
+ goto L60;
+ }
+ // goto L60;
+ goto L200;
+ }
L95:
if (!C2F(allowptr) (&k))
+ {
C2F(ref2val) ();
+ }
C2F(recu).krec = k;
C2F(callinterf) (&k);
C2F(recu).krec = -1;
C2F(iset) (&Lhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
}
if (C2F(recu).paus > 0)
+ {
goto L91;
+ }
if (C2F(errgst).err1 > 0)
+ {
Top = ireftop;
+ }
goto L90;
}
/* called interface ask for a sci function to perform the function (fun=-1) */
C2F(com).fun = 0;
C2F(funs) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz]);
if (Err > 0)
+ {
goto L97;
+ }
if (C2F(com).fun > 0)
{
if (C2F(isbyref) (&C2F(com).fun) == 0)
+ {
C2F(ref2val) ();
+ }
goto L91;
}
if (Fin == 0)
{
SciError(246);
if (Err > 0)
+ {
goto L97;
+ }
goto L90;
}
++C2F(recu).pt;
return FALSE;
};
if (C2F(com).fun == 0)
+ {
break;
+ }
Top = intop;
ifun = C2F(com).fun;
ifin = Fin;
-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)
{
}
}
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 non square matrix!\n"));
/* back conversion if necessary of a reference */
if (*istk(il) < 0)
+ {
il = iadr(*istk(il + 1));
+ }
m = *istk(il + 1);
n = *istk(il + 2);
it = *istk(il + 3);
}
if (Err > 0 || C2F(errgst).err1 > 0)
+ {
return TRUE;
+ }
if (C2F(com).fun == -1)
- return TRUE; /* execution continue with an
+ {
+ return TRUE;
+ } /* execution continue with an
* overloaded function */
if (LhsVar(1) == 0)
{
}
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;
ilp = iadr(iwh);
if (*istk(ilp) < 0)
+ {
ilp = iadr(*istk(ilp + 1));
+ }
m = *istk(ilp + 1);
n = *istk(ilp + 2);
it = *istk(ilp + 3);
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;
return FALSE;
}
if (C2F(vcopyobj) ("mvfromto", &pointed, itopl, 8L) == FALSE)
+ {
return FALSE;
+ }
break;
case 'h':
if (!C2F(crehmat) ("mvfromto", itopl, &m, &n, &lrs, 8L))
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;
{
ix1 = Top - Rhs + *ix;
if (C2F(vcopyobj) ("mvfromto", &ix1, itopl, 8L) == FALSE)
+ {
return FALSE;
+ }
}
}
return TRUE;
int ix1 = Top - Rhs + *ix;
if (!C2F(mvfromto) (&ix1, ix))
+ {
return FALSE;
+ }
C2F(intersci).ntypes[*ix - 1] = '$';
return TRUE;
}
int i;
for (i = 0; i < (int)strlen(str2); i++)
+ {
str1[i] = str2[i];
+ }
for (i = (int)strlen(str2); i < len; i++)
+ {
str1[i] = ' ';
+ }
str1[len - 1] = '\0';
}
FREE(tmp_buffer_1);
}
else
+ {
sprintf(arg_position, _("arguments #%d and #%d"), i, j);
+ }
}
return arg_position;
}
int check_same_dims(int i, int j, int m1, int n1, int m2, int n2)
{
if (m1 == m2 && n1 == n2)
+ {
return TRUE;
+ }
Scierror(999, _("%s: %s have incompatible dimensions (%dx%d) # (%dx%d)\n"), Get_Iname(), ArgsPosition(i, j), m1, n1, m2, n2);
return FALSE;
}
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);
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;
}
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;
intersci_list *loc = L_intersci;
if (loc == NULL)
+ {
return;
+ }
Nbvars = loc->nbvars;
for (i = 0; i < Nbvars; i++)
{
projects / scilab.git / commitdiff