scilab/modules/core/src/c/stack2.c

   1 /*
   2  * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   3  * Copyright (C) 1998-2000 - ENPC - Jean-Philippe CHANCELIER
   4  * Copyright (C) 1998-2008 - INRIA - Allan CORNET
   5  * Copyright (C) 1998-2008 - INRIA - Serge STEER
   6  * Copyright (C) 1998-2008 - INRIA - Sylvestre LEDRU
   7  * Copyright (C) 1998-2008 - INRIA - Bruno JOFRET
   8  * Copyright (C) 2011 - DIGITEO - Allan CORNET
   9  *
  10  * This file must be used under the terms of the CeCILL.
  11  * This source file is licensed as described in the file COPYING, which
  12  * you should have received as part of this distribution.  The terms
  13  * are also available at
  14  * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
  15  *
  16  * Please note that piece of code will be rewrited for the Scilab 6 family
  17  */
  18 /*------------------------------------------------------------------------
  19 *    Scilab Memory Management library (Stack API)
  20 --------------------------------------------------------------------------*/
  21
  22 /*---------------------------------------------------------------------
  23 * Interface Library:   ilib
  24 *---------------------------------------------------------------------*/
  25
  26 #include <string.h>
  27 #include <stdio.h>
  28
  29 #ifdef _MSC_VER
  30 #include "strdup_windows.h"
  31 #endif
  32
  33 #include "MALLOC.h"
  34 #include "stack-c.h"
  35 #include "sciprint.h"
  36 #include "stack2.h"
  37 #include "cvstr.h"
  38 #include "parse.h"
  39 #include "men_Sutils.h"
  40 #include "int2db.h"
  41 #include "rea2b.h"
  42 #include "Scierror.h"
  43 #include "localization.h"
  44 #include "callinterf.h"
  45 #include "call_scilab.h"
  46 #include "recursionFunction.h"
  47 #include "doublecomplex.h"
  48 #include "libinter.h"
  49
  50 #ifdef _MSC_VER
  51 #define abs(x) ((x) >= 0 ? (x) : -(x))  /* pour abs  C2F(mvfromto) line 2689 */
  52 #endif
  53
  54 /* Table of constant values */
  55 static int cx1 = 1;
  56 static int cx0 = 0;
  57
  58 static char *Get_Iname(void);
  59 static int C2F(mvfromto) (int *itopl, int *);
  60
  61 static int rhs_opt_find(char *name, rhs_opts opts[]);
  62 static void rhs_opt_print_names(rhs_opts opts[]);
  63 extern int C2F(isbyref) (int *fun);
  64
  65 /*------------------------------------------------*/
  66 void strcpy_tws(char *str1, char *str2, int len);
  67 int C2F(copyvarfromsciptr) (int lw, int n, int l);
  68 static int intersci_push(void);
  69 static void intersci_pop(void);
  70 static int C2F(getopcode) (char *string, unsigned long string_len);
  71
  72 static void ConvertData(unsigned char *type, int size, int l);
  73
  74 /*------------------------------------------------
  75 * checkrhs: checks right hand side arguments
  76 *-----------------------------------------------*/
  77
  78 int C2F(checkrhs) (char *fname, int *iMin, int *iMax, unsigned long fname_len)
  79 {
  80     /*
  81      * store the name in recu array, fname can be a non null terminated char array
  82      * Get_Iname() can be used in other function to get the interface name
  83      */
  84
  85     C2F(cvname) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], fname, &cx0, fname_len);
  86
  87     if (Rhs < *iMin || Rhs > *iMax)
  88     {
  89         if (*iMin == *iMax)
  90         {
  91             /* No optional argument */
  92             Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), get_fname(fname, fname_len), *iMax);
  93         }
  94         else
  95         {
  96             Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), get_fname(fname, fname_len), *iMin, *iMax);
  97         }
  98         return FALSE;
  99     }
 100     return TRUE;
 101 }
 102
 103 /*------------------------------------------------
 104 * checkrhs: checks left hand side arguments
 105 *-----------------------------------------------*/
 106
 107 int C2F(checklhs) (char *fname, int *iMin, int *iMax, unsigned long fname_len)
 108 {
 109     if (Lhs < *iMin || Lhs > *iMax)
 110     {
 111         if (*iMin == *iMax)
 112         {
 113             /* No optional argument */
 114             Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), get_fname(fname, fname_len), *iMax);
 115         }
 116         else
 117         {
 118             Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), get_fname(fname, fname_len), *iMin, *iMax);
 119         }
 120         return FALSE;
 121     }
 122     return TRUE;
 123 }
 124
 125 /*---------------------------------------------------------------------
 126 * isopt:
 127 * returns the status of the variable number k
 128 * if its an optional variable f(x=...)
 129 * returns .true. and variable name in namex
 130 * namex must have a size of nlgh + 1
 131 *---------------------------------------------------------------------*/
 132
 133 int C2F(isopt) (int *k, char *namex, unsigned long name_len)
 134 {
 135     int i1 = *k + Top - Rhs;
 136
 137     if (C2F(isoptlw) (&Top, &i1, namex, name_len) == FALSE)
 138     {
 139         return FALSE;
 140     }
 141     /* add a '\0' at the end of the string removing trailing blanks */
 142     for (i1 = nlgh - 1; i1 >= 0; i1--)
 143     {
 144         if (namex[i1] != ' ')
 145         {
 146             break;
 147         }
 148     }
 149     namex[i1 + 1] = '\0';
 150     return TRUE;
 151 }
 152
 153 /*--------------------------------------------------------------
 154 * freeptr : free ip pointer
 155 *--------------------------------------------------------------*/
 156
 157 void C2F(freeptr) (double *ip[])
 158 {
 159     if (ip)
 160     {
 161         FREE((char *)(*ip));
 162     }
 163 }
 164
 165 /*---------------------------------------
 166 * isoptlw :
 167 * returns the status of the variable at position lw in the stack
 168 * if its an optional variable f(x=...)
 169 * returns .true. and variable name in namex
 170 *--------------------------------------- */
 171
 172 int C2F(isoptlw) (int *topk, int *lw, char *namex, unsigned long name_len)
 173 {
 174     if (*Infstk(*lw) != 1)
 175     {
 176         return FALSE;
 177     }
 178     C2F(cvname) (&C2F(vstk).idstk[(*lw) * nsiz - nsiz], namex, &cx1, name_len);
 179     return TRUE;
 180 }
 181
 182 /*---------------------------------------
 183 * firstopt :
 184 * return the position of the first optionnal argument
 185 * given as xx=val in the calling sequence.
 186 * If no such argument it returns Rhs+1.
 187 *--------------------------------------- */
 188 int C2F(firstopt) (void)
 189 {
 190     int k;
 191
 192     for (k = 1; k <= Rhs; ++k)
 193         if (*Infstk(k + Top - Rhs) == 1)
 194         {
 195             return k;
 196         }
 197     return (Rhs + 1);
 198 }
 199
 200 /*---------------------------------------
 201 * findopt :
 202 * checks if option str has been passed.
 203 * If yes returns the position of the variable
 204 * If no  returns 0
 205 *--------------------------------------- */
 206
 207 int C2F(findopt) (char *str, rhs_opts opts[])
 208 {
 209     int i;
 210
 211     i = rhs_opt_find(str, opts);
 212     if (i >= 0)
 213         if (opts[i].iPos > 0)
 214         {
 215             return opts[i].iPos;
 216
 217         }
 218
 219     return 0;
 220 }
 221
 222 /*---------------------------------------
 223 * numopt :
 224 *  returns the number of optional variables
 225 *  given as xx=val in the caling sequence
 226 *  top must have a correct value when using this function
 227 *--------------------------------------- */
 228
 229 int C2F(numopt) (void)
 230 {
 231     int k, ret = 0;
 232
 233     for (k = 1; k <= Rhs; ++k)
 234         if (*Infstk(k + Top - Rhs) == 1)
 235         {
 236             ret++;
 237         }
 238     return ret;
 239 }
 240
 241 /*---------------------------------------------------------------------
 242 * vartype:
 243 *   type of variable number number in the stack
 244 *---------------------------------------------------------------------*/
 245
 246 int C2F(vartype) (int *number)
 247 {
 248     int ix1 = *number + Top - Rhs;
 249
 250     return C2F(gettype) (&ix1);
 251 }
 252
 253 /*------------------------------------------------
 254 * gettype:
 255 *    returns the type of object at position lw in the stack
 256 *------------------------------------------------*/
 257
 258 int C2F(gettype) (int *lw)
 259 {
 260     int il;
 261
 262     il = iadr(*Lstk(*lw));
 263     if (*istk(il) < 0)
 264     {
 265         il = iadr(*istk(il + 1));
 266     }
 267     return *istk(il);
 268 }
 269
 270 /*------------------------------------------------
 271 * overloadtype:
 272 *    set mechanism to overloaded function fname if object type
 273 *    does not fit given type
 274 *------------------------------------------------*/
 275
 276 static int overloadtype(int *lw, char *fname, unsigned char *typ)
 277 {
 278     int il = 0;
 279     int ityp = 0;
 280
 281     il = iadr(*Lstk(*lw));
 282     if (*istk(il) < 0)
 283     {
 284         il = iadr(*istk(il + 1));
 285     }
 286     switch (*typ)
 287     {
 288         case 'c':                  /* string */
 289         case 'S':                  /* string Matrix */
 290             ityp = sci_strings;
 291             break;
 292         case 'd':
 293         case 'i':
 294         case 'r':
 295         case 'z':                  /* numeric */
 296             ityp = sci_matrix;
 297             break;
 298         case 'b':                  /* boolean */
 299             ityp = sci_boolean;
 300             break;
 301         case 'h':                  /* handle */
 302             ityp = sci_handles;
 303             break;
 304         case 'l':                  /* list */
 305             ityp = sci_list;
 306             break;
 307         case 't':                  /* tlist */
 308             ityp = sci_tlist;
 309             break;
 310         case 'm':                  /* mlist */
 311             ityp = sci_mlist;
 312             break;
 313         case 'f':                  /* external */
 314             ityp = sci_c_function;
 315             break;
 316         case 'p':                  /* pointer */
 317             ityp = sci_pointer;     /* used to be sci_lufact_pointer before Scilab 5.2 */
 318             break;
 319         case 's':                  /* sparse */
 320             ityp = sci_sparse;
 321             break;
 322         case 'I':                  /* int matrix */
 323             ityp = sci_ints;
 324             break;
 325         case 'x':                  /* polynomial matrix */
 326             ityp = sci_poly;
 327             break;
 328
 329     }
 330     if (*istk(il) != ityp)
 331     {
 332         return C2F(overload) (lw, fname, (unsigned long)strlen(fname));
 333     }
 334     return 1;
 335 }
 336
 337 /*------------------------------------------------
 338 * overload
 339 *    set mechanism to overloaded function fname for object lw
 340 *------------------------------------------------*/
 341
 342 int C2F(overload) (int *lw, char *fname, unsigned long l)
 343 {
 344     C2F(putfunnam) (fname, lw, l);
 345     C2F(com).fun = -1;
 346     return 0;
 347 }
 348
 349 /*------------------------------------------------
 350 * ogettype : unused
 351 *------------------------------------------------*/
 352 int C2F(ogettype) (int *lw)
 353 {
 354     return *istk(iadr(*Lstk(*lw)));
 355 }
 356
 357 /*----------------------------------------------------
 358 * Optional arguments f(....., arg =val,...)
 359 *          in interfaces
 360 * function get_optionals : example is provided in
 361 *    examples/addinter-examples/intex2c.c
 362 *----------------------------------------------------*/
 363
 364 int get_optionals(char *fname, rhs_opts opts[])
 365 {
 366     int k, i = 0;
 367     char name[nlgh + 1];
 368     int nopt = NumOpt();        /* optional arguments on the stack */
 369
 370     /* reset first field since opts is declared static in calling function */
 371     /* this could be avoided with ansi compilers by removing static in the
 372      * opts declaration */
 373
 374     while (opts[i].pstName != NULL)
 375     {
 376         opts[i].iPos = -1;
 377         i++;
 378     }
 379
 380     /* Walking through last arguments */
 381
 382     for (k = Rhs - nopt + 1; k <= Rhs; k++)
 383     {
 384         if (IsOpt(k, name) == 0)
 385         {
 386             Scierror(999, _("%s: Optional arguments name=val must be at the end.\n"), fname);
 387             return 0;
 388         }
 389         else
 390         {
 391             int isopt = rhs_opt_find(name, opts);
 392
 393             if (isopt >= 0)
 394             {
 395                 rhs_opts *ro = &opts[isopt];
 396                 ro->iPos = k;
 397                 if (ro->iType != '?')
 398                 {
 399                     GetRhsVar(ro->iPos, ro->iType, &ro->iRows, &ro->iCols, &ro->piAddr);
 400                 }
 401             }
 402             else
 403             {
 404                 sciprint(_("%s: Unrecognized optional arguments %s.\n"), fname, name);
 405                 rhs_opt_print_names(opts);
 406                 SciError(999);
 407                 return 0;
 408             }
 409         }
 410     }
 411     return 1;
 412 }
 413
 414 /* Is name in opts */
 415
 416 int rhs_opt_find(char *name, rhs_opts opts[])
 417 {
 418     int rep = -1, i = 0;
 419
 420     while (opts[i].pstName != NULL)
 421     {
 422         int cmp;
 423
 424         /* name is terminated by white space and we want to ignore them */
 425         if ((cmp = strcmp(name, opts[i].pstName)) == 0)
 426         {
 427             rep = i;
 428             break;
 429         }
 430         else if (cmp < 0)
 431         {
 432             break;
 433         }
 434         else
 435         {
 436             i++;
 437         }
 438     }
 439     return rep;
 440 }
 441
 442 void rhs_opt_print_names(rhs_opts opts[])
 443 /* array of optinal names (in alphabetical order)
 444 * the array is null terminated */
 445 {
 446     int i = 0;
 447
 448     if (opts[i].pstName == NULL)
 449     {
 450         sciprint(_("Optional argument list is empty.\n"));
 451         return;
 452     }
 453     sciprint(_("Optional arguments list: \n"));
 454     while (opts[i + 1].pstName != NULL)
 455     {
 456         sciprint("%s, ", opts[i].pstName);
 457         i++;
 458     }
 459     sciprint(_("and %s.\n"), opts[i].pstName);
 460 }
 461
 462 /*---------------------------------------------------------------------
 463 * isref :
 464 *   checks if variable number lw is on the stack
 465 *   or is just a reference to a variable on the stack
 466 *---------------------------------------------------------------------*/
 467
 468 int IsRef(int number)
 469 {
 470     return C2F(isref) (&number);
 471 }
 472
 473 int C2F(isref) (int *number)
 474 {
 475     int il, lw;
 476
 477     lw = *number + Top - Rhs;
 478     if (*number > Rhs)
 479     {
 480         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), "isref", "isref");
 481         return FALSE;
 482     }
 483     il = iadr(*Lstk(lw));
 484     if (*istk(il) < 0)
 485     {
 486         return TRUE;
 487     }
 488     else
 489     {
 490         return FALSE;
 491     }
 492 }
 493
 494 /*---------------------------------------------------------------------
 495 *     create a variable number lw in the stack of type
 496 *     type and size m,n
 497 *     the argument must be of type type ('c','d','r','i','l','b')
 498 *     return values m,n,lr
 499 *     c : string  (m-> number of characters and n->1)
 500 *     d,r,i : matrix of double,float or integer
 501 *     b : boolean matrix
 502 *     l : a list  (m-> number of elements and n->1)
 503 *         for each element of the list an other function
 504 *         must be used to <<get>> them
 505 *     side effects : arguments in the common intersci are modified
 506 *     see examples in addinter-examples
 507 *---------------------------------------------------------------------*/
 508
 509 int C2F(createvar) (int *lw, char *typex, int *m, int *n, int *lr, unsigned long type_len)
 510 {
 511     int ix1, ix, it = 0, lw1, lcs, IT;
 512     unsigned char Type = *typex;
 513     char *fname = Get_Iname();
 514
 515     if (*lw > intersiz)
 516     {
 517         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createvar");
 518         return FALSE;
 519     }
 520     Nbvars = Max(*lw, Nbvars);
 521     lw1 = *lw + Top - Rhs;
 522     if (*lw < 0)
 523     {
 524         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createvar");
 525         return FALSE;
 526     }
 527     switch (Type)
 528     {
 529         case 'c':
 530             ix1 = *m **n;
 531             if (!C2F(cresmat2) (fname, &lw1, &ix1, lr, nlgh))
 532             {
 533                 return FALSE;
 534             }
 535             *lr = cadr(*lr);
 536             // Fill the string with spaces
 537             for (ix = 0; ix < (*m) * (*n); ++ix)
 538             {
 539                 *cstk(*lr + ix) = ' ';
 540             }
 541             *cstk(*lr + (*m) * (*n)) = '\0';
 542             C2F(intersci).ntypes[*lw - 1] = Type;
 543             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 544             C2F(intersci).lad[*lw - 1] = *lr;
 545             break;
 546         case 'd':
 547             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 548             {
 549                 return FALSE;
 550             }
 551             C2F(intersci).ntypes[*lw - 1] = Type;
 552             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 553             C2F(intersci).lad[*lw - 1] = *lr;
 554             break;
 555         case 'z':
 556             IT = 1;
 557             if (!(*Lstk(lw1) % 2))
 558             {
 559                 *Lstk(lw1) = *Lstk(lw1) + 1;
 560             }
 561             if (!C2F(cremat) (fname, &lw1, &IT, m, n, lr, &lcs, nlgh))
 562             {
 563                 return FALSE;
 564             }
 565             C2F(intersci).ntypes[*lw - 1] = Type;
 566             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 567             C2F(intersci).lad[*lw - 1] = *lr;
 568             *lr = sadr(*lr);
 569             break;
 570         case 'l':
 571             C2F(crelist) (&lw1, m, lr);
 572             C2F(intersci).ntypes[*lw - 1] = '$';
 573             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 574             C2F(intersci).lad[*lw - 1] = *lr;
 575             break;
 576         case 't':
 577             C2F(cretlist) (&lw1, m, lr);
 578             C2F(intersci).ntypes[*lw - 1] = '$';
 579             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 580             C2F(intersci).lad[*lw - 1] = *lr;
 581             break;
 582         case 'm':
 583             C2F(cremlist) (&lw1, m, lr);
 584             C2F(intersci).ntypes[*lw - 1] = '$';
 585             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 586             C2F(intersci).lad[*lw - 1] = *lr;
 587             break;
 588         case 'r':
 589             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 590             {
 591                 return FALSE;
 592             }
 593             *lr = iadr(*lr);
 594             C2F(intersci).ntypes[*lw - 1] = Type;
 595             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 596             C2F(intersci).lad[*lw - 1] = *lr;
 597             break;
 598         case 'i':
 599             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 600             {
 601                 return FALSE;
 602             }
 603             *lr = iadr(*lr);
 604             C2F(intersci).ntypes[*lw - 1] = Type;
 605             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 606             C2F(intersci).lad[*lw - 1] = *lr;
 607             break;
 608         case 'b':
 609             if (!C2F(crebmat) (fname, &lw1, m, n, lr, nlgh))
 610             {
 611                 return FALSE;
 612             }
 613             C2F(intersci).ntypes[*lw - 1] = Type;
 614             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 615             C2F(intersci).lad[*lw - 1] = *lr;
 616             break;
 617         case 'p':
 618             if (!C2F(crepointer) (fname, &lw1, lr, nlgh))
 619             {
 620                 return FALSE;
 621             }
 622             C2F(intersci).ntypes[*lw - 1] = '$';
 623             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 624             C2F(intersci).lad[*lw - 1] = *lr;
 625             break;
 626         case 'I':
 627             it = *lr;               /* on entry lr gives the int type */
 628             if (!C2F(creimat) (fname, &lw1, &it, m, n, lr, nlgh))
 629             {
 630                 return FALSE;
 631             }
 632             C2F(intersci).ntypes[*lw - 1] = '$';
 633             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 634             C2F(intersci).lad[*lw - 1] = *lr;
 635             break;
 636         case 'h':
 637             if (!C2F(crehmat) (fname, &lw1, m, n, lr, nlgh))
 638             {
 639                 return FALSE;
 640             }
 641             C2F(intersci).ntypes[*lw - 1] = Type;
 642             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 643             C2F(intersci).lad[*lw - 1] = *lr;
 644             break;
 645             // TODO : add a default case
 646     }
 647     return TRUE;
 648 }
 649
 650 /*---------------------------------------------------------------------
 651 *     create a variable number lw in the stack of type
 652 *     type and size m,n
 653 *     the argument must be of type type ('d','r','i')
 654 *     return values m,n,lr
 655 *     d,r,i : matrix of double,float or integer
 656 *     side effects : arguments in the common intersci are modified
 657 *     see examples in addinter-examples
 658 *     Like createvar but for complex matrices
 659 *---------------------------------------------------------------------*/
 660
 661 int C2F(createcvar) (int *lw, char *typex, int *it, int *m, int *n, int *lr, int *lc, unsigned long type_len)
 662 {
 663     unsigned char Type = *typex;
 664     int lw1;
 665     char *fname = Get_Iname();
 666
 667     if (*lw > intersiz)
 668     {
 669         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createcvar");
 670         return FALSE;
 671     }
 672     Nbvars = Max(*lw, Nbvars);
 673     lw1 = *lw + Top - Rhs;
 674     if (*lw < 0)
 675     {
 676         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createcvar");
 677         return FALSE;
 678     }
 679     switch (Type)
 680     {
 681         case 'd':
 682             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, lc, nlgh))
 683             {
 684                 return FALSE;
 685             }
 686             C2F(intersci).ntypes[*lw - 1] = Type;
 687             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 688             C2F(intersci).lad[*lw - 1] = *lr;
 689             break;
 690         case 'r':
 691             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, lc, nlgh))
 692             {
 693                 return FALSE;
 694             }
 695             *lr = iadr(*lr);
 696             *lc = *lr + *m **n;
 697             C2F(intersci).ntypes[*lw - 1] = Type;
 698             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 699             C2F(intersci).lad[*lw - 1] = *lr;
 700             break;
 701         case 'i':
 702             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, lc, nlgh))
 703             {
 704                 return FALSE;
 705             }
 706             *lr = iadr(*lr);
 707             *lc = *lr + *m **n;
 708             C2F(intersci).ntypes[*lw - 1] = Type;
 709             C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 710             C2F(intersci).lad[*lw - 1] = *lr;
 711             break;
 712     }
 713     return TRUE;
 714 }
 715
 716 /*---------------------------------------------------------------------
 717 *     create a variable number lw on the stack of type
 718 *     list with nel elements
 719 *---------------------------------------------------------------------*/
 720
 721 int C2F(createlist) (int *lw, int *nel)
 722 {
 723     char *fname = Get_Iname();
 724     int lr, lw1;
 725
 726     if (*lw > intersiz)
 727     {
 728         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createlist");
 729         return FALSE;
 730     }
 731     Nbvars = Max(*lw, Nbvars);
 732     lw1 = *lw + Top - Rhs;
 733     if (*lw < 0)
 734     {
 735         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createlist");
 736         return FALSE;
 737     }
 738     C2F(crelist) (&lw1, nel, &lr);
 739     C2F(intersci).ntypes[*lw - 1] = '$';
 740     C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 741     C2F(intersci).lad[*lw - 1] = lr;
 742     return TRUE;
 743 }
 744
 745 /*---------------------------------------------------------------------
 746 *     create a variable number lw on the stack of type
 747 *     type and size m,n
 748 *     the argument must be of type type ('c','d','r','i','b')
 749 *     return values m,n,lr,lar
 750 *     lar is also an input value
 751 *     if lar != -1 var is filled with data stored at lar
 752 *---------------------------------------------------------------------*/
 753
 754 int C2F(createvarfrom) (int *lw, char *typex, int *m, int *n, int *lr, int *lar, unsigned long type_len)
 755 {
 756     int M = *m, N = *n, MN = M * N;
 757     unsigned char Type = *typex;
 758     int inc = 1;
 759     int it = 0, lw1, lcs;
 760     char *fname = Get_Iname();
 761
 762     if (*lw > intersiz)
 763     {
 764         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createvarfrom");
 765         return FALSE;
 766     }
 767     Nbvars = Max(*lw, Nbvars);
 768     lw1 = *lw + Top - Rhs;
 769     if (*lw < 0)
 770     {
 771         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createvarfrom");
 772         return FALSE;
 773     }
 774     switch (Type)
 775     {
 776         case 'c':
 777             if (!C2F(cresmat2) (fname, &lw1, &MN, lr, nlgh))
 778             {
 779                 return FALSE;
 780             }
 781             if (*lar != -1)
 782             {
 783                 C2F(cvstr1) (&MN, istk(*lr), cstk(*lar), &cx0, MN + 1);
 784             }
 785             *lar = *lr;
 786             *lr = cadr(*lr);
 787             break;
 788         case 'd':
 789             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 790             {
 791                 return FALSE;
 792             }
 793             if (*lar != -1)
 794             {
 795                 C2F(dcopy) (&MN, stk(*lar), &cx1, stk(*lr), &cx1);
 796             }
 797             *lar = *lr;
 798             break;
 799         case 'r':
 800             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 801             {
 802                 return FALSE;
 803             }
 804             if (*lar != -1)
 805             {
 806                 C2F(rea2db) (&MN, sstk(*lar), &cx1, stk(*lr), &cx1);
 807             }
 808             *lar = *lr;
 809             *lr = iadr(*lr);
 810             break;
 811         case 'i':
 812             if (!C2F(cremat) (fname, &lw1, &it, m, n, lr, &lcs, nlgh))
 813             {
 814                 return FALSE;
 815             }
 816             if (*lar != -1)
 817             {
 818                 C2F(int2db) (&MN, istk(*lar), &cx1, stk(*lr), &cx1);
 819             }
 820             *lar = *lr;
 821             *lr = iadr(*lr);
 822             break;
 823         case 'b':
 824             if (!C2F(crebmat) (fname, &lw1, m, n, lr, nlgh))
 825             {
 826                 return FALSE;
 827             }
 828             if (*lar != -1)
 829             {
 830                 C2F(icopy) (&MN, istk(*lar), &cx1, istk(*lr), &cx1);
 831             }
 832             *lar = *lr;
 833             break;
 834         case 'I':
 835             it = *lr;
 836             if (!C2F(creimat) (fname, &lw1, &it, m, n, lr, nlgh))
 837             {
 838                 return FALSE;
 839             }
 840             if (*lar != -1)
 841             {
 842                 C2F(tpconv) (&it, &it, &MN, istk(*lar), &inc, istk(*lr), &inc);
 843             }
 844             *lar = *lr;
 845             break;
 846         case 'p':
 847             MN = 1;
 848             if (!C2F(crepointer) (fname, &lw1, lr, nlgh))
 849             {
 850                 return FALSE;
 851             }
 852             if (*lar != -1)
 853             {
 854                 C2F(dcopy) (&MN, stk(*lar), &cx1, stk(*lr), &cx1);
 855             }
 856             *lar = *lr;
 857             break;
 858         case 'h':
 859             if (!C2F(crehmat) (fname, &lw1, m, n, lr, nlgh))
 860             {
 861                 return FALSE;
 862             }
 863             if (*lar != -1)
 864             {
 865                 C2F(dcopy) (&MN, stk(*lar), &cx1, stk(*lr), &cx1);
 866             }
 867             *lar = *lr;
 868             break;
 869     }
 870     C2F(intersci).ntypes[*lw - 1] = '$';
 871     C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 872     C2F(intersci).lad[*lw - 1] = *lr;
 873     return TRUE;
 874 }
 875
 876 /*---------------------------------------------------------------------
 877 *     create a variable number lw on the stack of type
 878 *     type and size m,n
 879 *     the argument must be of type type ('d','r','i')
 880 *     return values it,m,n,lr,lc,lar,lac
 881 *     lar is also an input value
 882 *     if lar != -1 var is filled with data stored at lar
 883 *     idem for lac
 884 *     ==> like createvarfrom for complex matrices
 885 *---------------------------------------------------------------------*/
 886
 887 int C2F(createcvarfrom) (int *lw, char *typex, int *it, int *m, int *n, int *lr, int *lc, int *lar, int *lac, unsigned long type_len)
 888 {
 889     unsigned char Type = *typex;
 890     int MN;
 891     int lw1, lcs;
 892     char *fname = Get_Iname();
 893
 894     if (*lw > intersiz)
 895     {
 896         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createcvarfrom");
 897         return FALSE;
 898     }
 899     Nbvars = Max(*lw, Nbvars);
 900     lw1 = *lw + Top - Rhs;
 901     MN = (*m) * (*n);
 902     if (*lw < 0)
 903     {
 904         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createcvarfrom");
 905         return FALSE;
 906     }
 907     switch (Type)
 908     {
 909         case 'd':
 910             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, lc, nlgh))
 911             {
 912                 return FALSE;
 913             }
 914             if (*lar != -1)
 915             {
 916                 C2F(dcopy) (&MN, stk(*lar), &cx1, stk(*lr), &cx1);
 917             }
 918             if (*lac != -1 && *it == 1)
 919             {
 920                 C2F(dcopy) (&MN, stk(*lac), &cx1, stk(*lc), &cx1);
 921             }
 922             *lar = *lr;
 923             *lac = *lc;
 924             break;
 925         case 'r':
 926             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, lc, nlgh))
 927             {
 928                 return FALSE;
 929             }
 930             if (*lar != -1)
 931             {
 932                 C2F(rea2db) (&MN, sstk(*lar), &cx1, stk(*lr), &cx1);
 933             }
 934             if (*lac != -1 && *it == 1)
 935             {
 936                 C2F(rea2db) (&MN, sstk(*lac), &cx1, stk(*lc), &cx1);
 937             }
 938             *lar = *lr;
 939             *lac = *lc;
 940             *lr = iadr(*lr);
 941             *lc = *lr + *m **n;
 942             break;
 943         case 'i':
 944             if (!C2F(cremat) (fname, &lw1, it, m, n, lr, &lcs, nlgh))
 945             {
 946                 return FALSE;
 947             }
 948             if (*lar != -1)
 949             {
 950                 C2F(int2db) (&MN, istk(*lar), &cx1, stk(*lr), &cx1);
 951             }
 952             if (*lac != -1 && (*it == 1))
 953             {
 954                 C2F(int2db) (&MN, istk(*lac), &cx1, stk(*lc), &cx1);
 955             }
 956             *lar = *lr;
 957             *lac = *lc;
 958             *lr = iadr(*lr);
 959             *lc = *lr + *m **n;
 960             break;
 961     }
 962     C2F(intersci).ntypes[*lw - 1] = '$';
 963     C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
 964     C2F(intersci).lad[*lw - 1] = *lr;
 965     return TRUE;
 966 }
 967
 968 /*---------------------------------------------------------------------
 969 *     This function must be called after createvar(lnumber,'l',...)
 970 *     Argument lnumber is a list
 971 *     we want here to get its argument number number
 972 *     the argument must be of type type ('c','d','r','i','b')
 973 *     input values lnumber,number,type,lar
 974 *     lar : input value ( -1 or the adress of an object which is used
 975 *           to fill the new variable data slot.
 976 *     lar must be a variable since it is used as input and output
 977 *     return values m,n,lr,lar
 978 *         (lar --> data is coded at stk(lar)
 979 *          lr  --> data is coded at istk(lr) or stk(lr) or sstk(lr)
 980 *                  or cstk(lr)
 981 *     c : string  (m-> number of characters and n->1)
 982 *     d,r,i : matrix of double,float or integer
 983 *---------------------------------------------------------------------*/
 984
 985 int C2F(createlistvarfrom) (int *lnumber, int *number, char *typex, int *m, int *n, int *lr, int *lar, unsigned long type_len)
 986 {
 987     unsigned Type = *typex;
 988     int lc, ix1, it = 0, mn = (*m) * (*n), inc = 1;
 989     char *fname = Get_Iname();
 990
 991     if (*lnumber > intersiz)
 992     {
 993         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createlistvar");
 994         return FALSE;
 995     }
 996     switch (Type)
 997     {
 998         case 'c':
 999             *n = 1;
1000             ix1 = *lnumber + Top - Rhs;
1001             if (!C2F(listcrestring) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, lr, nlgh))
1002             {
1003                 return FALSE;
1004             }
1005             if (*lar != -1)
1006             {
1007                 C2F(cvstr1) (m, istk(*lr), cstk(*lar), &cx0, *m **n + 1);
1008             }
1009             *lar = *lr;
1010             *lr = cadr(*lr);
1011             break;
1012         case 'd':
1013             ix1 = *lnumber + Top - Rhs;
1014             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, lr, &lc, nlgh))
1015             {
1016                 return FALSE;
1017             }
1018             if (*lar != -1)
1019             {
1020                 C2F(dcopy) (&mn, stk(*lar), &cx1, stk(*lr), &cx1);
1021             }
1022             *lar = *lr;
1023             break;
1024         case 'r':
1025             ix1 = *lnumber + Top - Rhs;
1026             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, lr, &lc, nlgh))
1027             {
1028                 return FALSE;
1029             }
1030             if (*lar != -1)
1031             {
1032                 C2F(rea2db) (&mn, sstk(*lar), &cx1, stk(*lr), &cx1);
1033             }
1034             *lar = *lr;
1035             *lr = iadr(*lr);
1036             break;
1037         case 'i':
1038             ix1 = *lnumber + Top - Rhs;
1039             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, lr, &lc, nlgh))
1040             {
1041                 return FALSE;
1042             }
1043             if (*lar != -1)
1044             {
1045                 C2F(int2db) (&mn, istk(*lar), &cx1, stk(*lr), &cx1);
1046             }
1047             *lar = *lr;
1048             *lr = iadr(*lr);
1049             break;
1050         case 'b':
1051             ix1 = *lnumber + Top - Rhs;
1052             if (!C2F(listcrebmat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, n, lr, nlgh))
1053             {
1054                 return FALSE;
1055             }
1056             if (*lar != -1)
1057             {
1058                 C2F(icopy) (&mn, istk(*lar), &cx1, istk(*lr), &cx1);
1059             }
1060             *lar = *lr;
1061             break;
1062         case 'I':
1063             it = *lr;               /* it gives the type on entry */
1064             ix1 = *lnumber + Top - Rhs;
1065             if (!C2F(listcreimat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, lr, nlgh))
1066             {
1067                 return FALSE;
1068             }
1069             if (*lar != -1)
1070             {
1071                 C2F(tpconv) (&it, &it, &mn, istk(*lar), &inc, istk(*lr), &inc);
1072             }
1073             *lar = *lr;
1074             break;
1075         case 'p':
1076             ix1 = *lnumber + Top - Rhs;
1077             if (!C2F(listcrepointer) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], lr, nlgh))
1078             {
1079                 return FALSE;
1080             }
1081             if (*lar != -1)
1082             {
1083                 *stk(*lr) = *stk(*lar);
1084             }
1085             *lar = *lr;
1086             break;
1087         case 'h':
1088             ix1 = *lnumber + Top - Rhs;
1089             if (!C2F(listcrehmat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, n, lr, nlgh))
1090             {
1091                 return FALSE;
1092             }
1093             if (*lar != -1)
1094             {
1095                 C2F(dcopy) (&mn, stk(*lar), &cx1, stk(*lr), &cx1);
1096             }
1097             *lar = *lr;
1098             break;
1099         default:
1100             Scierror(999, _("%s: (%s) bad third argument!\n"), fname, "createlistvar");
1101             return FALSE;
1102             break;
1103     }
1104     return TRUE;
1105 }
1106
1107 /*---------------------------------------------------------------------
1108 * create a complex list variable from data
1109 *---------------------------------------------------------------------*/
1110
1111 int C2F(createlistcvarfrom) (int *lnumber, int *number, char *typex, int *it, int *m, int *n, int *lr, int *lc, int *lar, int *lac,
1112                              unsigned long type_len)
1113 {
1114     int ix1;
1115     int mn = (*m) * (*n);
1116     unsigned char Type = *typex;
1117     char *fname = Get_Iname();
1118
1119     if (*lnumber > intersiz)
1120     {
1121         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createlistcvar");
1122         return FALSE;
1123     }
1124
1125     switch (Type)
1126     {
1127         case 'd':
1128             ix1 = *lnumber + Top - Rhs;
1129             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, lr, lc, nlgh))
1130             {
1131                 return FALSE;
1132             }
1133             if (*lar != -1)
1134             {
1135                 C2F(dcopy) (&mn, stk(*lar), &cx1, stk(*lr), &cx1);
1136             }
1137             if (*lac != -1 && *it == 1)
1138             {
1139                 C2F(dcopy) (&mn, stk(*lac), &cx1, stk(*lc), &cx1);
1140             }
1141             *lar = *lr;
1142             *lac = *lc;
1143             break;
1144         case 'r':
1145             ix1 = *lnumber + Top - Rhs;
1146             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, lr, lc, nlgh))
1147             {
1148                 return FALSE;
1149             }
1150             if (*lar != -1)
1151             {
1152                 C2F(rea2db) (&mn, sstk(*lar), &cx1, stk(*lr), &cx1);
1153             }
1154             if (*lac != -1 && *it == 1)
1155             {
1156                 C2F(rea2db) (&mn, sstk(*lac), &cx1, stk(*lc), &cx1);
1157             }
1158             *lar = *lr;
1159             *lac = *lc;
1160             *lr = iadr(*lr);
1161             *lc = *lr + *m **n;
1162             break;
1163         case 'i':
1164             ix1 = *lnumber + Top - Rhs;
1165             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, lr, lc, nlgh))
1166             {
1167                 return FALSE;
1168             }
1169             if (*lar != -1)
1170             {
1171                 C2F(int2db) (&mn, istk(*lar), &cx1, stk(*lr), &cx1);
1172             }
1173             if (*lac != -1 && *it == 1)
1174             {
1175                 C2F(int2db) (&mn, istk(*lac), &cx1, stk(*lc), &cx1);
1176             }
1177             *lar = *lr;
1178             *lac = *lc;
1179             *lr = iadr(*lr);
1180             *lc = *lr + *m **n;
1181             break;
1182         default:
1183             Scierror(999, _("%s: (%s) bad third argument!\n"), fname, "createlistcvar");
1184             return FALSE;
1185     }
1186     return TRUE;
1187 }
1188
1189 /*---------------------------------------------------------------------
1190 *     This function must be called after createvar(lnumber,'l',...)
1191 *     Argument lnumber is a list
1192 *     we want here to get its argument number number
1193 *     the argument must be of type type ('c','d','r','i','b')
1194 *     input values lnumber,number,type,lar
1195 *     lar : input value ( -1 or the adress of an object which is used
1196 *           to fill the new variable data slot.
1197 *     lar must be a variable since it is used as input and output
1198 *     return values m,n,lr,lar
1199 *         (lar --> data is coded at stk(lar)
1200 *          lr  --> data is coded at istk(lr) or stk(lr) or sstk(lr)
1201 *                  or cstk(lr)
1202 *     c : string  (m-> number of characters and n->1)
1203 *     d,r,i : matrix of double,float or integer
1204 *---------------------------------------------------------------------*/
1205
1206 int C2F(createlistvarfromptr) (int *lnumber, int *number, char *typex, int *m, int *n, void *iptr, unsigned long type_len)
1207 {
1208     unsigned Type = *typex;
1209     int lc, ix1, it = 0, lr, inc = 1;
1210     char *fname = Get_Iname();
1211
1212     if (*lnumber > intersiz)
1213     {
1214         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createlistvarfromptr");
1215         return FALSE;
1216     }
1217
1218     ix1 = *lnumber + Top - Rhs; /* factorization of this term (Bruno 9 march 2005, bugfix ) */
1219     switch (Type)
1220     {
1221         case 'c':
1222             *n = 1;
1223             if (!C2F(listcrestring) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, &lr, nlgh))
1224             {
1225                 return FALSE;
1226             }
1227             C2F(cchar) (m, (char **)iptr, istk(lr));
1228             break;
1229         case 'd':
1230             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, &lr, &lc, nlgh))
1231             {
1232                 return FALSE;
1233             }
1234             ix1 = (*m) * (*n);
1235             C2F(cdouble) (&ix1, (double **)iptr, stk(lr));
1236             break;
1237         case 'r':
1238             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, &lr, &lc, nlgh))
1239             {
1240                 return FALSE;
1241             }
1242             ix1 = (*m) * (*n);
1243             C2F(cfloat) (&ix1, (float **)iptr, stk(lr));
1244             break;
1245         case 'i':
1246             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, &lr, &lc, nlgh))
1247             {
1248                 return FALSE;
1249             }
1250             ix1 = *m **n;
1251             C2F(cint) (&ix1, (int **)iptr, stk(lr));
1252             break;
1253         case 'b':
1254             if (!C2F(listcrebmat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, n, &lr, nlgh))
1255             {
1256                 return FALSE;
1257             }
1258             ix1 = *m **n;
1259             C2F(cbool) (&ix1, (int **)iptr, istk(lr));
1260             break;
1261         case 'S':
1262             if (!cre_listsmat_from_str(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, n, (char **)iptr, nlgh))   /* XXX */
1263             {
1264                 return FALSE;
1265             }
1266             break;
1267         case 's':
1268             if (!cre_listsparse_from_ptr(fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], m, n, (SciSparse *) iptr, nlgh))
1269             {
1270                 return FALSE;
1271             }
1272             break;
1273         case 'I':
1274             it = ((SciIntMat *) iptr)->it;
1275             if (!C2F(listcreimat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &it, m, n, &lr, nlgh))
1276             {
1277                 return FALSE;
1278             }
1279             ix1 = (*m) * (*n);
1280             C2F(tpconv) (&it, &it, &ix1, ((SciIntMat *) iptr)->D, &inc, istk(lr), &inc);
1281             break;
1282         case 'p':
1283             if (!C2F(listcrepointer) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], &lr, nlgh))
1284             {
1285                 return FALSE;
1286             }
1287             *stk(lr) = (double)((unsigned long int)iptr);
1288             break;
1289         default:
1290             Scierror(999, _("%s: (%s) bad third argument!\n"), fname, "createlistcvar");
1291             return FALSE;
1292             break;
1293     }
1294     return TRUE;
1295 }
1296
1297 /*---------------------------------------------------------------------
1298 *     This function must be called after createvar(lnumber,'l',...)
1299 *     Argument lnumber is a list
1300 *     we want here to get its argument number number
1301 *     the argument must be of type type ('c','d','r','i','b')
1302 *     input values lnumber,number,type,lar
1303 *     lar : input value ( -1 or the adress of an object which is used
1304 *           to fill the new variable data slot.
1305 *     lar must be a variable since it is used as input and output
1306 *     return values m,n,lr,lar
1307 *         (lar --> data is coded at stk(lar)
1308 *          lr  --> data is coded at istk(lr) or stk(lr) or sstk(lr)
1309 *                  or cstk(lr)
1310 *     c : string  (m-> number of characters and n->1)
1311 *     d,r,i : matrix of double,float or integer
1312 *---------------------------------------------------------------------*/
1313
1314 int C2F(createlistcvarfromptr) (int *lnumber, int *number, char *typex, int *it, int *m, int *n, void *iptr, void *iptc, unsigned long type_len)
1315 {
1316     unsigned Type = *typex;
1317     int lr, lc, ix1;
1318     char *fname = Get_Iname();
1319
1320     if (*lnumber > intersiz)
1321     {
1322         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createlistvarfromptr");
1323         return FALSE;
1324     }
1325     switch (Type)
1326     {
1327         case 'd':
1328             ix1 = *lnumber + Top - Rhs;
1329             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, &lr, &lc, nlgh))
1330             {
1331                 return FALSE;
1332             }
1333             ix1 = (*m) * (*n);
1334             C2F(cdouble) (&ix1, (double **)iptr, stk(lr));
1335             if (*it == 1)
1336             {
1337                 C2F(cdouble) (&ix1, (double **)iptc, stk(lc));
1338             }
1339             break;
1340         case 'r':
1341             ix1 = *lnumber + Top - Rhs;
1342             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, &lr, &lc, nlgh))
1343             {
1344                 return FALSE;
1345             }
1346             ix1 = (*m) * (*n);
1347             C2F(cfloat) (&ix1, (float **)iptr, stk(lr));
1348             if (*it == 1)
1349             {
1350                 C2F(cfloat) (&ix1, (float **)iptc, stk(lc));
1351             }
1352             break;
1353         case 'i':
1354             ix1 = *lnumber + Top - Rhs;
1355             if (!C2F(listcremat) (fname, &ix1, number, &C2F(intersci).lad[*lnumber - 1], it, m, n, &lr, &lc, nlgh))
1356             {
1357                 return FALSE;
1358             }
1359             ix1 = *m **n;
1360             C2F(cint) (&ix1, (int **)iptr, stk(lr));
1361             if (*it == 1)
1362             {
1363                 C2F(cint) (&ix1, (int **)iptc, stk(lc));
1364             }
1365             break;
1366         default:
1367             Scierror(999, _("%s: (%s) bad third argument!\n"), fname, "createlistcvarfromptr");
1368             return FALSE;
1369             break;
1370     }
1371     return TRUE;
1372 }
1373
1374 /*---------------------------------------------------------------------
1375 * use the rest of the stack as working area
1376 * the allowed size (in double) is returned in m
1377 *---------------------------------------------------------------------*/
1378
1379 int C2F(creatework) (int *number, int *m, int *lr)
1380 {
1381     int n, it = 0, lw1, lcs, il;
1382     char *fname = Get_Iname();
1383
1384     if (*number > intersiz)
1385     {
1386
1387         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "creatework");
1388         return FALSE;
1389     }
1390     Nbvars = Max(*number, Nbvars);
1391     lw1 = *number + Top - Rhs;
1392     if (lw1 < 0)
1393     {
1394         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "creatework");
1395         return FALSE;
1396     }
1397     il = iadr(*Lstk(lw1));
1398     *m = *Lstk(Bot) - sadr(il + 4);
1399     n = 1;
1400     if (!C2F(cremat) (fname, &lw1, &it, m, &n, lr, &lcs, nlgh))
1401     {
1402         return FALSE;
1403     }
1404     return TRUE;
1405 }
1406
1407 /*---------------------------------------------------------------------
1408 * This can be used with creatework to
1409 * set the size of object which was intialy sized to the whole
1410 * remaining space with creatework
1411 * Moreover information the objet is recorded
1412 *---------------------------------------------------------------------*/
1413
1414 int C2F(setworksize) (int *number, int *size)
1415 {
1416     int lw1;
1417     char *fname = Get_Iname();
1418
1419     if (*number > intersiz)
1420     {
1421         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "creatework");
1422         return FALSE;
1423     }
1424     Nbvars = Max(*number, Nbvars);
1425     lw1 = *number + Top - Rhs;
1426     if (lw1 < 0)
1427     {
1428         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "setworksize");
1429         return FALSE;
1430     }
1431     *Lstk(lw1 + 1) = *Lstk(lw1) + *size;
1432     C2F(intersci).ntypes[*number - 1] = '$';
1433     C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
1434     C2F(intersci).lad[*number - 1] = 0; /* not to be used XXXX */
1435     return TRUE;
1436 }
1437
1438 /*---------------------------------------------------------------------
1439 * getmatdims :
1440 *     check if argument number <<number>> is a matrix and
1441 *     returns its dimensions
1442 *---------------------------------------------------------------------*/
1443
1444 int C2F(getmatdims) (int *number, int *m, int *n)
1445 {
1446     char *fname = Get_Iname();
1447     int il, lw, typ;
1448
1449     lw = *number + Top - Rhs;
1450     if (*number > Rhs)
1451     {
1452         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "getmatdims");
1453         return FALSE;
1454     }
1455
1456     il = iadr(*Lstk(lw));
1457     if (*istk(il) < 0)
1458     {
1459         il = iadr(*istk(il + 1));
1460     }
1461     typ = *istk(il);
1462     if (typ > sci_strings)
1463     {
1464         Scierror(199, _("%s: Wrong type for argument #%d: Matrix expected.\n"), fname, *number);
1465         return FALSE;
1466     }
1467     *m = *istk(il + 1);
1468     *n = *istk(il + 2);
1469     return TRUE;
1470 }
1471
1472 /*---------------------------------------------------------------------
1473 * getrhsvar :
1474 *     get the argument number <<number>>
1475 *     the argument must be of type type ('c','d','r','i','f','l','b')
1476 *     return values m,n,lr
1477 *     c : string  (m-> number of characters and n->1)
1478 *     d,r,i : matrix of double,float or integer
1479 *     f : external (function)
1480 *     b : boolean matrix
1481 *     l : a list  (m-> number of elements and n->1)
1482 *         for each element of the list an other function
1483 *         must be used to <<get>> them
1484 *     side effects : arguments in the common intersci are modified
1485 *     see examples in addinter-examples
1486 *---------------------------------------------------------------------*/
1487
1488 int C2F(getrhsvar) (int *number, char *typex, int *m, int *n, int *lr, unsigned long type_len)
1489 {
1490     int ierr = 0, il1 = 0, ild1 = 0, nn = 0;
1491     int lrr = 0;
1492     char *fname = Get_Iname();
1493     char **items = NULL, namex[nlgh + 1];
1494     unsigned char Type = *(unsigned char *)typex;
1495     int topk = 0, ltype = 0, m1 = 0, n1 = 0, lc = 0, lr1 = 0, it = 0, lw = 0, ile = 0, ils = 0, ix1 = 0, ix2 = 0;
1496     int mnel = 0, icol = 0;
1497     SciSparse *Sp = NULL;
1498     SciIntMat *Im = NULL;
1499
1500     /* we accept a call to getrhsvar after a createvarfromptr call */
1501     if (*number > Rhs && *number > Nbvars)
1502     {
1503         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "getrhsvar");
1504         return FALSE;
1505     }
1506
1507     Nbvars = Max(Nbvars, *number);
1508     lw = *number + Top - Rhs;
1509
1510     if (*number > intersiz)
1511     {
1512         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "getrhsvar");
1513         return FALSE;
1514     }
1515
1516     if (overloadtype(&lw, fname, &Type) == 0)
1517     {
1518         return FALSE;
1519     }
1520
1521     topk = Top;
1522     switch (Type)
1523     {
1524         case 'c':
1525             *n = 1;
1526             if (!C2F(getsmat) (fname, &topk, &lw, &m1, &n1, &cx1, &cx1, lr, m, nlgh))
1527             {
1528                 return FALSE;
1529             }
1530
1531             if ((m1 != 1) || (n1 != 1))
1532             {
1533                 /* bug 8768 check dimensions */
1534                 Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), fname, *number);
1535                 return FALSE;
1536             }
1537
1538             ix2 = *m **n;
1539             /* in case where ix2 is 0 in2str adds the \0 char after the end of
1540              * the storage of the variable, so it writes over the next variable
1541              * tp avoid this pb we shift up by one the location where the
1542              * data is written */
1543             lrr = *lr;
1544             if (ix2 == 0)
1545             {
1546                 lrr--;
1547             }
1548
1549             C2F(in2str) (&ix2, istk(*lr), cstk(cadr(*lr)), ix2 + 1);
1550             *lr = cadr(*lr);
1551             C2F(intersci).ntypes[*number - 1] = Type;
1552             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1553             C2F(intersci).lad[*number - 1] = *lr;
1554             break;
1555
1556         case 'd':
1557             if (!C2F(getmat) (fname, &topk, &lw, &it, m, n, lr, &lc, nlgh))
1558             {
1559                 return FALSE;
1560             }
1561             C2F(intersci).ntypes[*number - 1] = Type;
1562             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1563             C2F(intersci).lad[*number - 1] = *lr;
1564             break;
1565         case 'z':
1566             if (!C2F(getmat) (fname, &topk, &lw, &it, m, n, lr, &lc, nlgh))
1567             {
1568                 return FALSE;
1569             }
1570             ix2 = *m **n;
1571             if ((it != 1) && (ix2 != 0))
1572             {
1573                 Scierror(999, _("%s: Wrong type for argument: Complex expected.\n"), fname);
1574                 return FALSE;
1575             };
1576             if (!(*lr % 2))
1577             {
1578                 /* bad adress (lr is even) shift up the stack */
1579                 double2z(stk(*lr), stk(*lr) - 1, ix2, ix2);
1580                 *istk(iadr(*lr) - 4) = 133;
1581                 *istk(iadr(*lr) - 3) = iadr(*lr + 2 * ix2 - 1);
1582                 *istk(iadr(*lr + 2 * ix2 - 1)) = *m;
1583                 *istk(iadr(*lr + 2 * ix2 - 1) + 1) = *n;
1584                 C2F(intersci).ntypes[*number - 1] = Type;
1585                 C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1586                 C2F(intersci).lad[*number - 1] = *lr - 1;
1587                 *lr = sadr(*lr - 1);
1588             }
1589             else
1590             {
1591                 SciToF77(stk(*lr), ix2, ix2);
1592                 C2F(intersci).ntypes[*number - 1] = Type;
1593                 C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1594                 C2F(intersci).lad[*number - 1] = *lr;
1595                 *lr = sadr(*lr);
1596             };
1597             break;
1598         case 'r':
1599             if (!C2F(getmat) (fname, &topk, &lw, &it, m, n, lr, &lc, nlgh))
1600             {
1601                 return FALSE;
1602             }
1603             ix1 = *m **n;
1604             C2F(simple) (&ix1, stk(*lr), sstk(iadr(*lr)));
1605             *lr = iadr(*lr);
1606             C2F(intersci).ntypes[*number - 1] = Type;
1607             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1608             C2F(intersci).lad[*number - 1] = *lr;
1609             break;
1610         case 'i':
1611             if (!C2F(getmat) (fname, &topk, &lw, &it, m, n, lr, &lc, nlgh))
1612             {
1613                 return FALSE;
1614             }
1615             ix1 = *m **n;
1616             C2F(entier) (&ix1, stk(*lr), istk(iadr(*lr)));
1617             *lr = iadr(*lr);
1618             C2F(intersci).ntypes[*number - 1] = Type;
1619             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1620             C2F(intersci).lad[*number - 1] = *lr;
1621             break;
1622         case 'b':
1623             if (!C2F(getbmat) (fname, &topk, &lw, m, n, lr, nlgh))
1624             {
1625                 return FALSE;
1626             }
1627             C2F(intersci).ntypes[*number - 1] = Type;
1628             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1629             C2F(intersci).lad[*number - 1] = *lr;
1630             break;
1631         case 'l':
1632         case 't':
1633         case 'm':
1634             *n = 1;
1635             if (!C2F(getilist) (fname, &topk, &lw, m, n, lr, nlgh))
1636             {
1637                 return FALSE;
1638             }
1639             /* No data conversion for list members ichar(type)='$' */
1640             Type = '$';
1641             C2F(intersci).ntypes[*number - 1] = Type;
1642             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1643             C2F(intersci).lad[*number - 1] = *lr;
1644             break;
1645         case 'S':
1646             /** getwsmat : must be back in stack1.c from xawelm.f */
1647             if (!C2F(getwsmat) (fname, &topk, &lw, m, n, &il1, &ild1, nlgh))
1648             {
1649                 return FALSE;
1650             }
1651             nn = (*m) * (*n);
1652             ScilabMStr2CM(istk(il1), &nn, istk(ild1), &items, &ierr);
1653             if (ierr == 1)
1654             {
1655                 return FALSE;
1656             }
1657             Type = '$';
1658             /*
1659              * Warning : lr must have the proper size when calling getrhsvar
1660              * char **Str1; .... GetRhsVar(...., &lr)
1661              */
1662             *((char ***)lr) = items;
1663             C2F(intersci).ntypes[*number - 1] = Type;
1664             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1665             C2F(intersci).lad[*number - 1] = *lr;
1666             break;
1667         case 's':
1668             /* sparse matrices */
1669             Sp = (SciSparse *) lr;
1670             if (!C2F(getsparse) (fname, &topk, &lw, &it, m, n, &(Sp->nel), &mnel, &icol, &lr1, &lc, nlgh))
1671             {
1672                 return FALSE;
1673             }
1674             Sp->m = *m;
1675             Sp->n = *n;
1676             Sp->it = it;
1677             Sp->mnel = istk(mnel);
1678             Sp->icol = istk(icol);
1679             Sp->R = stk(lr1);
1680             Sp->I = (it == 1) ? stk(lc) : NULL;
1681             Type = '$';
1682             C2F(intersci).ntypes[*number - 1] = Type;
1683             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1684             C2F(intersci).lad[*number - 1] = *lr;
1685             break;
1686         case 'I':
1687             /* int matrices */
1688             Im = (SciIntMat *) lr;
1689             if (!C2F(getimat) (fname, &topk, &lw, &it, m, n, &lr1, nlgh))
1690             {
1691                 return FALSE;
1692             }
1693             Im->m = *m;
1694             Im->n = *n;
1695             Im->it = it;
1696             Im->l = lr1;
1697             Im->D = istk(lr1);
1698             Type = '$';
1699             C2F(intersci).ntypes[*number - 1] = Type;
1700             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1701             C2F(intersci).lad[*number - 1] = *lr;
1702             break;
1703         case 'f':
1704             /* XXXXXX : gros bug ici car getexternal a besoin de savoir
1705              * pour quelle fonction on recupere un external
1706              * or ici on presuppose que c'est setfeval
1707              * de plus on ne sait pas exactement de quel type d'external il s'agit
1708              */
1709
1710             /*      int function getrhsvar(number,type,m,n,lr) */
1711             *lr = *Lstk(lw);
1712             ils = iadr(*lr) + 1;
1713             *m = *istk(ils);
1714             ile = ils + *m * nsiz + 1;
1715             *n = *istk(ile);
1716             if (!C2F(getexternal) (fname, &topk, &lw, namex, &ltype, C2F(setfeval), nlgh, nlgh))
1717             {
1718                 return FALSE;
1719             }
1720             Type = '$';
1721             C2F(intersci).ntypes[*number - 1] = Type;
1722             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1723             C2F(intersci).lad[*number - 1] = *lr;
1724             break;
1725         case 'p':
1726             if (!C2F(getpointer) (fname, &topk, &lw, lr, nlgh))
1727             {
1728                 return FALSE;
1729             }
1730             C2F(intersci).ntypes[*number - 1] = Type;
1731             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1732             C2F(intersci).lad[*number - 1] = *lr;
1733             break;
1734         case 'h':
1735             if (!C2F(gethmat) (fname, &topk, &lw, m, n, lr, nlgh))
1736             {
1737                 return FALSE;
1738             }
1739             C2F(intersci).ntypes[*number - 1] = Type;
1740             C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1741             C2F(intersci).lad[*number - 1] = *lr;
1742             break;
1743     }
1744     return TRUE;
1745 }
1746
1747 /*---------------------------------------------------------------------
1748 * getrhsvcar :
1749 *     get the argument number <<number>>
1750 *     the argument must be of type type ('d','r','i')
1751 *     like getrhsvar but for complex matrices
1752 *---------------------------------------------------------------------*/
1753
1754 int C2F(getrhscvar) (int *number, char *typex, int *it, int *m, int *n, int *lr, int *lc, unsigned long type_len)
1755 {
1756     int ix1, lw, topk;
1757     unsigned char Type = *typex;
1758     char *fname = Get_Iname();
1759
1760     Nbvars = Max(Nbvars, *number);
1761     lw = *number + Top - Rhs;
1762     if (*number > Rhs)
1763     {
1764         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "getrhscvar");
1765         return FALSE;
1766     }
1767     if (*number > intersiz)
1768     {
1769         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "getrhscvar");
1770         return FALSE;
1771     }
1772     topk = Top;
1773     switch (Type)
1774     {
1775         case 'd':
1776             if (!C2F(getmat) (fname, &topk, &lw, it, m, n, lr, lc, nlgh))
1777             {
1778                 return FALSE;
1779             }
1780             break;
1781         case 'r':
1782             if (!C2F(getmat) (fname, &topk, &lw, it, m, n, lr, lc, nlgh))
1783             {
1784                 return FALSE;
1785             }
1786             ix1 = *m **n * (*it + 1);
1787             C2F(simple) (&ix1, stk(*lr), sstk(iadr(*lr)));
1788             *lr = iadr(*lr);
1789             *lc = *lr + *m **n;
1790             break;
1791         case 'i':
1792             if (!C2F(getmat) (fname, &topk, &lw, it, m, n, lr, lc, nlgh))
1793             {
1794                 return FALSE;
1795             }
1796             ix1 = *m **n * (*it + 1);
1797             C2F(entier) (&ix1, stk(*lr), istk(iadr(*lr)));
1798             *lr = iadr(*lr);
1799             *lc = *lr + *m **n;
1800             break;
1801     }
1802     C2F(intersci).ntypes[*number - 1] = Type;
1803     C2F(intersci).iwhere[*number - 1] = *Lstk(lw);
1804     C2F(intersci).lad[*number - 1] = *lr;
1805     return TRUE;
1806 }
1807
1808 /*---------------------------------------------------------------------
1809 * elementtype:
1810 *   returns the type of the element indexed by *number in the list
1811 *   whose variable number is *lnumber. If the indexed element does not exist
1812 *   the function returns 0.
1813 *---------------------------------------------------------------------*/
1814
1815 int C2F(elementtype) (int *lnumber, int *number)
1816 {
1817     int il, lw, itype, n, ix, ili;
1818     char *fname = Get_Iname();
1819
1820     if (*lnumber > Rhs)
1821     {
1822         Scierror(999, _("%s: bad call to %s!\n"), fname, "elementtype");
1823         return FALSE;
1824     }
1825
1826     lw = *lnumber + Top - Rhs;  /*index of the variable numbered *lnumber in the stack */
1827     il = iadr(*Lstk(lw));
1828     if (*istk(il) < 0)
1829     {
1830         il = iadr(*istk(il + 1));
1831     }
1832     itype = *istk(il);          /* type of the variable numbered *lnumber */
1833     if (itype < sci_list || itype > sci_mlist)
1834     {
1835         /* check if it is really a list */
1836         Scierror(210, _("%s: Wrong type for argument #%d: List expected.\n"), fname, *lnumber);
1837         return FALSE;
1838     }
1839     n = *istk(il + 1);          /* number of elements in the list */
1840     itype = 0;                  /*default answer if *number is not a valid element index */
1841     if (*number <= n && *number > 0)
1842     {
1843         ix = sadr(il + 3 + n);  /* adress of the first list element */
1844         if (*istk(il + 1 + *number) < *istk(il + *number + 2))
1845         {
1846             /* the required element is defined */
1847             ili = iadr(ix + *istk(il + 1 + *number) - 1);   /* adress of the required element */
1848             itype = *istk(ili);
1849         }
1850     }
1851     return itype;
1852 }
1853
1854 /*---------------------------------------------------------------------
1855 *     This function must be called after getrhsvar(lnumber,'l',...)
1856 *     Argument lnumber is a list
1857 *     we want here to get its argument number number
1858 *     the argument must be of type type ('c','d','r','i','b')
1859 *     return values m,n,lr,lar
1860 *         (lar --> data is coded at stk(lar)
1861 *          lr  --> data is coded at istk(lr) or stk(lr) or sstk(lr)
1862 *                  or cstk(lr)
1863 *     c : string  (m-> number of characters and n->1)
1864 *     d,r,i : matrix of double,float or integer
1865 *---------------------------------------------------------------------*/
1866
1867 int C2F(getlistrhsvar) (int *lnumber, int *number, char *typex, int *m, int *n, int *lr, unsigned long type_len)
1868 {
1869     int lr1;
1870     char **items;
1871     int il1, ild1, nn, ierr = 0;
1872     char *fname = Get_Iname();
1873     int m1, n1, lc, it, lw, topk = Top, ix1, ix2;
1874     unsigned char Type = *typex;
1875     int mnel, icol;
1876     SciSparse *Sp;
1877     SciIntMat *Im;
1878
1879     Nbvars = Max(Nbvars, *lnumber);
1880     lw = *lnumber + Top - Rhs;
1881     if (*lnumber > Rhs)
1882     {
1883         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "getlistrhsvar");
1884         return FALSE;
1885     }
1886     if (*lnumber > intersiz)
1887     {
1888         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "getlistrhsvar");
1889         return FALSE;
1890     }
1891
1892     switch (Type)
1893     {
1894         case 'c':
1895             *n = 1;
1896             if (!C2F(getlistsimat) (fname, &topk, &lw, number, &m1, &n1, &cx1, &cx1, lr, m, nlgh))
1897             {
1898                 return FALSE;
1899             }
1900             ix2 = *m **n;
1901             C2F(in2str) (&ix2, istk(*lr), cstk(cadr(*lr)), ix2 + 1);
1902             *lr = cadr(*lr);
1903             break;
1904         case 'd':
1905             if (!C2F(getlistmat) (fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
1906             {
1907                 return FALSE;
1908             }
1909             break;
1910         case 'r':
1911             if (!C2F(getlistmat) (fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
1912             {
1913                 return FALSE;
1914             }
1915             ix1 = *m **n;
1916             C2F(simple) (&ix1, stk(*lr), sstk(iadr(*lr)));
1917             *lr = iadr(*lr);
1918             break;
1919         case 'i':
1920             if (!C2F(getlistmat) (fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
1921             {
1922                 return FALSE;
1923             }
1924             ix1 = *m **n;
1925             C2F(entier) (&ix1, stk(*lr), istk(iadr(*lr)));
1926             *lr = iadr(*lr);
1927             break;
1928         case 'b':
1929             if (!C2F(getlistbmat) (fname, &topk, &lw, number, m, n, lr, nlgh))
1930             {
1931                 return FALSE;
1932             }
1933             *lr = *lr;
1934             break;
1935         case 'z':
1936             if (!C2F(getlistmat) (fname, &topk, &lw, number, &it, m, n, lr, &lc, nlgh))
1937             {
1938                 return FALSE;
1939             }
1940             ix2 = *m **n;
1941             if ((it != 1) && (ix2 != 0))
1942             {
1943                 Scierror(999, _("%s: argument %d > (%d) should be a complex matrix.\n"), fname, Rhs + (lw - topk), *number);
1944                 return FALSE;
1945             };
1946             if (!(*lr % 2))
1947             {
1948                 /* bad adress (lr is even) shift up the stack */
1949                 double2z(stk(*lr), stk(*lr) - 1, ix2, ix2);
1950                 ix2 = 2 * ix2;
1951                 *istk(iadr(*lr) - 4) = 133;
1952                 *istk(iadr(*lr) - 3) = iadr(*lr + ix2);
1953                 *istk(iadr(*lr + ix2)) = *m;
1954                 *istk(iadr(*lr + ix2) + 1) = *n;
1955                 *lr = sadr(*lr - 1);
1956             }
1957             else
1958             {
1959                 SciToF77(stk(*lr), ix2, ix2);
1960                 *lr = sadr(*lr);
1961             }
1962             break;
1963         case 'S':
1964             /** getwsmat : must be back in stack1.c from xawelm.f */
1965             if (!C2F(getlistwsmat) (fname, &topk, &lw, number, m, n, &il1, &ild1, nlgh))
1966             {
1967                 return FALSE;
1968             }
1969             nn = (*m) * (*n);
1970             ScilabMStr2CM(istk(il1), &nn, istk(ild1), &items, &ierr);
1971             if (ierr == 1)
1972             {
1973                 return FALSE;
1974             }
1975             /*
1976              * Warning : lr must have the proper size when calling getrhsvar
1977              * char **Str1; .... GetRhsVar(...., &lr)
1978              */
1979             *((char ***)lr) = items;
1980             break;
1981         case 's':
1982             /* sparse matrices */
1983             Sp = (SciSparse *) lr;
1984             if (!C2F(getlistsparse) (fname, &topk, &lw, number, &it, m, n, &(Sp->nel), &mnel, &icol, &lr1, &lc, nlgh))
1985             {
1986                 return FALSE;
1987             }
1988             Sp->m = *m;
1989             Sp->n = *n;
1990             Sp->it = it;
1991             Sp->mnel = istk(mnel);
1992             Sp->icol = istk(icol);
1993             Sp->R = stk(lr1);
1994             Sp->I = stk(lc);
1995             break;
1996         case 'I':
1997             /* int matrices */
1998             Im = (SciIntMat *) lr;
1999             if (!C2F(getlistimat) (fname, &topk, &lw, number, &it, m, n, &lr1, nlgh))
2000             {
2001                 return FALSE;
2002             }
2003             Im->m = *m;
2004             Im->n = *n;
2005             Im->it = it;
2006             Im->l = lr1;
2007             Im->D = istk(lr1);
2008             break;
2009         case 'p':
2010             if (!C2F(getlistpointer) (fname, &topk, &lw, number, lr, nlgh))
2011             {
2012                 return FALSE;
2013             }
2014             break;
2015         default:
2016             Scierror(999, _("%s: bad call to %s (third argument %c).\n"), fname, "getlistrhsvar", Type);
2017             return FALSE;
2018     }
2019     /* can't perform back data conversion with lists */
2020     C2F(intersci).ntypes[*number - 1] = '$';
2021     return TRUE;
2022 }
2023
2024 /*---------------------------------------------------------------------
2025 * for complex
2026 *---------------------------------------------------------------------*/
2027
2028 int C2F(getlistrhscvar) (int *lnumber, int *number, char *typex, int *it, int *m, int *n, int *lr, int *lc, unsigned long type_len)
2029 {
2030     int ix1, topk = Top, lw;
2031     char *fname = Get_Iname();
2032     unsigned char Type = *typex;
2033
2034     Nbvars = Max(Nbvars, *lnumber);
2035     lw = *lnumber + Top - Rhs;
2036     if (*lnumber > Rhs)
2037     {
2038         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "getlistrhscvar");
2039         return FALSE;
2040     }
2041     if (*lnumber > intersiz)
2042     {
2043         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "getlistrhscvar");
2044         return FALSE;
2045     }
2046     switch (Type)
2047     {
2048         case 'd':
2049             if (!C2F(getlistmat) (fname, &topk, &lw, number, it, m, n, lr, lc, nlgh))
2050             {
2051                 return FALSE;
2052             }
2053             break;
2054         case 'r':
2055             if (!C2F(getlistmat) (fname, &topk, &lw, number, it, m, n, lr, lc, nlgh))
2056             {
2057                 return FALSE;
2058             }
2059             ix1 = *m **n * (*it + 1);
2060             C2F(simple) (&ix1, stk(*lr), sstk(iadr(*lr)));
2061             *lr = iadr(*lr);
2062             *lc = *lr + *m **n;
2063             break;
2064         case 'i':
2065             if (!C2F(getlistmat) (fname, &topk, &lw, number, it, m, n, lr, lc, nlgh))
2066             {
2067                 return FALSE;
2068             }
2069             ix1 = *m **n * (*it + 1);
2070             C2F(entier) (&ix1, stk(*lr), istk(iadr(*lr)));
2071             *lr = iadr(*lr);
2072             *lc = *lr + *m **n;
2073             break;
2074         default:
2075             Scierror(999, _("%s: (%s) bad third argument!\n"), fname, "getlistrhscvar");
2076
2077             return FALSE;
2078     }
2079     /* can't perform back data conversion with lists */
2080     C2F(intersci).ntypes[*number - 1] = '$';
2081     return TRUE;
2082 }
2083
2084 /*---------------------------------------------------------------------
2085 *     creates variable number number of type "type" and dims m,n
2086 *     from pointer ptr
2087 *
2088 *---------------------------------------------------------------------*/
2089
2090 int C2F(createvarfromptr) (int *number, char *typex, int *m, int *n, void *iptr, unsigned long type_len)
2091 {
2092     static int un = 1;
2093     unsigned char Type = *typex;
2094     int MN = (*m) * (*n), lr, it, lw1;
2095     char *fname = Get_Iname();
2096
2097     lw1 = *number + Top - Rhs;
2098     switch (Type)
2099     {
2100         case 'd':
2101             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2102             {
2103                 return FALSE;
2104             }
2105             C2F(dcopy) (&MN, *((double **)iptr), &un, stk(lr), &un);
2106             break;
2107         case 'i':
2108         case 'b':
2109             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2110             {
2111                 return FALSE;
2112             }
2113             C2F(icopy) (&MN, *((int **)iptr), &un, istk(lr), &un);
2114             break;
2115         case 'r':
2116             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2117             {
2118                 return FALSE;
2119             }
2120             C2F(rcopy) (&MN, *((float **)iptr), &un, sstk(lr), &un);
2121             break;
2122         case 'c':
2123             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2124             {
2125                 return FALSE;
2126             }
2127             strcpy(cstk(lr), *((char **)iptr));
2128             break;
2129         case 'I':
2130             /* on entry lr must gives the int type */
2131             it = lr = ((SciIntMat *) iptr)->it;
2132             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2133             {
2134                 return FALSE;
2135             }
2136             C2F(tpconv) (&it, &it, &MN, ((SciIntMat *) iptr)->D, &un, istk(lr), &un);
2137             break;
2138         case 'p':
2139             if (C2F(createvar) (number, typex, m, n, &lr, type_len) == FALSE)
2140             {
2141                 return FALSE;
2142             }
2143             *stk(lr) = (double)((unsigned long int)iptr);
2144             break;
2145         case 'S':
2146             /* special case: not taken into account in createvar */
2147             Nbvars = Max(*number, Nbvars);
2148             if (!cre_smat_from_str(fname, &lw1, m, n, (char **)iptr, nlgh))
2149             {
2150                 return FALSE;
2151             }
2152             C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
2153             C2F(intersci).ntypes[*number - 1] = '$';
2154             break;
2155         case 's':
2156             /* special case: not taken into account in createvar */
2157             Nbvars = Max(*number, Nbvars);
2158             if (!cre_sparse_from_ptr(fname, &lw1, m, n, (SciSparse *) iptr, nlgh))
2159             {
2160                 return FALSE;
2161             }
2162             C2F(intersci).iwhere[*number - 1] = *Lstk(lw1);
2163             C2F(intersci).ntypes[*number - 1] = '$';
2164             break;
2165         default:
2166             Scierror(999, _("%s: (%s) bad second argument!\n"), fname, "createvarfromptr");
2167
2168             return FALSE;
2169     }
2170     /*     this object will be copied with a vcopyobj in putlhsvar */
2171     return TRUE;
2172 }
2173
2174 /*---------------------------------------------------------------------
2175 *     for complex
2176 *---------------------------------------------------------------------*/
2177
2178 int C2F(createcvarfromptr) (int *number, char *typex, int *it, int *m, int *n, double *iptr, double *iptc, unsigned long type_len)
2179 {
2180     unsigned char Type = *typex;
2181     char *fname = Get_Iname();
2182     int lw1, lcs, lrs, ix1;
2183
2184     Nbvars = Max(Nbvars, *number);
2185     if (*number > intersiz)
2186     {
2187         Scierror(999, _("%s: createcvarfromptr: too many arguments on the stack, enlarge intersiz.\n"), fname);
2188         return FALSE;
2189     }
2190     lw1 = *number + Top - Rhs;
2191     switch (Type)
2192     {
2193         case 'd':
2194             if (!C2F(cremat) (fname, &lw1, it, m, n, &lrs, &lcs, nlgh))
2195             {
2196                 return FALSE;
2197             }
2198             ix1 = *m **n;
2199             C2F(cdouble) (&ix1, (double **)iptr, stk(lrs));
2200             if (*it == 1)
2201             {
2202                 ix1 = *m **n;
2203                 C2F(cdouble) (&ix1, (double **)iptc, stk(lcs));
2204             }
2205             break;
2206         case 'i':
2207             if (!C2F(cremat) (fname, &lw1, it, m, n, &lrs, &lcs, nlgh))
2208             {
2209                 return FALSE;
2210             }
2211             ix1 = *m **n;
2212             C2F(cint) (&ix1, (int **)iptr, stk(lrs));
2213             if (*it == 1)
2214             {
2215                 ix1 = *m **n;
2216                 C2F(cint) (&ix1, (int **)iptc, stk(lcs));
2217             }
2218             break;
2219         default:
2220             Scierror(999, _("%s: (%s) bad second argument!\n"), fname, "createcvarfromptr");
2221
2222             return FALSE;
2223     }
2224     /*     this object will be copied with a vcopyobj in putlhsvar */
2225     C2F(intersci).ntypes[*number - 1] = '$';
2226     return TRUE;
2227 }
2228
2229 /*---------------------------------------------------------------------
2230 * mklistfromvars :
2231 *     replace the last n variables created at postions pos:pos-1+n
2232 *     by a list of these variables at position pos
2233 *---------------------------------------------------------------------*/
2234
2235 int C2F(mklistfromvars) (int *pos, int *n)
2236 {
2237     int tops = Top;
2238     int k;
2239
2240     for (k = *pos; k < *pos + *n; k++)
2241     {
2242         C2F(convert2sci) (&k);
2243     }
2244     Top = Top - Rhs + *pos - 1 + *n;
2245     C2F(mklist) (n);
2246     Top = tops;
2247     C2F(intersci).ntypes[*pos - 1] = '$';
2248     return TRUE;
2249 }
2250
2251 /*---------------------------------------------------------------------
2252 * mktlistfromvars :
2253 *     similar to mklistfromvars but create a tlist
2254 *---------------------------------------------------------------------*/
2255
2256 int C2F(mktlistfromvars) (int *pos, int *n)
2257 {
2258     int type = 16;
2259     int tops = Top;
2260     int k;
2261
2262     for (k = *pos; k < *pos + *n; k++)
2263     {
2264         C2F(convert2sci) (&k);
2265     }
2266     Top = Top - Rhs + *pos - 1 + *n;
2267     C2F(mklistt) (n, &type);
2268     Top = tops;
2269     C2F(intersci).ntypes[*pos - 1] = '$';
2270     return TRUE;
2271 }
2272
2273 /*---------------------------------------------------------------------
2274 * mktlistfromvars :
2275 *     similar to mklistfromvars but create a mlist
2276 *---------------------------------------------------------------------*/
2277
2278 int C2F(mkmlistfromvars) (int *pos, int *n)
2279 {
2280     int type = sci_mlist;
2281     int tops = Top;
2282     int k;
2283
2284     for (k = *pos; k < *pos + *n; k++)
2285     {
2286         C2F(convert2sci) (&k);
2287     }
2288     Top = Top - Rhs + *pos - 1 + *n;
2289     C2F(mklistt) (n, &type);
2290     Top = tops;
2291     C2F(intersci).ntypes[*pos - 1] = '$';
2292     return TRUE;
2293 }
2294
2295 /*---------------------------------------------------------------------
2296 * call a Scilab function given its name
2297 *---------------------------------------------------------------------*/
2298
2299 int C2F(callscifun) (char *string, unsigned long string_len)
2300 {
2301     int id[nsiz];
2302
2303     C2F(cvname) (id, string, &cx0, string_len);
2304     C2F(putid) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], id);
2305     C2F(com).fun = -1;
2306     return 0;
2307 }
2308
2309 /*---------------------------------------------------------------------
2310 * scifunction(number,ptr,mlhs,mrhs) >
2311 *     execute scilab function with mrhs input args and mlhs output
2312 *     variables
2313 *     input args are supposed to be stored in the top of the stack
2314 *     at positions top-mrhs+1:top
2315 *---------------------------------------------------------------------*/
2316
2317 int C2F(scifunction) (int *number, int *ptr, int *mlhs, int *mrhs)
2318 {
2319     int cx26 = 26;
2320     int ix1, ix, k, intop, lw;
2321     int imode, ireftop;
2322
2323     if (intersci_push() == 0)
2324     {
2325         Scierror(999, _("%s: No more memory.\n"), "scifunction");
2326         goto L9999;
2327     }
2328
2329     /*     macro execution inside a builtin gateway */
2330     intop = Top;
2331     Top = Top - Rhs + *number + *mrhs - 1;
2332     ++C2F(recu).pt;
2333     if (C2F(recu).pt > psiz)
2334     {
2335         SciError(cx26);
2336         goto L9999;
2337     }
2338     C2F(recu).ids[C2F(recu).pt * nsiz - nsiz] = Lhs;
2339     C2F(recu).ids[C2F(recu).pt * nsiz - (nsiz - 1)] = Rhs;
2340     C2F(recu).rstk[C2F(recu).pt - 1] = 1001;
2341     Lhs = *mlhs;
2342     Rhs = *mrhs;
2343     ++C2F(recu).niv;
2344     C2F(com).fun = 0;
2345     C2F(com).fin = *ptr;
2346     C2F(recu).icall = 5;
2347     C2F(recu).krec = -1;
2348     /* ************************** copied from callinter.h */
2349 L60:
2350     C2F(parse) ();
2351     /* parse has exited for a built-in evaluation */
2352
2353     if (C2F(com).fun == 99)
2354     {
2355         if (Err > 0 || C2F(errgst).err1 > 0)
2356         {
2357             imode = abs(C2F(errgst).errct) / 100000 % 8;
2358             if (imode != 3)
2359             {
2360                 goto L97;
2361             }
2362         }
2363         C2F(com).fun = 0;
2364         goto L200;
2365     }
2366     if (Err > 0)
2367     {
2368         goto L97;
2369     }
2370
2371     if (isRecursionCallToFunction())
2372     {
2373         int gw = getRecursionGatewayToCall();
2374
2375         if (gw == END_OVERLOAD)
2376         {
2377             goto L96;
2378         }
2379         else if (gw == ERROR_GW_ID)
2380         {
2381             goto L89;
2382         }
2383         else
2384         {
2385             k = gw;
2386         }
2387         goto L95;
2388     }
2389     if (isRecursionCallToFunction())
2390     {
2391         int gw = getRecursionGatewayToCall();
2392
2393         if (gw == END_OVERLOAD)
2394         {
2395             goto L96;
2396         }
2397         else if (gw == ERROR_GW_ID)
2398         {
2399             goto L89;
2400         }
2401         else
2402         {
2403             k = gw;
2404         }
2405         goto L95;
2406     }
2407
2408 L89:
2409     if (Top < Rhs)
2410     {
2411         Scierror(22, _("%s: Recursion problems. Sorry ...\n"), "scifunction");
2412         goto L97;
2413     }
2414     if (Top - Rhs + Lhs + 1 >= Bot)
2415     {
2416         Scierror(18, _("%s: Too many names.\n"), "scifunction");
2417         goto L97;
2418     }
2419     /*     ireftop used to reset top if an error occurs during
2420      * the function evaluation */
2421     ireftop = Top - Max(0, Rhs);
2422
2423     goto L91;
2424 L90:
2425     if (Err > 0)
2426     {
2427         goto L97;
2428     }
2429     /**/
2430 L91:
2431     k = C2F(com).fun;
2432     C2F(com).fun = 0;
2433     if (k == C2F(recu).krec)
2434     {
2435         Scierror(22, _("%s: Recursion problems. Sorry ...\n"), "scifunction");
2436         goto L97;
2437     }
2438     C2F(recu).krec = -1;
2439     if (k == 0)
2440     {
2441         goto L60;
2442     }
2443 L95:
2444     if (!C2F(allowptr) (&k))
2445     {
2446         C2F(ref2val) ();
2447     }
2448     C2F(recu).krec = k;
2449     C2F(callinterf) (&k);
2450
2451     C2F(recu).krec = -1;
2452     if (C2F(com).fun >= 0)
2453     {
2454         if (Top - Lhs + 1 > 0)
2455         {
2456             C2F(iset) (&Rhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
2457         }
2458         if (C2F(recu).paus > 0)
2459         {
2460             goto L91;
2461         }
2462         if (C2F(errgst).err1 > 0)
2463         {
2464             Top = ireftop;
2465         }
2466         goto L90;
2467     }
2468     /*    called interface ask for a scilab function to perform the function (fun=-1)
2469      *     the function name is given in ids(1,pt+1)
2470      */
2471     /*     call ref2val removed here because if forces overloading function to
2472      *     be called by value
2473      C2F(ref2val)();*/
2474     C2F(com).fun = 0;
2475     C2F(funs) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz]);
2476     if (Err > 0)
2477     {
2478         goto L97;
2479     }
2480
2481     if (C2F(com).fun > 0)
2482     {
2483         if (C2F(isbyref) (&C2F(com).fun) == 0)
2484         {
2485             C2F(ref2val) ();
2486         }
2487         goto L91;
2488     }
2489     if (Fin == 0)
2490     {
2491         SciError(246);
2492         if (Err > 0)
2493         {
2494             goto L97;
2495         }
2496         goto L90;
2497     }
2498     ++C2F(recu).pt;
2499     Fin = *Lstk(C2F(com).fin);
2500     C2F(recu).rstk[C2F(recu).pt - 1] = 910;
2501     C2F(recu).icall = 5;
2502     C2F(com).fun = 0;
2503     /*     *call*  macro */
2504     goto L60;
2505 L96:
2506     --C2F(recu).pt;
2507     goto L90;
2508
2509 L97:                           /* error handling */
2510     if ((C2F(recu).niv > 0) && (C2F(recu).paus > 0))
2511     {
2512         C2F(com).fun = 0;
2513         goto L60;
2514     }
2515     goto L9999;
2516     /* ************************** end of copy */
2517 L200:
2518     Lhs = C2F(recu).ids[C2F(recu).pt * nsiz - nsiz];
2519     Rhs = C2F(recu).ids[C2F(recu).pt * nsiz - (nsiz - 1)];
2520     --C2F(recu).pt;
2521     --C2F(recu).niv;
2522     /* + */
2523     Top = intop;
2524     ix1 = *mlhs;
2525     intersci_pop();
2526     for (ix = 1; ix <= ix1; ++ix)
2527     {
2528         lw = Top - Rhs + *number + ix - 1;
2529         C2F(intersci).ntypes[lw - 1] = '$';
2530     }
2531     return TRUE;
2532
2533 L9999:
2534     Top = intop;
2535     --C2F(recu).niv;
2536     if (C2F(errgst).err1 > 0)
2537     {
2538         Lhs = C2F(recu).ids[C2F(recu).pt * nsiz - nsiz];
2539         Rhs = C2F(recu).ids[C2F(recu).pt * nsiz - (nsiz - 1)];
2540         --C2F(recu).pt;
2541         C2F(com).fun = 0;
2542     }
2543     intersci_pop();
2544     return FALSE;
2545 }
2546
2547 /*---------------------------------------------------------------------
2548 * scistring :
2549 *   executes scilab string (name of a scilab function) with mrhs
2550 *     input args and mlhs output variables
2551 *     input args are supposed to be indexed by ifirst,ifirst+1,...
2552 *     thestring= string made of the name of a Scilab function
2553 *     mlhs,mlhs = number of lhs and rhs parameters of the function
2554 *     ifirst,thestring,mlhs and mrhs are input parameters.
2555 *---------------------------------------------------------------------*/
2556
2557 int C2F(scistring) (int *ifirst, char *thestring, int *mlhs, int *mrhs, unsigned long thestring_len)
2558 {
2559     int ret = FALSE;
2560     int ifin = 0, ifun = 0, tops = 0;
2561     int id[nsiz];
2562     int lf = 0, op = 0, ils = 0, nnn = thestring_len;
2563
2564     if (nnn <= 2)
2565     {
2566         op = C2F(getopcode) (thestring, thestring_len);
2567     }
2568
2569     if (op == 0)
2570     {
2571         C2F(cvname) (id, thestring, &cx0, nnn);
2572         Fin = 0;
2573         tops = Top;
2574         Top = Top - Rhs + *ifirst + *mrhs - 1;
2575         C2F(funs) (id);
2576         Top = tops;
2577
2578         if (Fin == 0)
2579         {
2580             Scierror(999, _("%s: %s is not a Scilab function.\n"), "scistring", get_fname(thestring, thestring_len));
2581             return ret;
2582         }
2583
2584         if (C2F(com).fun <= 0)
2585         {
2586             lf = *Lstk(Fin);
2587             ret = C2F(scifunction) (ifirst, &lf, mlhs, mrhs);
2588         }
2589         else
2590         {
2591             ifin = Fin;
2592             ifun = C2F(com).fun;
2593             ret = C2F(scibuiltin) (ifirst, &ifun, &ifin, mlhs, mrhs);
2594         }
2595     }
2596     else
2597     {
2598         ret = C2F(sciops) (ifirst, &op, mlhs, mrhs);
2599     }
2600     return ret;
2601 }
2602
2603 int C2F(getopcode) (char *string, unsigned long string_len)
2604 {
2605     unsigned char ch = string[0];
2606     int op = 0;
2607
2608     if (string_len >= 2)
2609     {
2610         /* .op  or op. */
2611         if (ch == '.')
2612         {
2613             ch = string[1];
2614         }
2615         op += 51;
2616     }
2617
2618     switch (ch)
2619     {
2620         case '*':
2621             op += 47;
2622             break;
2623         case '+':
2624             op += 45;
2625             break;
2626         case '-':
2627             op += 46;
2628             break;
2629         case '\'':
2630             op += 53;
2631             break;
2632         case '/':
2633             op += 48;
2634             break;
2635         case '\\':
2636             op += 49;
2637             break;
2638         case '^':
2639             op += 62;
2640             break;
2641         default:
2642             op = 0;
2643             break;
2644     }
2645     return op;
2646 }
2647
2648 /*---------------------------------------------------------------------
2649 *     same as scifunction: executes scilab built-in function (ifin,ifun)
2650 *
2651 *     =(interface-number, function-nmber-in-interface)
2652 *     for the input parameters located at number, number+1, ....
2653 *     mlhs,mrhs = # of lhs and rhs parameters of the function.
2654 *---------------------------------------------------------------------*/
2655
2656 int C2F(scibuiltin) (int *number, int *ifun, int *ifin, int *mlhs, int *mrhs)
2657 {
2658     int srhs = 0, slhs = 0;
2659     int ix = 0, k = 0, intop = 0, lw = 0, pt0 = C2F(recu).pt;
2660     int imode = 0, ireftop = 0;
2661
2662     intop = Top;
2663
2664     if (intersci_push() == 0)
2665     {
2666         Scierror(999, _("%s: No more memory.\n"), "scifunction");
2667         goto L9999;
2668     }
2669
2670     Top = Top - Rhs + *number + *mrhs - 1;
2671     slhs = Lhs;
2672     srhs = Rhs;
2673     Lhs = *mlhs;
2674     Rhs = *mrhs;
2675     C2F(recu).krec = -1;
2676     ++C2F(recu).niv;
2677     goto L90;
2678     /* ***************************** copied from callinter.h  */
2679
2680 L60:
2681     C2F(parse) ();
2682     if (C2F(com).fun == 99)
2683     {
2684         if (Err > 0 || C2F(errgst).err1 > 0)
2685         {
2686             imode = abs(C2F(errgst).errct) / 100000 % 8;
2687             if (imode != 3)
2688             {
2689                 goto L97;
2690             }
2691         }
2692         C2F(com).fun = 0;
2693         goto L200;
2694     }
2695     if (Err > 0)
2696     {
2697         goto L97;
2698     }
2699
2700     if (isRecursionCallToFunction())
2701     {
2702         int gw = getRecursionGatewayToCall();
2703
2704         if (gw == END_OVERLOAD)
2705         {
2706             goto L96;
2707         }
2708         else if (gw == ERROR_GW_ID)
2709         {
2710             goto L89;
2711         }
2712         else
2713         {
2714             k = gw;
2715         }
2716         goto L95;
2717     }
2718
2719 L89:
2720     if (Top < Rhs)
2721     {
2722         Scierror(22, _("%s: Recursion problems. Sorry ...\n"), _("built in"));
2723         goto L97;
2724     }
2725     if (Top - Rhs + Lhs + 1 >= Bot)
2726     {
2727         Scierror(18, _("%s: Too many names.\n"), "");
2728         goto L97;
2729     }
2730     /*     ireftop used to reset top if an error occurs during
2731      * the function evaluation */
2732     ireftop = Top - Max(0, Rhs);
2733
2734     goto L91;
2735 L90:
2736     if (Err > 0)
2737     {
2738         goto L97;
2739     }
2740     /**/
2741 L91:
2742     k = C2F(com).fun;
2743     C2F(com).fun = 0;
2744     if (k == C2F(recu).krec)
2745     {
2746         Scierror(22, _("%s: Recursion problems. Sorry ...\n"), _("built in"));
2747         goto L9999;
2748     }
2749     C2F(recu).krec = -1;
2750     if (k == 0)
2751     {
2752         goto L60;
2753         if (C2F(recu).pt > pt0)
2754         {
2755             goto L60;
2756         }
2757         // goto L60;
2758         goto L200;
2759     }
2760 L95:
2761     if (!C2F(allowptr) (&k))
2762     {
2763         C2F(ref2val) ();
2764     }
2765     C2F(recu).krec = k;
2766     C2F(callinterf) (&k);
2767     C2F(recu).krec = -1;
2768     if (C2F(com).fun >= 0)
2769     {
2770         if (Top - Lhs + 1 > 0)
2771         {
2772             C2F(iset) (&Lhs, &cx0, &C2F(vstk).infstk[Top - Lhs], &cx1);
2773         }
2774         if (C2F(recu).paus > 0)
2775         {
2776             goto L91;
2777         }
2778         if (C2F(errgst).err1 > 0)
2779         {
2780             Top = ireftop;
2781         }
2782         goto L90;
2783     }
2784     /*    called interface ask for a sci function to perform the function (fun=-1) */
2785     /*     the function name is given in ids(1,pt+1) */
2786     C2F(ref2val) ();
2787     C2F(com).fun = 0;
2788     C2F(funs) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz]);
2789     if (Err > 0)
2790     {
2791         goto L97;
2792     }
2793     if (C2F(com).fun > 0)
2794     {
2795         if (C2F(isbyref) (&C2F(com).fun) == 0)
2796         {
2797             C2F(ref2val) ();
2798         }
2799         goto L91;
2800     }
2801     if (Fin == 0)
2802     {
2803         SciError(246);
2804         if (Err > 0)
2805         {
2806             goto L97;
2807         }
2808         goto L90;
2809     }
2810     ++C2F(recu).pt;
2811     Fin = *Lstk(C2F(com).fin);
2812     C2F(recu).rstk[C2F(recu).pt - 1] = 910;
2813     C2F(recu).icall = 5;
2814     C2F(com).fun = 0;
2815     /*     *call*  macro */
2816     goto L60;
2817 L96:
2818     --C2F(recu).pt;
2819     goto L90;
2820
2821 L97:                           /* error handling */
2822     if ((C2F(recu).niv > 0) && (C2F(recu).paus > 0))
2823     {
2824         C2F(com).fun = 0;
2825         goto L60;
2826     }
2827     /* ************************** end of copy */
2828 L200:
2829     Lhs = slhs;
2830     Rhs = srhs;
2831     --C2F(recu).niv;
2832     Top = intop;
2833     intersci_pop();
2834     for (ix = 0; ix < *mlhs; ++ix)
2835     {
2836         lw = Top - Rhs + *number + ix;
2837         C2F(intersci).ntypes[lw - 1] = '$';
2838     }
2839     return TRUE;
2840 L9999:
2841     Top = intop;
2842     --C2F(recu).niv;
2843     intersci_pop();
2844     return FALSE;
2845 }
2846
2847 /*---------------------------------------------------------------------
2848 *     same as scibuiltin: executes scilab operation op
2849 *     for the input parameters located at number, number+1, ....
2850 *     mlhs,mrhs = # of lhs and rhs parameters of the operation.
2851 *---------------------------------------------------------------------*/
2852
2853 int C2F(sciops) (int *number, int *op, int *mlhs, int *mrhs)
2854 {
2855     int ifin, ifun, srhs = Rhs, slhs = Lhs, ix, intop = Top, lw;
2856
2857     Fin = *op;
2858     Top = Top - Rhs + *number + *mrhs - 1;
2859     Lhs = *mlhs;
2860     Rhs = *mrhs;
2861
2862     while (1)
2863     {
2864         C2F(allops) ();
2865         if (Err > 0)
2866         {
2867             return FALSE;
2868         };
2869         if (C2F(com).fun == 0)
2870         {
2871             break;
2872         }
2873         Top = intop;
2874         ifun = C2F(com).fun;
2875         ifin = Fin;
2876         if (!C2F(scibuiltin) (number, &ifun, &ifin, mlhs, mrhs))
2877         {
2878             return FALSE;
2879         };
2880         if (Err > 0)
2881         {
2882             return FALSE;
2883         };
2884     }
2885     Lhs = slhs;
2886     Rhs = srhs;
2887     Top = intop;
2888
2889     for (ix = 1; ix <= *mlhs; ++ix)
2890     {
2891         lw = Top - Rhs + *number + ix - 1;
2892         C2F(intersci).ntypes[lw - 1] = '$';
2893     }
2894     C2F(com).fun = 0;
2895     Fin = *op;
2896     C2F(recu).icall = 0;
2897     return TRUE;
2898 }
2899
2900 /*-------------------------------------------------------------
2901 *     test and return linear system (syslin tlist)
2902 *     inputs: lw = variable number
2903 *     outputs:
2904 *     N=size of A matrix (square)
2905 *     M=number of inputs = col. dim B matrix
2906 *     P=number of outputs = row. dim of C matrix
2907 *     ptr(A,B,C,D,X0) adresses of A,B,C,D,X0 in stk
2908 *     h=type   h=0.0  continuous system
2909 *              h=1.0  discrete time system
2910 *              h=h    sampled system h=sampling period
2911 -------------------------------------------------------------*/
2912
2913 int C2F(getrhssys) (int *lw, int *n, int *m, int *p, int *ptra, int *ptrb, int *ptrc, int *ptrd, int *ptrx0, double *hx)
2914 {
2915     int cx2 = 2, cx3 = 3, cx4 = 4, cx5 = 5, cx6 = 6;
2916     int ix1, junk, msys, nsys, ix, icord;
2917     int ma, na, mb, nb, mc, nc, il, md, nd;
2918     int mx0, nx0, ptrsys, itimedomain;
2919
2920     static int iwork[23] = { 10, 1, 7, 0, 1, 4, 5, 6, 7, 8, 10, 12, 21, 28, 28, -10, -11,
2921                              -12, -13, -33, 0, 13, 29
2922                            };
2923     if (!C2F(getrhsvar) (lw, "t", &msys, &nsys, &ptrsys, 1L))
2924     {
2925         return FALSE;
2926     }
2927     il = iadr(ptrsys) - msys - 1;
2928     /*     syslin tlist=[ chain, (A,B,C,D,X0) ,chain or scalar ]
2929      *                     10     1 1 1 1 1      10       1
2930      */
2931     junk = il + msys + iadr(*istk(il));
2932     if (*istk(junk) != 10)
2933     {
2934         return FALSE;
2935     }
2936     if (*istk(il + msys + iadr(*istk(il + 1))) != 1)
2937     {
2938         return FALSE;
2939     }
2940     if (*istk(il + msys + iadr(*istk(il + 2))) != 1)
2941     {
2942         return FALSE;
2943     }
2944     if (*istk(il + msys + iadr(*istk(il + 3))) != 1)
2945     {
2946         return FALSE;
2947     }
2948     if (*istk(il + msys + iadr(*istk(il + 4))) != 1)
2949     {
2950         return FALSE;
2951     }
2952     if (*istk(il + msys + iadr(*istk(il + 5))) != 1)
2953     {
2954         return FALSE;
2955     }
2956     itimedomain = *istk(il + msys + iadr(*istk(il + 6)));
2957     switch (itimedomain)
2958     {
2959         case sci_strings:
2960             /* Sys(7)='c' or 'd' */
2961             icord = *istk(il + msys + iadr(*istk(il + 6)) + 6);
2962             switch (icord)
2963             {
2964                 case 12:
2965                     *hx = 0.;
2966                     break;
2967                 case 13:
2968                     *hx = 1.;
2969                     break;
2970                 default:
2971                     Scierror(999, _("Invalid time domain.\n"));
2972                     return FALSE;
2973             }
2974             break;
2975         case sci_matrix:
2976             /*     Sys(7)=h */
2977             ix1 = il + msys + iadr(*istk(il + 6)) + 4;
2978             *hx = *stk(sadr(ix1));
2979             break;
2980         default:
2981             Scierror(999, _("Invalid time domain.\n"));
2982             return FALSE;
2983     }
2984     for (ix = 0; ix < 23; ++ix) /* @TODO : what is 23 ? */
2985     {
2986         if (iwork[ix] != *istk(junk + ix))
2987         {
2988             Scierror(999, _("Invalid system.\n"));
2989             return FALSE;
2990         }
2991     }
2992     if (!C2F(getlistrhsvar) (lw, &cx2, "d", &ma, &na, ptra, 1L))
2993     {
2994         return FALSE;
2995     }
2996     if (!C2F(getlistrhsvar) (lw, &cx3, "d", &mb, &nb, ptrb, 1L))
2997     {
2998         return FALSE;
2999     }
3000     if (!C2F(getlistrhsvar) (lw, &cx4, "d", &mc, &nc, ptrc, 1L))
3001     {
3002         return FALSE;
3003     }
3004     if (!C2F(getlistrhsvar) (lw, &cx5, "d", &md, &nd, ptrd, 1L))
3005     {
3006         return FALSE;
3007     }
3008     if (!C2F(getlistrhsvar) (lw, &cx6, "d", &mx0, &nx0, ptrx0, 1L))
3009     {
3010         return FALSE;
3011     }
3012     if (ma != na)
3013     {
3014         Scierror(999, _("A non square matrix!\n"));
3015         return FALSE;
3016     }
3017     if (ma != mb && mb != 0)
3018     {
3019         Scierror(999, _("Invalid %c,%c matrices.\n"), 'A', 'B');
3020         return FALSE;
3021     }
3022     if (ma != nc && nc != 0)
3023     {
3024         Scierror(999, _("Invalid %c,%c matrices.\n"), 'A', 'C');
3025         return FALSE;
3026     }
3027     if (mc != md && md != 0)
3028     {
3029         Scierror(999, _("Invalid %c,%c matrices.\n"), 'C', 'D');
3030         return FALSE;
3031     }
3032     if (nb != nd && nd != 0)
3033     {
3034         Scierror(999, _("Invalid %c,%c matrices.\n"), 'B', 'D');
3035         return FALSE;
3036     }
3037     *n = ma;
3038     *m = nb;
3039     *p = mc;
3040     return TRUE;
3041 }
3042
3043 /*---------------------------------------------------
3044 * call Scilab error function (for Fortran use)
3045 *---------------------------------------------------*/
3046
3047 int C2F(errorinfo) (char *fname, int *info, unsigned long fname_len)
3048 {
3049     Scierror(998, _("%s: internal error, info=%d.\n"), get_fname(fname, fname_len), *info);
3050     return 0;
3051 }
3052
3053 /*-------------------------------------------------------------
3054 *  returns Maximal available size in scilab stack
3055 *  for variable <<number>> lw
3056 *  In a Fortran call
3057 *     lw =
3058 *     type= 'd','r','i','c'
3059 *     type_len is here for C/Fortran calling conventions
3060 *  This function is used for creating a working array of Maximal dimension
3061 *  Example :
3062 *     lwork=Maxvol(nb,'d')
3063 *     if(.not.createvar(nb,'d',lwork,1,idwork)) return
3064 *     call pipo(   ,stk(idwork),[lwork],...)
3065 *-------------------------------------------------------------*/
3066
3067 int C2F(maxvol) (int *lw, char *lw_type, unsigned long type_len)
3068 {
3069     unsigned char Type = *(unsigned char *)lw_type;
3070
3071     /* I like this one a lot: a kind of free jazz pattern  */
3072     int m = *Lstk(Bot) - sadr(iadr(*Lstk(*lw + Top - Rhs)) + 4);
3073
3074     switch (Type)
3075     {
3076         case 'd':
3077             return m;
3078             break;
3079         case 'i':
3080             return iadr(m);
3081             break;
3082         case 'r':
3083             return iadr(m);
3084             break;
3085         case 'c':
3086             return cadr(m);
3087             break;
3088         case 'z':
3089             return sadr(m) - 3;
3090             break;
3091     }
3092     /* should never get there */
3093     return m;
3094 }
3095
3096 /*---------------------------------------------
3097 * This function checks all the variables which
3098 * where references and restore their contents
3099 * to Scilab value.
3100 *---------------------------------------------*/
3101
3102 static int Check_references()
3103 {
3104     int ivar;
3105
3106     for (ivar = 1; ivar <= Rhs; ++ivar)
3107     {
3108         unsigned char Type = (unsigned char)C2F(intersci).ntypes[ivar - 1];
3109
3110         if (Type != '$')
3111         {
3112             int lw = ivar + Top - Rhs;
3113             int il = iadr(*Lstk(lw));
3114
3115             if (*istk(il) < 0)
3116             {
3117                 int m, n, it, size;
3118
3119                 /* back conversion if necessary of a reference */
3120                 if (*istk(il) < 0)
3121                 {
3122                     il = iadr(*istk(il + 1));
3123                 }
3124                 m = *istk(il + 1);
3125                 n = *istk(il + 2);
3126                 it = *istk(il + 3);
3127                 switch (Type)
3128                 {
3129                     case 'i':
3130                     case 'r':
3131                     case 'd':
3132                         size = m * n * (it + 1);
3133                         break;
3134                     case 'z':
3135                         size = 0;
3136                         break;      /* size is unsued for 'z' in ConvertData; */
3137                     case 'c':
3138                         size = *istk(il + 4 + 1) - *istk(il + 4);
3139                         break;
3140                     case 'b':
3141                         size = m * n;
3142                         break;
3143                     default:
3144                         return FALSE;
3145                 }
3146                 ConvertData(&Type, size, C2F(intersci).lad[ivar - 1]);
3147                 C2F(intersci).ntypes[ivar - 1] = '$';
3148             }
3149         }
3150         else
3151         {
3152         }
3153     }
3154     return TRUE;
3155 }
3156
3157 /*---------------------------------------------------------------------
3158 * int C2F(putlhsvar)()
3159 *     This function put on the stack the lhs
3160 *     variables which are at position lhsvar(i)
3161 *     on the calling stack
3162 *     Warning : this function supposes that the last
3163 *     variable on the stack is at position top-rhs+nbvars
3164 *---------------------------------------------------------------------*/
3165
3166 int C2F(putlhsvar) ()
3167 {
3168     int ix2, ivar, ibufprec, ix, k, lcres, nbvars1;
3169     int plhsk;
3170
3171     Check_references();
3172
3173     for (k = 1; k <= Lhs; k++)
3174     {
3175         if (LhsVar(k))
3176         {
3177             plhsk = *Lstk(LhsVar(k) + Top - Rhs);
3178             if (*istk(iadr(plhsk)) < 0)
3179             {
3180                 if (*Lstk(Bot) > *Lstk(*istk(iadr(plhsk) + 2)))
3181                 {
3182                     LhsVar(k) = *istk(iadr(plhsk) + 2);
3183                     /* lcres = 0 */
3184                 }
3185             }
3186         }
3187     }
3188
3189     if (Err > 0 || C2F(errgst).err1 > 0)
3190     {
3191         return TRUE;
3192     }
3193     if (C2F(com).fun == -1)
3194     {
3195         return TRUE;
3196     }            /* execution continue with an
3197                                  * overloaded function */
3198     if (LhsVar(1) == 0)
3199     {
3200         Top = Top - Rhs + Lhs;
3201         C2F(objvide) (" ", &Top, 1L);
3202         Nbvars = 0;
3203         return TRUE;
3204     }
3205     nbvars1 = 0;
3206     for (k = 1; k <= Lhs; ++k)
3207     {
3208         nbvars1 = Max(nbvars1, LhsVar(k));
3209     }
3210     /* check if output variabe are in increasing order in the stack */
3211     lcres = TRUE;
3212     ibufprec = 0;
3213     for (ix = 1; ix <= Lhs; ++ix)
3214     {
3215         if (LhsVar(ix) < ibufprec)
3216         {
3217             lcres = FALSE;
3218             break;
3219         }
3220         else
3221         {
3222             ibufprec = LhsVar(ix);
3223         }
3224     }
3225     if (!lcres)
3226     {
3227         /* First pass if output variables are not
3228          * in increasing order
3229          */
3230         for (ivar = 1; ivar <= Lhs; ++ivar)
3231         {
3232             ix2 = Top - Rhs + nbvars1 + ivar;
3233             if (!C2F(mvfromto) (&ix2, &LhsVar(ivar)))
3234             {
3235                 return FALSE;
3236             }
3237             LhsVar(ivar) = nbvars1 + ivar;
3238             /* I change type of variable nbvars1 + ivar
3239              * in order to just perform a dcopy at next pass
3240              */
3241             if (nbvars1 + ivar > intersiz)
3242             {
3243                 Scierror(999, _("%s: intersiz is too small.\n"), "putlhsvar");
3244                 return FALSE;
3245             }
3246             C2F(intersci).ntypes[nbvars1 + ivar - 1] = '$';
3247         }
3248     }
3249     /*  Second pass */
3250     for (ivar = 1; ivar <= Lhs; ++ivar)
3251     {
3252         ix2 = Top - Rhs + ivar;
3253         if (!C2F(mvfromto) (&ix2, &LhsVar(ivar)))
3254         {
3255             return FALSE;
3256         }
3257     }
3258     Top = Top - Rhs + Lhs;
3259     LhsVar(1) = 0;
3260     Nbvars = 0;
3261     return TRUE;
3262 }
3263
3264 /*---------------------------------------------------------------------
3265 * mvfromto :
3266 *     this routines copies the variable number i
3267 *     (created by getrhsvar or createvar or by mvfromto itself in a precedent call)
3268 *     from its position on the stack to position itopl
3269 *     returns false if there's no more stack space available
3270 *     - if type(i) # '$'  : This variable is at
3271 *                         position lad(i) on the stack )
3272 *                         and itopl must be the first free position
3273 *                         on the stack
3274 *                         copy is performed + type conversion (type(i))
3275 *     - if type(i) == '$': then it means that object at position i
3276 *                         is the result of a previous call to mvfromto
3277 *                         a copyobj is performed and itopl can
3278 *                         can be any used position on the stack
3279 *                         the object which was at position itopl
3280 *                         is replaced by object at position i
3281 *                         (and access to object itopl+1 can be lost if
3282 *                         the object at position i is <> from object at
3283 *                         position itopl
3284 *---------------------------------------------------------------------*/
3285
3286 static int C2F(mvfromto) (int *itopl, int *ix)
3287 {
3288     int ix1 = 0;
3289     int m = 0;
3290     int n = 0;
3291     int it = 0;
3292     int lcs = 0;
3293     int lrs = 0;
3294     int l = 0;
3295     int size = 0;
3296     int pointed = 0;
3297     unsigned long int ilp = 0;
3298     unsigned char Type;
3299     double wsave;
3300
3301     Type = (unsigned char)C2F(intersci).ntypes[*ix - 1];
3302     if (Type != '$')
3303     {
3304         /* int iwh = *ix + Top - Rhs;
3305          * ilp = iadr(*Lstk(iwh)); */
3306         int iwh = C2F(intersci).iwhere[*ix - 1];
3307
3308         ilp = iadr(iwh);
3309         if (*istk(ilp) < 0)
3310         {
3311             ilp = iadr(*istk(ilp + 1));
3312         }
3313         m = *istk(ilp + 1);
3314         n = *istk(ilp + 2);
3315         it = *istk(ilp + 3);
3316     }
3317
3318     switch (Type)
3319     {
3320         case 'i':
3321             if (!C2F(cremat) ("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L))
3322             {
3323                 return FALSE;
3324             }
3325             ix1 = m * n * (it + 1);
3326             C2F(stacki2d) (&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
3327             C2F(intersci).lad[*ix - 1] = iadr(lrs);
3328             break;
3329         case 'r':
3330             if (!C2F(cremat) ("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L))
3331             {
3332                 return FALSE;
3333             }
3334             ix1 = m * n * (it + 1);
3335             C2F(stackr2d) (&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
3336             C2F(intersci).lad[*ix - 1] = iadr(lrs);
3337             break;
3338         case 'd':
3339             if (!C2F(cremat) ("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L))
3340             {
3341                 return FALSE;
3342             }
3343             /* no copy if the two objects are the same
3344              * the cremat above is kept to deal with possible size changes
3345              */
3346             if (C2F(intersci).lad[*ix - 1] != lrs)
3347             {
3348                 ix1 = m * n * (it + 1);
3349                 l = C2F(intersci).lad[*ix - 1];
3350                 if (abs(l - lrs) < ix1)
3351                 {
3352                     C2F(unsfdcopy) (&ix1, stk(l), &cx1, stk(lrs), &cx1);
3353                 }
3354                 else
3355                 {
3356                     C2F(dcopy) (&ix1, stk(l), &cx1, stk(lrs), &cx1);
3357                 }
3358                 C2F(intersci).lad[*ix - 1] = lrs;
3359             }
3360             break;
3361         case 'z':
3362             if (*istk(ilp) == 133)
3363             {
3364                 wsave = *stk(C2F(intersci).lad[*ix - 1]);
3365                 n = *istk(m + 1);
3366                 m = *istk(m);
3367                 it = 1;
3368                 if (!C2F(cremat) ("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L))
3369                 {
3370                     return FALSE;
3371                 }
3372                 z2double(stk(C2F(intersci).lad[*ix - 1]), stk(lrs), m * n, m * n);
3373                 *stk(lrs) = wsave;
3374                 C2F(intersci).lad[*ix - 1] = lrs;
3375             }
3376             else
3377             {
3378                 if (!C2F(cremat) ("mvfromto", itopl, &it, &m, &n, &lrs, &lcs, 8L))
3379                 {
3380                     return FALSE;
3381                 }
3382                 z2double(stk(C2F(intersci).lad[*ix - 1]), stk(lrs), m * n, m * n);
3383                 C2F(intersci).lad[*ix - 1] = lrs;
3384             }
3385             break;
3386         case 'c':
3387             m = *istk(ilp + 4 + 1) - *istk(ilp + 4);
3388             n = 1;
3389             ix1 = m * n;
3390             if (!C2F(cresmat2) ("mvfromto", itopl, &ix1, &lrs, 8L))
3391             {
3392                 return FALSE;
3393             }
3394             C2F(stackc2i) (&ix1, &C2F(intersci).lad[*ix - 1], &lrs);
3395             C2F(intersci).lad[*ix - 1] = cadr(lrs);
3396             break;
3397
3398         case 'b':
3399             if (!C2F(crebmat) ("mvfromto", itopl, &m, &n, &lrs, 8L))
3400             {
3401                 return FALSE;
3402             }
3403             ix1 = m * n;
3404             C2F(icopy) (&ix1, istk(C2F(intersci).lad[*ix - 1]), &cx1, istk(lrs), &cx1);
3405             C2F(intersci).lad[*ix - 1] = lrs;
3406             break;
3407         case '-':
3408             /*    reference  '-' = ascii(45) */
3409             ilp = iadr(*Lstk(*ix));
3410             size = *istk(ilp + 3);
3411             pointed = *istk(ilp + 2);
3412             if (!C2F(cremat) ("mvfromto", itopl, (it = 0, &it), (m = 1, &m), &size, &lrs, &lcs, 8L))
3413             {
3414                 return FALSE;
3415             }
3416             if (C2F(vcopyobj) ("mvfromto", &pointed, itopl, 8L) == FALSE)
3417             {
3418                 return FALSE;
3419             }
3420             break;
3421         case 'h':
3422             if (!C2F(crehmat) ("mvfromto", itopl, &m, &n, &lrs, 8L))
3423             {
3424                 return FALSE;
3425             }
3426             /* no copy if the two objects are the same
3427              * the cremat above is kept to deal with possible size changes
3428              */
3429             if (C2F(intersci).lad[*ix - 1] != lrs)
3430             {
3431                 ix1 = m * n;
3432                 l = C2F(intersci).lad[*ix - 1];
3433                 if (abs(l - lrs) < ix1)
3434                 {
3435                     C2F(unsfdcopy) (&ix1, stk(l), &cx1, stk(lrs), &cx1);
3436                 }
3437                 else
3438                 {
3439                     C2F(dcopy) (&ix1, stk(l), &cx1, stk(lrs), &cx1);
3440                 }
3441                 C2F(intersci).lad[*ix - 1] = lrs;
3442             }
3443             break;
3444         case 'p':
3445         case '$':
3446             /*     special case */
3447             if (Top - Rhs + *ix != *itopl)
3448             {
3449                 ix1 = Top - Rhs + *ix;
3450                 if (C2F(vcopyobj) ("mvfromto", &ix1, itopl, 8L) == FALSE)
3451                 {
3452                     return FALSE;
3453                 }
3454             }
3455     }
3456     return TRUE;
3457 }
3458
3459 /*---------------------------------------------------------------------
3460 * copyref
3461 * copy object at position from to position to
3462 * without changing data.
3463 * The copy is only performed if object is a reference
3464 * and ref object is replaced by its value
3465 *---------------------------------------------------------------------*/
3466
3467 int Ref2val(int from, int to)
3468 {
3469     int il, lw;
3470
3471     lw = from + Top - Rhs;
3472     if (from > Rhs)
3473     {
3474         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), "copyref", "isref");
3475         return FALSE;
3476     }
3477     il = iadr(*Lstk(lw));
3478     if (*istk(il) < 0)
3479     {
3480         int lwd;
3481
3482         /* from contains a reference */
3483         lw = *istk(il + 2);
3484         lwd = to + Top - Rhs;
3485         C2F(copyobj) ("copyref", &lw, &lwd, (unsigned long)strlen("copyref"));
3486     }
3487     return 0;
3488 }
3489
3490 /*---------------------------------------------------------------------
3491 * convert2sci :
3492 *     this routine converts data of variable number num
3493 *     to scilab standard data code
3494 *     see how it is used in matdes.c
3495 *---------------------------------------------------------------------*/
3496
3497 int C2F(convert2sci) (int *ix)
3498 {
3499     int ix1 = Top - Rhs + *ix;
3500
3501     if (!C2F(mvfromto) (&ix1, ix))
3502     {
3503         return FALSE;
3504     }
3505     C2F(intersci).ntypes[*ix - 1] = '$';
3506     return TRUE;
3507 }
3508
3509 /*-----------------------------------------------------------
3510 * strcpy_tws : fname[0:nlgh-2]=' '
3511 * fname[nlgh-1] = '\0'
3512 * then second string is copied into first one
3513 * ------------------------------------------------------------*/
3514
3515 void strcpy_tws(char *str1, char *str2, int len)
3516 {
3517     int i;
3518
3519     for (i = 0; i < (int)strlen(str2); i++)
3520     {
3521         str1[i] = str2[i];
3522     }
3523     for (i = (int)strlen(str2); i < len; i++)
3524     {
3525         str1[i] = ' ';
3526     }
3527     str1[len - 1] = '\0';
3528 }
3529
3530 /*---------------------------------------------------------------------
3531 *     conversion from Scilab code --> ascii
3532 *     + add a 0 at end of string
3533 *---------------------------------------------------------------------*/
3534
3535 int C2F(in2str) (int *n, int *line, char *str, unsigned long str_len)
3536 {
3537     C2F(codetoascii) (n, line, str, str_len);
3538     str[*n] = '\0';
3539     return 0;
3540 }
3541
3542 /*---------------------------------------------------------------------
3543 * Get_Iname:
3544 * Get the name (interfcae name) which was stored in ids while in checkrhs
3545 *---------------------------------------------------------------------*/
3546
3547 static char Fname[nlgh + 1];
3548
3549 static char *Get_Iname()
3550 {
3551     int i;
3552
3553     C2F(cvname) (&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], Fname, &cx1, nlgh);
3554     /** remove trailing blanks **/
3555     for (i = 0; i < nlgh; i++)
3556         if (Fname[i] == ' ')
3557         {
3558             Fname[i] = '\0';
3559             break;
3560         }
3561     Fname[nlgh] = '\0';
3562     return Fname;
3563 }
3564
3565 /*---------------------------------------------------------------------
3566 * Utility for error message
3567 *---------------------------------------------------------------------*/
3568
3569 static char arg_position[56];   /* @TODO WTF is 56 ? */
3570
3571 char *CharPosition(int i)
3572 {
3573     char *tmp_buffer = NULL;
3574
3575     switch (i + 1)
3576     {
3577         case 1:
3578             tmp_buffer = strdup(_("first"));
3579             break;
3580         case 2:
3581             tmp_buffer = strdup(_("second"));
3582             break;
3583         case 3:
3584             tmp_buffer = strdup(_("third"));
3585             break;
3586         case 4:
3587             tmp_buffer = strdup(_("fourth"));
3588             break;
3589         default:
3590             tmp_buffer = strdup(" ");
3591             break;
3592     }
3593     return tmp_buffer;
3594 }
3595
3596 char *ArgPosition(int i)
3597 {
3598     char *tmp_buffer = NULL;
3599
3600     if (i > 0 && i <= 4)
3601     {
3602         tmp_buffer = CharPosition(i - 1);
3603         sprintf(arg_position, _("%s argument"), tmp_buffer);
3604         FREE(tmp_buffer);
3605     }
3606     else
3607     {
3608         sprintf(arg_position, _("argument #%d"), i);
3609     }
3610     return arg_position;
3611 }
3612
3613 char *ArgsPosition(int i, int j)
3614 {
3615     char *tmp_buffer_1 = NULL, *tmp_buffer_2 = NULL;
3616
3617     if (i > 0 && i <= 4)
3618     {
3619         if (j > 0 && j <= 4)
3620         {
3621             tmp_buffer_1 = CharPosition(i - 1);
3622             tmp_buffer_2 = CharPosition(j - 1);
3623             sprintf(arg_position, _("%s and %s arguments"), tmp_buffer_1, tmp_buffer_2);
3624             FREE(tmp_buffer_1);
3625             FREE(tmp_buffer_2);
3626         }
3627         else
3628         {
3629             tmp_buffer_1 = CharPosition(i - 1);
3630             sprintf(arg_position, _("%s argument and argument #%d"), tmp_buffer_1, j);
3631             FREE(tmp_buffer_1);
3632         }
3633     }
3634     else
3635     {
3636         if (j > 0 && j <= 4)
3637         {
3638             tmp_buffer_1 = CharPosition(j - 1);
3639             sprintf(arg_position, _("%s argument and argument #%d"), tmp_buffer_1, i);
3640             FREE(tmp_buffer_1);
3641         }
3642         else
3643         {
3644             sprintf(arg_position, _("arguments #%d and #%d"), i, j);
3645         }
3646     }
3647     return arg_position;
3648 }
3649
3650 /*---------------------------------------------------------------------
3651 * Utility for back convertion to Scilab format
3652 * (can be used with GetListRhsVar )
3653 *---------------------------------------------------------------------*/
3654
3655 static void ConvertData(unsigned char *type, int size, int l)
3656 {
3657     int zero = 0, mu = -1;
3658     int laddr;
3659     int prov, m, n, it;
3660     double wsave;
3661
3662     switch (type[0])
3663     {
3664         case 'c':
3665             C2F(cvstr1) (&size, (int *)cstk(l), cstk(l), &zero, size);
3666             break;
3667         case 'r':
3668             C2F(rea2db) (&size, sstk(l), &mu, (double *)sstk(l), &mu);
3669             break;
3670         case 'i':
3671             C2F(int2db) (&size, istk(l), &mu, (double *)istk(l), &mu);
3672             break;
3673         case 'z':
3674             if (*istk(iadr(iadr(l)) - 2) == 133)
3675             {
3676                 /* values @ even adress */
3677                 prov = *istk(iadr(iadr(l)) - 1);
3678                 m = *istk(prov);
3679                 n = *istk(prov + 1);
3680                 it = 1;
3681                 laddr = iadr(l);
3682                 wsave = *stk(laddr);
3683                 /* make header */
3684                 *istk(iadr(iadr(l)) - 2) = 1;
3685                 *istk(iadr(iadr(l)) - 1) = m;
3686                 *istk(iadr(iadr(l))) = n;
3687                 *istk(iadr(iadr(l)) + 1) = it;
3688                 /* convert values */
3689                 z2double(stk(laddr), stk(laddr + 1), m * n, m * n);
3690                 *stk(laddr + 1) = wsave;
3691             }
3692             else
3693             {
3694                 F77ToSci((double *)zstk(l), size, size);
3695             }
3696     }
3697 }
3698
3699 /*---------------------------------------------------------------------
3700 * Utility for checking properties
3701 *---------------------------------------------------------------------*/
3702
3703 static int check_prop(char *mes, int posi, int m)
3704 {
3705     if (m)
3706     {
3707         /* XXXX moduler 999 en fn des messages */
3708         Scierror(999, "%s: %s %s\n", Get_Iname(), ArgPosition(posi), mes);
3709         return FALSE;
3710     }
3711     return TRUE;
3712 }
3713
3714 int check_square(int posi, int m, int n)
3715 {
3716     return check_prop(_("should be square"), posi, m != n);
3717 }
3718
3719 int check_vector(int posi, int m, int n)
3720 {
3721     return check_prop(_("should be a vector"), posi, m != 1 && n != 1);
3722 }
3723
3724 int check_row(int posi, int m, int n)
3725 {
3726     return check_prop(_("should be a row vector"), posi, m != 1);
3727 }
3728
3729 int check_col(int posi, int m, int n)
3730 {
3731     return check_prop(_("should be a column vector"), posi, n != 1);
3732 }
3733
3734 int check_scalar(int posi, int m, int n)
3735 {
3736     return check_prop(_("should be a scalar"), posi, n != 1 || m != 1);
3737 }
3738
3739 int check_dims(int posi, int m, int n, int m1, int n1)
3740 {
3741     if (m != m1 || n != n1)
3742     {
3743         Scierror(999, _("%s: %s has wrong dimensions (%d,%d), expecting (%d,%d).\n"), Get_Iname(), ArgPosition(posi), m, n, m1, n1);
3744         return FALSE;
3745     }
3746     return TRUE;
3747 }
3748
3749 int check_one_dim(int posi, int dim, int val, int valref)
3750 {
3751     if (val != valref)
3752     {
3753         Scierror(999, _("%s: %s has wrong %s dimension (%d), expecting (%d).\n"), Get_Iname(), ArgPosition(posi),
3754                  (dim == 1) ? _("first") : _("second"), val, valref);
3755         return FALSE;
3756     }
3757     return TRUE;
3758 }
3759
3760 int check_length(int posi, int m, int m1)
3761 {
3762     if (m != m1)
3763     {
3764         Scierror(999, _("%s: %s has wrong length %d, expecting (%d).\n"), Get_Iname(), ArgPosition(posi), m, m1);
3765         return FALSE;
3766     }
3767     return TRUE;
3768 }
3769
3770 int check_same_dims(int i, int j, int m1, int n1, int m2, int n2)
3771 {
3772     if (m1 == m2 && n1 == n2)
3773     {
3774         return TRUE;
3775     }
3776     Scierror(999, _("%s: %s have incompatible dimensions (%dx%d) # (%dx%d)\n"), Get_Iname(), ArgsPosition(i, j), m1, n1, m2, n2);
3777     return FALSE;
3778 }
3779
3780 int check_dim_prop(int i, int j, int flag)
3781 {
3782     if (flag)
3783     {
3784         Scierror(999, _("%s: %s have incompatible dimensions.\n"), Get_Iname(), ArgsPosition(i, j));
3785         return FALSE;
3786     }
3787     return TRUE;
3788 }
3789
3790 static int check_list_prop(char *mes, int lpos, int posi, int m)
3791 {
3792     if (m)
3793     {
3794         Scierror(999, _("%s: %s should be a list with %d-element being %s.\n"), Get_Iname(), ArgPosition(posi), posi, mes);
3795         return FALSE;
3796     }
3797     return TRUE;
3798 }
3799
3800 int check_list_square(int lpos, int posi, int m, int n)
3801 {
3802     return check_list_prop(_("square"), lpos, posi, (m != n));
3803 }
3804
3805 int check_list_vector(int lpos, int posi, int m, int n)
3806 {
3807     return check_list_prop(_("a vector"), lpos, posi, m != 1 && n != 1);
3808 }
3809
3810 int check_list_row(int lpos, int posi, int m, int n)
3811 {
3812     return check_list_prop(_("a row vector"), lpos, posi, m != 1);
3813 }
3814
3815 int check_list_col(int lpos, int posi, int m, int n)
3816 {
3817     return check_list_prop(_("a column vector"), lpos, posi, n != 1);
3818 }
3819
3820 int check_list_scalar(int lpos, int posi, int m, int n)
3821 {
3822     return check_list_prop(_("a scalar"), lpos, posi, n != 1 || m != 1);
3823 }
3824
3825 int check_list_one_dim(int lpos, int posi, int dim, int val, int valref)
3826 {
3827     if (val != valref)
3828     {
3829         Scierror(999, _("%s: argument %d(%d) has wrong %s dimension (%d), expecting (%d).\n"), Get_Iname(), lpos, posi,
3830                  (dim == 1) ? _("first") : _("second"), val, valref);
3831         return FALSE;
3832     }
3833     return TRUE;
3834 }
3835
3836 /*---------------------------------------------------------------------
3837 * Utility for hand writen data extraction or creation
3838 *---------------------------------------------------------------------*/
3839
3840 int C2F(createdata) (int *lw, int n)
3841 {
3842     int lw1;
3843     char *fname = Get_Iname();
3844
3845     if (*lw > intersiz)
3846     {
3847         Scierror(999, _("%s: (%s) too many arguments in the stack edit stack.h and enlarge intersiz.\n"), fname, "createdata");
3848         return FALSE;
3849     }
3850     Nbvars = Max(*lw, Nbvars);
3851     lw1 = *lw + Top - Rhs;
3852     if (*lw < 0)
3853     {
3854         Scierror(999, _("%s: bad call to %s! (1rst argument).\n"), fname, "createdata");
3855         return FALSE;
3856     }
3857     if (!C2F(credata) (fname, &lw1, n, nlgh))
3858     {
3859         return FALSE;
3860     }
3861     C2F(intersci).ntypes[*lw - 1] = '$';
3862     C2F(intersci).iwhere[*lw - 1] = *Lstk(lw1);
3863     C2F(intersci).lad[*lw - 1] = *Lstk(lw1);
3864     return TRUE;
3865 }
3866
3867 /*---------------------------------------------------------------------
3868 * copyvarfromsciptr
3869 *     copy a Scilab variable given by
3870 *      - its first adress l in stk
3871 *      - its size n
3872 *    to the variable position  lw
3873 *----------------------------------------------------------------------*/
3874 int C2F(copyvarfromsciptr) (int lw, int n, int l)
3875 {
3876     int ret, un = 1;
3877
3878     if ((ret = C2F(createdata) (&lw, n)) == FALSE)
3879     {
3880         return ret;
3881     }
3882     C2F(unsfdcopy) (&n, stk(l), &un, stk(*Lstk(lw + Top - Rhs)), &un);
3883     return TRUE;
3884 }
3885
3886 void *GetVarPtr(int n)
3887 /* return  the pointer on the first int of the n th variable  data structure  */
3888 {
3889     int l1 = *Lstk(n + Top - Rhs);
3890     int *loci = (int *)stk(l1);
3891
3892     return loci;
3893 }
3894
3895 void *GetData(int lw)
3896 /* Usage: header = (int *) GetData(lw); header[0] = type of variable lw etc */
3897 {
3898     int lw1 = lw + Top - Rhs;
3899     int l1 = *Lstk(lw1);
3900     int *loci = (int *)stk(l1);
3901
3902     if (loci[0] < 0)
3903     {
3904         l1 = loci[1];
3905         loci = (int *)stk(l1);
3906     }
3907     C2F(intersci).ntypes[lw - 1] = '$';
3908     C2F(intersci).iwhere[lw - 1] = l1;
3909     C2F(intersci).lad[lw - 1] = l1;
3910     return loci;
3911 }
3912
3913 int GetDataSize(int lw)
3914 /* get memory used by the argument lw in double world etc */
3915 {
3916     int lw1 = lw + Top - Rhs;
3917     int l1 = *Lstk(lw1);
3918     int *loci = (int *)stk(l1);
3919     int n = *Lstk(lw1 + 1) - *Lstk(lw1);
3920
3921     if (loci[0] < 0)
3922     {
3923         l1 = loci[1];
3924         loci = (int *)stk(l1);
3925         n = loci[3];
3926     }
3927     return n;
3928 }
3929
3930 void *GetRawData(int lw)
3931 /* same as GetData BUT does not go to the pointed variable if lw is a reference */
3932 {
3933     int lw1 = lw + Top - Rhs;
3934     int l1 = *Lstk(lw1);
3935     int *loci = (int *)stk(l1);
3936
3937     C2F(intersci).ntypes[lw - 1] = '$';
3938     C2F(intersci).iwhere[lw - 1] = l1;
3939     /*  C2F(intersci).lad[lw - 1] = l1;  to be checked */
3940     return loci;
3941 }
3942
3943 void *GetDataFromName(char *name)
3944 /* usage:  header = (int *) GetDataFromName("pipo"); header[0] = type of variable pipo etc... */
3945 {
3946     void *header;
3947     int lw;
3948     int fin;
3949
3950     if (C2F(objptr) (name, &lw, &fin, (unsigned long)strlen(name)))
3951     {
3952         header = istk(iadr(*Lstk(fin)));
3953         return (void *)header;
3954     }
3955     else
3956     {
3957         Scierror(999, _("GetDataFromName: variable %s not found.\n"), name);
3958         return (void *)0;
3959     }
3960 }
3961
3962 int C2F(createreference) (int number, int pointed)
3963 /* variable number is created as a reference to variable pointed */
3964 {
3965     int offset;
3966     int point_ed;
3967     int *header;
3968
3969     CreateData(number, 4 * sizeof(int));
3970     header = GetRawData(number);
3971     offset = Top - Rhs;
3972     point_ed = offset + pointed;
3973     header[0] = -*istk(iadr(*Lstk(point_ed)));  /* reference : 1st entry (type) is opposite */
3974     header[1] = *Lstk(point_ed);    /* pointed adress */
3975     header[2] = point_ed;       /* pointed variable */
3976     header[3] = *Lstk(point_ed + 1) - *Lstk(point_ed);  /* size of pointed variable */
3977     C2F(intersci).ntypes[number - 1] = '-';
3978     return 1;
3979 }
3980
3981 int C2F(changetoref) (int number, int pointed)
3982 /* variable number is changed as a reference to variable pointed */
3983 {
3984     int offset;
3985     int point_ed;
3986     int *header;
3987
3988     header = GetRawData(number);
3989     offset = Top - Rhs;
3990     point_ed = offset + pointed;
3991     header[0] = -*istk(iadr(*Lstk(point_ed)));  /* reference : 1st entry (type) is opposite */
3992     header[1] = *Lstk(point_ed);    /* pointed adress */
3993     header[2] = pointed;        /* pointed variable */
3994     header[3] = *Lstk(point_ed + 1) - *Lstk(point_ed);  /* size of pointed variable */
3995     C2F(intersci).ntypes[number - 1] = '-';
3996     return 1;
3997 }
3998
3999 int C2F(createreffromname) (int number, char *name)
4000 /* variable number is created as a reference pointing to variable "name" */
4001 /* name must be an existing Scilab variable */
4002 {
4003     int *header;
4004     int lw;
4005     int fin;
4006
4007     CreateData(number, 4 * sizeof(int));
4008     header = (int *)GetData(number);
4009     if (C2F(objptr) (name, &lw, &fin, (unsigned long)strlen(name)))
4010     {
4011         header[0] = -*istk(iadr(*Lstk(fin)));   /* type of reference = - type of pointed variable */
4012         header[1] = lw;         /* pointed adress */
4013         header[2] = fin;        /* pointed variable */
4014         header[3] = *Lstk(fin + 1) - *Lstk(fin);    /*size of pointed variable */
4015         return 1;
4016     }
4017     else
4018     {
4019         Scierror(999, _("%s: Variable %s not found.\n"), "CreateRefFromName", name);
4020         return 0;
4021     }
4022 }
4023
4024 /*-------------------------------------------------------
4025 * protect the intersci common during recursive calls
4026 *-------------------------------------------------------*/
4027
4028 typedef struct inter_s_
4029 {
4030     int iwhere, nbrows, nbcols, itflag, ntypes, lad, ladc, lhsvar;
4031 } intersci_state;
4032
4033 typedef struct inter_l
4034 {
4035     intersci_state *state;
4036     int nbvars;
4037     struct inter_l *next;
4038 } intersci_list;
4039
4040 static intersci_list *L_intersci;
4041
4042 static int intersci_push(void)
4043 {
4044     int i;
4045     intersci_list *loc;
4046     intersci_state *new = NULL;
4047
4048     if (Nbvars)
4049     {
4050         new = MALLOC(Nbvars * sizeof(intersci_state));
4051         if (new == 0)
4052         {
4053             return 0;
4054         }
4055     }
4056
4057     loc = MALLOC(sizeof(intersci_list));
4058     if (loc == NULL)
4059     {
4060         return 0;
4061     }
4062     loc->next = L_intersci;
4063     loc->state = new;
4064     loc->nbvars = Nbvars;
4065     for (i = 0; i < Nbvars; i++)
4066     {
4067         loc->state[i].iwhere = C2F(intersci).iwhere[i];
4068         loc->state[i].ntypes = C2F(intersci).ntypes[i];
4069         loc->state[i].lad = C2F(intersci).lad[i];
4070         loc->state[i].lhsvar = C2F(intersci).lhsvar[i];
4071     }
4072     L_intersci = loc;
4073     return 1;
4074 }
4075
4076 static void intersci_pop(void)
4077 {
4078     int i;
4079     intersci_list *loc = L_intersci;
4080
4081     if (loc == NULL)
4082     {
4083         return;
4084     }
4085     Nbvars = loc->nbvars;
4086     for (i = 0; i < Nbvars; i++)
4087     {
4088         C2F(intersci).iwhere[i] = loc->state[i].iwhere;
4089         C2F(intersci).ntypes[i] = loc->state[i].ntypes;
4090         C2F(intersci).lad[i] = loc->state[i].lad;
4091         C2F(intersci).lhsvar[i] = loc->state[i].lhsvar;
4092     }
4093     L_intersci = loc->next;
4094     if (loc->state)
4095     {
4096         FREE(loc->state);
4097     }
4098
4099     if (loc)
4100     {
4101         FREE(loc);
4102     }
4103 }
4104
4105 /*
4106 static void intersci_show()
4107 {
4108 int i;
4109 fprintf(stderr,"======================\n");
4110 for ( i = 0 ; i < C2F(intersci).nbvars ; i++ )
4111 {
4112 fprintf(stderr,"%d %d %d\n",i,
4113 C2F(intersci).iwhere[i],
4114 C2F(intersci).ntypes[i]);
4115 }
4116 fprintf(stderr,"======================\n");
4117 }
4118
4119 */