Scicos src: fix warning
[scilab.git] / scilab / modules / scicos / src / cpp / sciblk4.cpp
1 /*  Scicos
2 *
3 *  Copyright (C) 2015 - Scilab Enterprises - Antoine ELIAS
4 *  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 *
20 * See the file ./license.txt
21 */
22 /*--------------------------------------------------------------------------*/
23 #include <cstring>
24 #include <cstdio>
25
26 #include "internal.hxx"
27 #include "callable.hxx"
28 #include "list.hxx"
29 #include "tlist.hxx"
30 #include "double.hxx"
31 #include "int.hxx"
32 #include "function.hxx"
33
34 extern "C"
35 {
36 #include "sciblk4.h"
37 #include "scicos.h"
38 #include "import.h"
39 }
40
41 #include "createblklist.hxx"
42
43 /*--------------------------------------------------------------------------*/
44 template <typename T>
45 bool sci2var(T* p, void* dest, const int row, const int col)
46 {
47     const int size = p->getSize();
48     typename T::type* srcR = p->get();
49
50     if (row != p->getRows())
51     {
52         return false;
53     }
54
55     if (col != p->getCols())
56     {
57         return false;
58     }
59
60     if (p->isComplex())
61     {
62         typename T::type* srcI = p->getImg();
63         if (dest == nullptr)
64         {
65             return false;
66         }
67
68         typename T::type* destR = (typename T::type*)dest;
69         typename T::type* destI = destR + size;
70         for (int i = 0; i < size; ++i)
71         {
72             destR[i] = srcR[i];
73             destI[i] = srcI[i];
74         }
75     }
76     else
77     {
78         if (dest == nullptr)
79         {
80             return false;
81         }
82
83         typename T::type* destR = (typename T::type*)dest;
84         for (int i = 0; i < size; ++i)
85         {
86             destR[i] = srcR[i];
87         }
88     }
89
90     return true;
91 }
92
93 /*--------------------------------------------------------------------------*/
94 static bool sci2var(types::InternalType* p, void* dest, const int desttype, const int row, const int col)
95 {
96     switch (p->getType())
97     {
98         case types::InternalType::ScilabDouble:
99         {
100             if (p->getAs<types::Double>()->isComplex() && desttype == SCSCOMPLEX_N)
101             {
102                 return sci2var(p->getAs<types::Double>(), dest, row, col);
103             }
104
105             if (p->getAs<types::Double>()->isComplex() == false && desttype == SCSREAL_N)
106             {
107                 return sci2var(p->getAs<types::Double>(), dest, row, col);
108             }
109         }
110         case types::InternalType::ScilabInt8:
111         {
112             if (desttype == SCSINT8_N)
113             {
114                 return sci2var(p->getAs<types::Int8>(), dest, row, col);
115             }
116         }
117         case types::InternalType::ScilabInt16:
118         {
119             if (desttype == SCSINT16_N)
120             {
121                 return sci2var(p->getAs<types::Int16>(), dest, row, col);
122             }
123         }
124         case types::InternalType::ScilabInt32:
125         {
126             if (desttype == SCSINT32_N)
127             {
128                 return sci2var(p->getAs<types::Int32>(), dest, row, col);
129             }
130         }
131         case types::InternalType::ScilabUInt8:
132         {
133             if (desttype == SCSUINT8_N)
134             {
135                 return sci2var(p->getAs<types::UInt8>(), dest, row, col);
136             }
137         }
138         case types::InternalType::ScilabUInt16:
139         {
140             if (desttype == SCSUINT16_N)
141             {
142                 return sci2var(p->getAs<types::UInt16>(), dest, row, col);
143             }
144         }
145         case types::InternalType::ScilabUInt32:
146         {
147             if (desttype == SCSUINT32_N)
148             {
149                 return sci2var(p->getAs<types::UInt32>(), dest, row, col);
150             }
151         }
152         default:
153             return false;
154     }
155
156     return false;
157 }
158
159 /*--------------------------------------------------------------------------*/
160 static bool getDoubleArray(types::InternalType* p, double* dest)
161 {
162     if (p == nullptr)
163     {
164         return false;
165     }
166
167     if (p->isDouble())
168     {
169         types::Double* d = p->getAs<types::Double>();
170         const int size = d->getSize();
171         if (size == 0)
172         {
173             return true;
174         }
175
176         if (dest == nullptr)
177         {
178             return false;
179         }
180
181         memcpy(dest, d->get(), sizeof(double) * size);
182         return true;
183     }
184
185     return false;
186 }
187
188 /*--------------------------------------------------------------------------*/
189 static bool getDoubleArrayAsInt(types::InternalType* p, int* dest)
190 {
191     if (p == nullptr)
192     {
193         return false;
194     }
195
196     if (p->isDouble())
197     {
198         types::Double* d = p->getAs<types::Double>();
199         const int size = d->getSize();
200         if (size == 0)
201         {
202             return true;
203         }
204
205         double* dbl = d->get();
206         for (int i = 0; i < size; ++i)
207         {
208             dest[i] = static_cast<int>(dbl[i]);
209         }
210         return true;
211     }
212
213     return false;
214 }
215
216 /*--------------------------------------------------------------------------*/
217 void sciblk4(scicos_block* Blocks, const int flag)
218 {
219     int ierr = 0;
220     /* Retrieve block number */
221     const int kfun = get_block_number();
222
223     /* Retrieve 'funtyp' by import structure */
224     int* ptr = nullptr;
225     int nv = 0, mv = 0;
226     char buf[] = "funtyp";
227     ierr = getscicosvarsfromimport(buf, (void**)&ptr, &nv, &mv);
228     if (ierr == 0)
229     {
230         set_block_error(-1);
231         return;
232     }
233     const int* const funtyp = (int *)ptr;
234
235     types::typed_list in, out;
236     types::optional_list opt;
237
238     /*****************************
239     * Create Scilab tlist Blocks *
240     *****************************/
241     types::InternalType* pIT = createblklist(Blocks, -1, funtyp[kfun - 1]);
242     if (pIT == nullptr)
243     {
244         set_block_error(-1);
245         return;
246     }
247
248     in.push_back(pIT);
249     /* * flag * */
250     in.push_back(new types::Double(flag));
251
252     /***********************
253     * Call Scilab function *
254     ***********************/
255     types::Callable* pCall = static_cast<types::Callable*>(Blocks->scsptr);
256
257     try
258     {
259         if (pCall->call(in, opt, 1, out) != types::Function::OK)
260         {
261             set_block_error(-1);
262             return;
263         }
264
265         if (out.size() != 1)
266         {
267             set_block_error(-1);
268             return;
269         }
270     }
271     catch (const ast::InternalError& /*ie*/)
272     {
273         set_block_error(-1);
274         return;
275     }
276
277     pIT = out[0];
278     if (pIT->isTList() == false)
279     {
280         set_block_error(-1);
281         delete pIT;
282         return;
283     }
284
285     types::TList* t = pIT->getAs<types::TList>();
286
287     switch (flag)
288     {
289         /**************************
290         * update continuous state
291         **************************/
292         case 0:
293         {
294             if (Blocks->nx != 0)
295             {
296                 /* 14 - xd */
297                 if (getDoubleArray(t->getField(L"xd"), Blocks->xd) == false)
298                 {
299                     t->killMe();
300                     set_block_error(-1);
301                     return;
302                 }
303
304                 if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
305                 {
306                     /* 15 - res */
307                     if (getDoubleArray(t->getField(L"res"), Blocks->res) == false)
308                     {
309                         t->killMe();
310                         set_block_error(-1);
311                         return;
312                     }
313                 }
314             }
315             break;
316         }
317         /**********************
318         * update output state
319         **********************/
320         case 1:
321         {
322             /* 21 - outptr */
323             if (Blocks->nout > 0)
324             {
325                 types::InternalType* pIT = t->getField(L"outptr");
326                 if (pIT && pIT->isList())
327                 {
328                     types::List* lout = pIT->getAs<types::List>();
329                     if (Blocks->nout == lout->getSize())
330                     {
331                         for (int i = 0; i < Blocks->nout; ++i)
332                         {
333                             //update data
334                             int row = Blocks->outsz[i];
335                             int col = Blocks->outsz[i + Blocks->nout];
336                             int type = Blocks->outsz[i + Blocks->nout * 2];
337                             if (sci2var(lout->get(i), Blocks->outptr[i], type, row, col) == false)
338                             {
339                                 t->killMe();
340                                 set_block_error(-1);
341                                 return;
342                             }
343                         }
344                     }
345                 }
346             }
347             break;
348         }
349         case 2:
350         {
351             /* 7 - z */
352             if (Blocks[0].nz != 0)
353             {
354                 if (getDoubleArray(t->getField(L"z"), Blocks->z) == false)
355                 {
356                     t->killMe();
357                     set_block_error(-1);
358                     return;
359                 }
360             }
361
362             /* 11 - oz */
363             //TODO : how to store object ?
364
365             if (Blocks[0].nx != 0)
366             {
367                 /* 13 - x */
368                 if (getDoubleArray(t->getField(L"x"), Blocks->x) == false)
369                 {
370                     t->killMe();
371                     set_block_error(-1);
372                     return;
373                 }
374
375                 /* 14 - xd */
376                 if (getDoubleArray(t->getField(L"xd"), Blocks->xd) == false)
377                 {
378                     t->killMe();
379                     set_block_error(-1);
380                     return;
381                 }
382             }
383
384             break;
385         }
386
387         /***************************
388         * update event output state
389         ***************************/
390         case 3:
391         {
392             /* 23 - evout */
393             if (getDoubleArray(t->getField(L"evout"), Blocks->evout) == false)
394             {
395                 t->killMe();
396                 set_block_error(-1);
397                 return;
398             }
399             break;
400         }
401         /**********************
402         * state initialisation
403         **********************/
404         case 4:
405         {
406             /* 7 - z */
407             if (Blocks[0].nz != 0)
408             {
409                 if (getDoubleArray(t->getField(L"z"), Blocks->z) == false)
410                 {
411                     t->killMe();
412                     set_block_error(-1);
413                     return;
414                 }
415             }
416
417             /* 11 - oz */
418             //TODO : how to store object ?
419
420             if (Blocks[0].nx != 0)
421             {
422                 /* 13 - x */
423                 if (getDoubleArray(t->getField(L"x"), Blocks->x) == false)
424                 {
425                     t->killMe();
426                     set_block_error(-1);
427                     return;
428                 }
429
430                 /* 14 - xd */
431                 if (getDoubleArray(t->getField(L"xd"), Blocks->xd) == false)
432                 {
433                     t->killMe();
434                     set_block_error(-1);
435                     return;
436                 }
437             }
438
439             break;
440         }
441
442         case 5:
443         {
444             /* 7 - z */
445             if (Blocks[0].nz != 0)
446             {
447                 if (getDoubleArray(t->getField(L"z"), Blocks->z) == false)
448                 {
449                     t->killMe();
450                     set_block_error(-1);
451                     return;
452                 }
453             }
454
455             /* 11 - oz */
456             //TODO : how to store object ?
457
458             break;
459         }
460
461         /*****************************
462         * output state initialisation
463         *****************************/
464         case 6:
465         {
466             /* 7 - z */
467             if (Blocks[0].nz != 0)
468             {
469                 if (getDoubleArray(t->getField(L"z"), Blocks->z) == false)
470                 {
471                     t->killMe();
472                     set_block_error(-1);
473                     return;
474                 }
475             }
476
477             /* 11 - oz */
478             //TODO : how to store object ?
479
480             if (Blocks[0].nx != 0)
481             {
482                 /* 13 - x */
483                 if (getDoubleArray(t->getField(L"x"), Blocks->x) == false)
484                 {
485                     t->killMe();
486                     set_block_error(-1);
487                     return;
488                 }
489
490                 /* 14 - xd */
491                 if (getDoubleArray(t->getField(L"xd"), Blocks->xd) == false)
492                 {
493                     t->killMe();
494                     set_block_error(-1);
495                     return;
496                 }
497             }
498
499             /* 21 - outptr */
500             if (Blocks->nout > 0)
501             {
502                 types::InternalType* pIT = t->getField(L"outptr");
503                 if (pIT && pIT->isList())
504                 {
505                     types::List* lout = pIT->getAs<types::List>();
506                     if (Blocks->nout == lout->getSize())
507                     {
508                         for (int i = 0; i < Blocks->nout; ++i)
509                         {
510                             //update data
511                             const int row = Blocks->outsz[i];
512                             const int col = Blocks->outsz[i + Blocks->nout];
513                             const int type = Blocks->outsz[i + Blocks->nout * 2];
514                             if (sci2var(lout->get(i), Blocks->outptr[i], type, row, col) == false)
515                             {
516                                 t->killMe();
517                                 set_block_error(-1);
518                                 return;
519                             }
520                         }
521                     }
522                 }
523             }
524             break;
525         }
526
527         /*******************************************
528         * define property of continuous time states
529         * (algebraic or differential states)
530         *******************************************/
531         case 7:
532         {
533             if (Blocks[0].nx != 0)
534             {
535                 /* 40 - xprop */
536                 if (getDoubleArrayAsInt(t->getField(L"xprop"), Blocks->xprop) == false)
537                 {
538                     t->killMe();
539                     set_block_error(-1);
540                     return;
541                 }
542             }
543             break;
544         }
545
546         /****************************
547         * zero crossing computation
548         ****************************/
549         case 9:
550         {
551             /* 33 - g */
552             if (getDoubleArray(t->getField(L"g"), Blocks->g) == false)
553             {
554                 t->killMe();
555                 set_block_error(-1);
556                 return;
557             }
558
559             if (get_phase_simulation() == 1)
560             {
561                 /* 39 - mode */
562                 if (getDoubleArrayAsInt(t->getField(L"mode"), Blocks->mode) == false)
563                 {
564                     t->killMe();
565                     set_block_error(-1);
566                     return;
567                 }
568             }
569             break;
570         }
571         /**********************
572         * Jacobian computation
573         **********************/
574         case 10:
575         {
576             if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
577             {
578                 /* 15 - res */
579                 if (getDoubleArray(t->getField(L"res"), Blocks->res) == false)
580                 {
581                     t->killMe();
582                     set_block_error(-1);
583                     return;
584                 }
585             }
586             break;
587         }
588     }
589
590     t->killMe();
591     return;
592 }
593 /*--------------------------------------------------------------------------*/