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