scilab/modules/scicos/sci_gateway/cpp/sci_getscicosvars.cpp

   1 /*
   2  *  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   3  *  Copyright (C) 2015 - Scilab Enterprises - Paul Bignier
   4  *
   5  * Copyright (C) 2012 - 2016 - Scilab Enterprises
   6  *
   7  * This file is hereby licensed under the terms of the GNU GPL v2.0,
   8  * pursuant to article 5.3.4 of the CeCILL v.2.1.
   9  * This file was originally licensed under the terms of the CeCILL v2.1,
  10  * and continues to be available under such terms.
  11  * For more information, see the COPYING file which you should have received
  12  * along with this program.
  13  *
  14  */
  15
  16 #include <string>
  17 #include <vector>
  18
  19 #include "gw_scicos.hxx"
  20 #include "internal.hxx"
  21 #include "types.hxx"
  22 #include "double.hxx"
  23 #include "int.hxx"
  24 #include "string.hxx"
  25 #include "tlist.hxx"
  26 #include "function.hxx"
  27
  28 extern "C"
  29 {
  30 #include "sciprint.h"
  31 #include "scicos-def.h"
  32 #include "charEncoding.h"
  33 #include "Scierror.h"
  34 #include "localization.h"
  35 #include "import.h"
  36
  37     /*--------------------------------------------------------------------------*/
  38     // Variable defined in sci_scicosim.cpp
  39     extern COSIM_struct C2F(cosim);
  40     /*--------------------------------------------------------------------------*/
  41 }
  42
  43 #include "il_state.hxx"
  44 #include "il_sim.hxx"
  45 #include "createblklist.hxx"
  46
  47 /*--------------------------------------------------------------------------*/
  48 /* getscicosvars interface routine retrieves some information during simulation.
  49 *
  50 * [myvar]=getscicosvars(str)
  51 *
  52 * rhs 1  : str : a character string matrix with choice,
  53 *               - 'x' to retrieve continuous state
  54 *               - 'xptr' to retrieve ptr of continuous state
  55 *               - 'z' to retrieve discrete state
  56 *               - 'zptr' to retrieve ptr of discrete state
  57 *               - 'rpar' to retrieve real parameters
  58 *               - 'rpptr' to retrieve ptr of real parameters
  59 *               - 'ipar' to retrieve int parameters
  60 *               - 'ipptr' to retrieve  ptr of int parameters
  61 *               - 'outtb' to retrieve output register (list of scilb object)
  62 *               - 'inpptr' to retrieve number of input ports
  63 *               - 'outptr' to retrieve number of output ports
  64 *               - 'inplnk' to retrieve link number of input ports
  65 *               - 'outlnk' to retrieve link number of output ports
  66 *               ...... -see below-
  67 *
  68 * lhs 1  : myvar : matrix of int32 or double, or list or a Tlist
  69 *
  70 * 31/05/06, Alan : Rewritten from original fortran
  71 * source code intgetscicosvars in coselm.f.
  72 *
  73 * 22/06/06, Alan : Allow multiple string in rhs(1).
  74 *                  Create Tlist for Lhs(1).
  75 *
  76 * 23/06/06, Alan : Create blocks list for Lhs(1).
  77 *
  78 * 13/11/06, Alan : Remove il_sim_save global variable (all in sim
  79 *                  come from import struct now)
  80 *                  evtspt & pointi of state come from import struct
  81 *
  82 * 09/02/07, Alan : Update with oz/opar and restore il_sim_save only for opar
  83 *
  84 * 08/12/14, Paul : Rewrote to C++.
  85 *
  86 */
  87 /*--------------------------------------------------------------------------*/
  88
  89 static const std::string funname = "getscicosvars";
  90
  91 types::Function::ReturnValue sci_getscicosvars(types::typed_list &in, int _iRetCount, types::typed_list &out)
  92 {
  93     if (in.size() > 1)
  94     {
  95         Scierror(77, _("%s: Wrong number of input argument(s): %d or %d expected.\n"), funname.data(), 0, 1);
  96         return types::Function::Error;
  97     }
  98
  99     if (_iRetCount > 1)
 100     {
 101         Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1);
 102         return types::Function::Error;
 103     }
 104
 105     int isrun = C2F(cosim).isrun;
 106     if (!isrun)
 107     {
 108         Scierror(999, _("%s: scicosim is not running.\n"), funname.data());
 109         return types::Function::Error;
 110     }
 111
 112     bool ok = false;
 113     // Define accepted entries of getscicosvars -please update me-
 114     const std::vector<const char*> entry
 115     {
 116         "x"       , "nx"       , "xptr"   , "zcptr"      , "z"        ,
 117         "nz"      , "zptr"     , "noz"    , "oz"         , "ozsz"     ,
 118         "oztyp"   , "ozptr"    , "rpar"   , "rpptr"      , "ipar"     ,
 119         "ipptr"   , "opar"     , "oparsz" , "opartyp"    , "opptr"    ,
 120         "outtb"   , "inpptr"   , "outptr" , "inplnk"     , "outlnk"   ,
 121         "subs"    , "tevts"    , "evtspt" , "pointi"     , "iord"     ,
 122         "oord"    , "zord"     , "funtyp" , "ztyp"       , "cord"     ,
 123         "ordclk"  , "clkptr"   , "ordptr" , "critev"     , "mod"      ,
 124         "nmod"    , "iz"       , "nblk"   , "izptr"      , "outtbptr" ,
 125         "outtbsz" , "outtbtyp" , "nlnk"   , "nsubs"      , "nevts"    ,
 126         "niord"   , "noord"    , "nzord"  , "funptr"     , "ncord"    ,
 127         "nordptr" , "iwa"      , "blocks" , "ng"         , "g"        ,
 128         "t0"      , "tf"       , "Atol"   , "rtol"       , "ttol"     ,
 129         "deltat"  , "hmax"     , "nelem"  , "outtb_elem"
 130     };
 131     // Number of entries
 132     const size_t nentries = entry.size();
 133
 134     // Display usage of getscicosvars function if in.size()==0
 135     if (in.size() == 0)
 136     {
 137         sciprint(_("\ngetscicosvars: utility function to retrieve\n"));
 138         sciprint(_("                scicos arrays during simulation.\n\n"));
 139         sciprint(_("Usage: [myvar]=getscicosvars([\"str1\";\"str2\";...]);\n\n"));
 140         sciprint(_("- myvar: an int32 or double matrix or a Tlist.\n"));
 141         sciprint(_("- [\"str1\";\"str2\",...] is a string matrix\n"));
 142         sciprint(_("  that must be informed with the following values:\n"));
 143
 144         // Display allowed entries
 145         int i = 0;
 146         for (size_t j = 0; j < nentries; ++j)
 147         {
 148             if (j == nentries - 1)
 149             {
 150                 sciprint("\"%s\" ", entry[j]);
 151             }
 152             else
 153             {
 154                 sciprint("\"%s\", ", entry[j]);
 155             }
 156             i++;
 157             if (i == 6)
 158             {
 159                 sciprint("\n");
 160                 i = 0;
 161             }
 162         }
 163         sciprint("\n");
 164         return types::Function::OK;
 165     }
 166
 167     /*******************
 168     * Check str (rhs 1)
 169     *******************/
 170     if (!in[0]->isString())
 171     {
 172         Scierror(999, _("%s: Wrong type for input argument #%d: A string matrix expected.\n"), funname.data(), 1);
 173         return types::Function::Error;
 174     }
 175     types::String* il_str = in[0]->getAs<types::String>();
 176
 177     // Retrieve dimension of input string matrix
 178     const int m1 = il_str->getRows();
 179     const int n1 = il_str->getCols();
 180
 181     // Create header of TList
 182     types::String* dyn_char = new types::String(1 + m1 * n1, 1);
 183
 184     // Type of list is scicosvar
 185     const std::string scicosvar("scicosvar");
 186     dyn_char->set(0, "scicosvar");
 187
 188     // Check string matrix
 189     for (int j = 0; j < m1 * n1; ++j)
 190     {
 191         ok = false;
 192         for (size_t i = 0; i < nentries; ++i)
 193         {
 194             char* field = wide_string_to_UTF8(il_str->get(j));
 195             if (strcmp(field, entry[i]) == 0)
 196             {
 197                 dyn_char->set(j + 1, entry[i]);
 198
 199                 ok = true;
 200                 FREE(field);
 201                 break;
 202             }
 203             FREE(field);
 204         }
 205
 206         // If failed then display an error message and exit
 207         if (!ok)
 208         {
 209             Scierror(999, _("%s: Undefined field in string matrix position: %d.\n"), funname.data(), j + 1);
 210             dyn_char->killMe();
 211             return types::Function::Error;
 212         }
 213     }
 214
 215     // Preparing the return
 216     types::TList* ret = new types::TList();
 217     ret->append(dyn_char); // Header for the returned tlist
 218
 219     types::InternalType* element; // Declare 'element' out of the loop to be able to return it alone in case il_str->getSize()==1
 220     for (int j = 0; j < m1 * n1; j++)
 221     {
 222         char* field = wide_string_to_UTF8(il_str->get(j));
 223
 224         /*****************************************************************
 225         * Entries that can be retrieved by 'il_state_save' global variable
 226         *****************************************************************/
 227         if (strcmp(field, "x") == 0)          /* Retrieve continuous state */
 228         {
 229             types::TList* il_state = get_il_state()->getAs<types::TList>();
 230             if (il_state->getSize() < 2)
 231             {
 232                 ok = false;
 233             }
 234             else
 235             {
 236                 element = il_state->get(1);
 237                 ok = true;
 238             }
 239         }
 240         else if (strcmp(field, "z") == 0)     /* Retrieve discrete state */
 241         {
 242             types::TList* il_state = get_il_state()->getAs<types::TList>();
 243             if (il_state->getSize() < 3)
 244             {
 245                 ok = false;
 246             }
 247             else
 248             {
 249                 element = il_state->get(2);
 250                 ok = true;
 251             }
 252         }
 253         else if (strcmp(field, "oz") == 0)    /* Retrieve object discrete state */
 254         {
 255             types::TList* il_state = get_il_state()->getAs<types::TList>();
 256             if (il_state->getSize() < 4)
 257             {
 258                 ok = false;
 259             }
 260             else
 261             {
 262                 element = il_state->get(3);
 263                 ok = true;
 264             }
 265         }
 266         else if (strcmp(field, "outtb") == 0) /* Retrieve outtb */
 267         {
 268             types::TList* il_state = get_il_state()->getAs<types::TList>();
 269             if (il_state->getSize() < 9)
 270             {
 271                 ok = false;
 272             }
 273             else
 274             {
 275                 element = il_state->get(8);
 276                 ok = true;
 277             }
 278         }
 279         else if (strcmp(field, "tevts") == 0) /* Retrieve tevts */
 280         {
 281             types::TList* il_state = get_il_state()->getAs<types::TList>();
 282             if (il_state->getSize() < 6)
 283             {
 284                 ok = false;
 285             }
 286             else
 287             {
 288                 element = il_state->get(5);
 289                 ok = true;
 290             }
 291         }
 292
 293         /*****************************************************************
 294         * Entries that can be retrieved by 'il_sim_save' global variable
 295         *****************************************************************/
 296         if (strcmp(field, "opar") == 0)       /* retrieve object parameters */
 297         {
 298             types::TList* il_sim = get_il_sim()->getAs<types::TList>();
 299             if (il_sim->getSize() < 15)
 300             {
 301                 ok = false;
 302             }
 303             else
 304             {
 305                 element = il_sim->get(14);
 306                 ok = true;
 307             }
 308         }
 309
 310         /*************************************************
 311         * int variables coming from import structure
 312         *************************************************/
 313         else if ((strcmp(field, "mod") == 0)      || /* retrieve mode */
 314                  (strcmp(field, "nmod") == 0)     || /* retrieve nmode */
 315                  (strcmp(field, "iz") == 0)       || /* label int code of blocks */
 316                  (strcmp(field, "nblk") == 0)     || /* number of block */
 317                  (strcmp(field, "izptr") == 0)    || /* label int code of blocks ptr*/
 318                  (strcmp(field, "outtbptr") == 0) || /* outtb ptr */
 319                  (strcmp(field, "outtbsz") == 0)  || /* outtb size */
 320                  (strcmp(field, "outtbtyp") == 0) || /* outtb type */
 321                  (strcmp(field, "nlnk") == 0)     || /* number of link */
 322                  (strcmp(field, "nsubs") == 0)    || /* length of nsubs */
 323                  (strcmp(field, "nevts") == 0)    || /* length of evtspt & tevts */
 324                  (strcmp(field, "niord") == 0)    || /* length of iord */
 325                  (strcmp(field, "noord") == 0)    || /* length of oord */
 326                  (strcmp(field, "nzord") == 0)    || /* length of zord */
 327                  (strcmp(field, "funptr") == 0)   || /* retrieve function ptr */
 328                  (strcmp(field, "ncord") == 0)    || /* retrieve ncord */
 329                  (strcmp(field, "nordptr") == 0)  || /* retrieve nordptr */
 330                  (strcmp(field, "iwa") == 0)      || /* retrieve iwa */
 331                  (strcmp(field, "ng") == 0)       || /* retrieve ng */
 332                  (strcmp(field, "nx") == 0)       || /* retrieve nx */
 333                  (strcmp(field, "nz") == 0)       || /* retrieve nz */
 334                  (strcmp(field, "noz") == 0)      || /* retrieve noz */
 335                  (strcmp(field, "ozptr") == 0)    || /* retrieve ozptr */
 336                  (strcmp(field, "ozsz") == 0)     || /* retrieve ozsz */
 337                  (strcmp(field, "oztyp") == 0)    || /* retrieve oztyp */
 338                  (strcmp(field, "nelem") == 0)    || /* retrieve nelem */
 339                  (strcmp(field, "xptr") == 0)     || /* retrieve xptr */
 340                  (strcmp(field, "zcptr") == 0)    || /* retrieve zcptr */
 341                  (strcmp(field, "zptr") == 0)     || /* retrieve zptr */
 342                  (strcmp(field, "rpptr") == 0)    || /* retrieve rpptr */
 343                  (strcmp(field, "ipar") == 0)     || /* retrieve ipar */
 344                  (strcmp(field, "ipptr") == 0)    || /* retrieve ipptr */
 345                  (strcmp(field, "opptr") == 0)    || /* retrieve opptr */
 346                  (strcmp(field, "oparsz") == 0)   || /* retrieve oparsz */
 347                  (strcmp(field, "opartyp") == 0)  || /* retrieve opartyp */
 348                  (strcmp(field, "inpptr") == 0)   || /* retrieve inpptr */
 349                  (strcmp(field, "outptr") == 0)   || /* retrieve outptr */
 350                  (strcmp(field, "inplnk") == 0)   || /* retrieve inplnk */
 351                  (strcmp(field, "outlnk") == 0)   || /* retrieve outlnk */
 352                  (strcmp(field, "subs") == 0)     || /* retrieve subs */
 353                  (strcmp(field, "iord") == 0)     || /* retrieve iord */
 354                  (strcmp(field, "oord") == 0)     || /* retrieve iord */
 355                  (strcmp(field, "zord") == 0)     || /* retrieve iord */
 356                  (strcmp(field, "funtyp") == 0)   || /* retrieve funtyp */
 357                  (strcmp(field, "ztyp") == 0)     || /* retrieve ztyp */
 358                  (strcmp(field, "cord") == 0)     || /* retrieve cord */
 359                  (strcmp(field, "ordclk") == 0)   || /* retrieve ordclk */
 360                  (strcmp(field, "clkcpr") == 0)   || /* retrieve clkcpr */
 361                  (strcmp(field, "ordptr") == 0)   || /* retrieve ordptr */
 362                  (strcmp(field, "critev") == 0)   || /* retrieve critev */
 363                  /* state */
 364                  (strcmp(field, "evtspt") == 0)   || /* retrieve evtspt */
 365                  (strcmp(field, "pointi") == 0)      /* retrieve nelem */
 366                 )
 367         {
 368             /* Retrieve dims and 'ptr' of asked array with getscicosvarsfromimport() */
 369             void* ptr = nullptr;
 370             int nv, mv;
 371             ok = getscicosvarsfromimport(field, &ptr, &nv, &mv) != 0;
 372
 373             if (ok)
 374             {
 375                 int* data;
 376                 element = new types::Int32(nv, mv, &data);
 377                 data = static_cast<int*>(ptr);
 378             }
 379         }
 380
 381         /*************************************************
 382         * double variables coming from import structure
 383         *************************************************/
 384         else if ((strcmp(field, "rpar") == 0)   || /* retrieve rpar      */
 385                  (strcmp(field, "g") == 0)      || /* retrieve g      */
 386                  (strcmp(field, "t0") == 0)     || /* retrieve t0     */
 387                  (strcmp(field, "tf") == 0)     || /* retrieve tf     */
 388                  (strcmp(field, "Atol") == 0)   || /* retrieve Atol   */
 389                  (strcmp(field, "rtol") == 0)   || /* retrieve rtol   */
 390                  (strcmp(field, "ttol") == 0)   || /* retrieve ttol   */
 391                  (strcmp(field, "deltat") == 0) || /* retrieve deltat */
 392                  (strcmp(field, "hmax") == 0)      /* retrieve hmax   */
 393                 )
 394         {
 395             /* Retrieve dims and 'ptr' of asked array with getscicosvarsfromimport() */
 396             void* ptr = nullptr;
 397             int nv, mv;
 398             ok = getscicosvarsfromimport(field, &ptr, &nv, &mv) != 0;
 399
 400             if (ok)
 401             {
 402                 double* data;
 403                 element = new types::Double(nv, mv, &data);
 404                 data = static_cast<double*>(ptr);
 405             }
 406         }
 407
 408         /*************************************************
 409         * scicos_block ptr coming from import structure
 410         *************************************************/
 411         else if (strcmp(field, "blocks") == 0)
 412         {
 413             /* Retrieve scicos_block 'ptr' of asked array with getscicosvarsfromimport() */
 414             void* ptr = nullptr;
 415             int nv, mv;
 416             ok = getscicosvarsfromimport(field, &ptr, &nv, &mv) != 0;
 417
 418             if (ok)
 419             {
 420                 /* Store ptr in ptrscs_blk */
 421                 scicos_block* ptr_scsblk = static_cast<scicos_block*>(ptr);
 422
 423                 /* Retrieve 'nblk' by import structure */
 424                 strcpy(field, "nblk");
 425                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 426                 int nblk = ((int*)ptr)[0];
 427
 428                 /* Retrieve 'ng' by import structure */
 429                 strcpy(field, "ng");
 430                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 431                 //int ng = ((int*)ptr)[0];
 432
 433                 /* Retrieve 'xptr' by import structure */
 434                 strcpy(field, "xptr");
 435                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 436                 int* xptr = ((int*)ptr);
 437
 438                 /* Retrieve 'zcptr' by import structure */
 439                 strcpy(field, "zcptr");
 440                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 441                 int* zcptr = ((int*)ptr);
 442
 443                 /* Retrieve 'x' and 'xd' by import structure */
 444                 strcpy(field, "x");
 445                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 446                 double* x = ((double*)ptr);
 447                 //double* xd = &x[xptr[nblk] - 1];
 448
 449                 /* Retrieve 'g' by import structure */
 450                 strcpy(field, "g");
 451                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 452                 double* g = ((double*)ptr);
 453
 454                 /* Retrieve 'funtyp' by import structure */
 455                 strcpy(field, "funtyp");
 456                 getscicosvarsfromimport(field, &ptr, &nv, &mv);
 457                 //int* funtyp = ((int*)ptr);
 458
 459                 for (int k = 0; k < nblk; ++k)
 460                 {
 461                     /* For each block, call createblklist() */
 462
 463                     /* Set 'flag_imp' <0 for createblklst() */
 464                     int i = -1;
 465
 466                     /* The following test is done in order to know if block k
 467                     * have been already called with callf in scicos.c
 468                     */
 469                     if (ptr_scsblk[k].nx != 0)
 470                     {
 471                         if (ptr_scsblk[k].x != &x[xptr[k] - 1])
 472                         {
 473                             /*fprintf(stderr,"k=%d,X,xd Non initialise",k);*/
 474                             /* Set 'flag_imp'=k for createblklst() <0 */
 475                             i = k;
 476                         }
 477                     }
 478                     if (ptr_scsblk[k].ng != 0)
 479                     {
 480                         if ((ptr_scsblk[k].g != &g[zcptr[k] - 1]) && (ptr_scsblk[k].g != &x[xptr[k] - 1]))
 481                         {
 482                             /*fprintf(stderr,"k=%d,g Non initialise",k);*/
 483                             /* Set 'flag_imp'=k for createblklst() <0 */
 484                             i = k;
 485                         }
 486                     }
 487                     /* Call createblklist() */
 488                     element = createblklist(&ptr_scsblk[k], i, k + 1);
 489                 }
 490             }
 491         }
 492
 493         /*******************************************
 494         * outtb_elem coming from import structure
 495         *******************************************/
 496         else if ((strcmp(field, "outtb_elem") == 0)) /* retrieve outtb_elem */
 497         {
 498             /* Retrieve dims and 'ptr' of asked array with getscicosvarsfromimport */
 499             void* ptr = nullptr;
 500             int nv, mv;
 501             ok = getscicosvarsfromimport(field, &ptr, &nv, &mv) != 0;
 502
 503             /* Check 'ok' flag */
 504             if (ok == true)
 505             {
 506                 int* data;
 507                 element = new types::Int32(nv, mv, &data);
 508                 outtb_el* ptr_elem = static_cast<outtb_el*>(ptr);
 509                 for (int i = 0; i < nv; ++i) /* Copy returned array in 'element' */
 510                 {
 511                     data[i] = ptr_elem[i].lnk + 1; /* +1 is for the connection with outtb list */
 512                     data[nv + i] = ptr_elem[i].pos + 1;
 513                 }
 514             }
 515         }
 516
 517         // If failed then display an error message.
 518         if (ok == false)
 519         {
 520             Scierror(999, _("%s: Error with parameter \"%s\".\n"), funname.data(), il_str->get(j));
 521             dyn_char->killMe();
 522             ret->killMe();
 523             FREE(field);
 524             return types::Function::Error;
 525         }
 526
 527         FREE(field);
 528         ret->append(element);
 529     }
 530
 531     if (il_str->getSize() == 1)
 532     {
 533         out.push_back(element);
 534         dyn_char->killMe();
 535         ret->killMe();
 536     }
 537     else
 538     {
 539         out.push_back(ret);
 540     }
 541     return types::Function::OK;
 542 }
 543