Xcos MVC: fix includes
[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 "createblklist.hxx"
27
28 #include "internal.hxx"
29 #include "callable.hxx"
30 #include "list.hxx"
31 #include "tlist.hxx"
32 #include "double.hxx"
33 #include "int.hxx"
34 #include "function.hxx"
35 #include "execvisitor.hxx"
36
37 extern "C"
38 {
39 #include "sciblk4.h"
40 #include "scicos.h"
41 #include "import.h"
42 }
43
44 /*--------------------------------------------------------------------------*/
45 template <typename T>
46 bool sci2var(T* p, void* dest, const int row, const int col)
47 {
48     const int size = p->getSize();
49     typename T::type* srcR = p->get();
50
51     if (row != p->getRows())
52     {
53         return false;
54     }
55
56     if (col != p->getCols())
57     {
58         return false;
59     }
60
61     if (p->isComplex())
62     {
63         typename T::type* srcI = p->getImg();
64         if (dest == nullptr)
65         {
66             return false;
67         }
68
69         typename T::type* destR = (typename T::type*)dest;
70         typename T::type* destI = destR + size;
71         for (int i = 0; i < size; ++i)
72         {
73             destR[i] = srcR[i];
74             destI[i] = srcI[i];
75         }
76     }
77     else
78     {
79         if (dest == nullptr)
80         {
81             return false;
82         }
83
84         typename T::type* destR = (typename T::type*)dest;
85         for (int i = 0; i < size; ++i)
86         {
87             destR[i] = srcR[i];
88         }
89     }
90
91     return true;
92 }
93
94 /*--------------------------------------------------------------------------*/
95 static bool sci2var(types::InternalType* p, void* dest, const int desttype, const int row, const int col)
96 {
97     switch (p->getType())
98     {
99         case types::InternalType::ScilabDouble:
100         {
101             if (p->getAs<types::Double>()->isComplex() && desttype == SCSCOMPLEX_N)
102             {
103                 return sci2var(p->getAs<types::Double>(), dest, row, col);
104             }
105
106             if (p->getAs<types::Double>()->isComplex() == false && desttype == SCSREAL_N)
107             {
108                 return sci2var(p->getAs<types::Double>(), dest, row, col);
109             }
110         }
111         case types::InternalType::ScilabInt8:
112         {
113             if (desttype == SCSINT8_N)
114             {
115                 return sci2var(p->getAs<types::Int8>(), dest, row, col);
116             }
117         }
118         case types::InternalType::ScilabInt16:
119         {
120             if (desttype == SCSINT16_N)
121             {
122                 return sci2var(p->getAs<types::Int16>(), dest, row, col);
123             }
124         }
125         case types::InternalType::ScilabInt32:
126         {
127             if (desttype == SCSINT32_N)
128             {
129                 return sci2var(p->getAs<types::Int32>(), dest, row, col);
130             }
131         }
132         case types::InternalType::ScilabUInt8:
133         {
134             if (desttype == SCSUINT8_N)
135             {
136                 return sci2var(p->getAs<types::UInt8>(), dest, row, col);
137             }
138         }
139         case types::InternalType::ScilabUInt16:
140         {
141             if (desttype == SCSUINT16_N)
142             {
143                 return sci2var(p->getAs<types::UInt16>(), dest, row, col);
144             }
145         }
146         case types::InternalType::ScilabUInt32:
147         {
148             if (desttype == SCSUINT32_N)
149             {
150                 return sci2var(p->getAs<types::UInt32>(), dest, row, col);
151             }
152         }
153     }
154
155     return false;
156 }
157
158 /*--------------------------------------------------------------------------*/
159 static bool getDoubleArray(types::InternalType* p, double* dest)
160 {
161     if (p == nullptr)
162     {
163         return false;
164     }
165
166     if (p->isDouble())
167     {
168         types::Double* d = p->getAs<types::Double>();
169         const int size = d->getSize();
170         if (size == 0)
171         {
172             return true;
173         }
174
175         if (dest == nullptr)
176         {
177             return false;
178         }
179
180         memcpy(dest, d->get(), sizeof(double) * size);
181         return true;
182     }
183
184     return false;
185 }
186
187 /*--------------------------------------------------------------------------*/
188 static bool getDoubleArrayAsInt(types::InternalType* p, int* dest)
189 {
190     if (p == nullptr)
191     {
192         return false;
193     }
194
195     if (p->isDouble())
196     {
197         types::Double* d = p->getAs<types::Double>();
198         const int size = d->getSize();
199         if (size == 0)
200         {
201             return true;
202         }
203
204         double* dbl = d->get();
205         for (int i = 0; i < size; ++i)
206         {
207             dest[i] = static_cast<int>(dbl[i]);
208         }
209         return true;
210     }
211
212     return false;
213 }
214
215 /*--------------------------------------------------------------------------*/
216 void sciblk4(scicos_block* Blocks, const int flag)
217 {
218     int ierr = 0;
219     /* Retrieve block number */
220     const int kfun = get_block_number();
221
222     /* Retrieve 'funtyp' by import structure */
223     int* ptr = nullptr;
224     int nv = 0, mv = 0;
225     char buf[] = "funtyp";
226     ierr = getscicosvarsfromimport(buf, (void**)&ptr, &nv, &mv);
227     if (ierr == 0)
228     {
229         set_block_error(-1);
230         return;
231     }
232     const int* const funtyp = (int *)ptr;
233
234     types::typed_list in, out;
235     types::optional_list opt;
236
237     /*****************************
238     * Create Scilab tlist Blocks *
239     *****************************/
240     types::InternalType* pIT = createblklist(Blocks, -1, funtyp[kfun - 1]);
241     if (pIT == nullptr)
242     {
243         set_block_error(-1);
244         return;
245     }
246
247     in.push_back(pIT);
248     /* * flag * */
249     in.push_back(new types::Double(flag));
250
251     /***********************
252     * Call Scilab function *
253     ***********************/
254     ast::ExecVisitor exec;
255     types::Callable* pCall = static_cast<types::Callable*>(Blocks->scsptr);
256
257     try
258     {
259         if (pCall->call(in, opt, 1, out, &exec) != 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 (ast::ScilabMessage& /*sm*/)
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                 InternalType* pIT = t->getField(L"outptr");
326                 if (pIT && pIT->isList())
327                 {
328                     types::List* lout = pIT->getAs<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                 InternalType* pIT = t->getField(L"outptr");
503                 if (pIT && pIT->isList())
504                 {
505                     types::List* lout = pIT->getAs<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 /*--------------------------------------------------------------------------*/