f3831143f01d16471f6080921d3dc940c4058fd3
[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 #include "scilabWrite.hxx"
34
35 extern "C"
36 {
37 #include "sciblk4.h"
38 #include "scicos.h"
39 #include "import.h"
40 }
41
42 #include "createblklist.hxx"
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         default:
154             return false;
155     }
156
157     return false;
158 }
159
160 /*--------------------------------------------------------------------------*/
161 static bool getDoubleArray(types::InternalType* p, double* dest)
162 {
163     if (p == nullptr)
164     {
165         return false;
166     }
167
168     if (p->isDouble())
169     {
170         types::Double* d = p->getAs<types::Double>();
171         const int size = d->getSize();
172         if (size == 0)
173         {
174             return true;
175         }
176
177         if (dest == nullptr)
178         {
179             return false;
180         }
181
182         memcpy(dest, d->get(), sizeof(double) * size);
183         return true;
184     }
185
186     return false;
187 }
188
189 /*--------------------------------------------------------------------------*/
190 static bool getDoubleArrayAsInt(types::InternalType* p, int* dest)
191 {
192     if (p == nullptr)
193     {
194         return false;
195     }
196
197     if (p->isDouble())
198     {
199         types::Double* d = p->getAs<types::Double>();
200         const int size = d->getSize();
201         if (size == 0)
202         {
203             return true;
204         }
205
206         double* dbl = d->get();
207         for (int i = 0; i < size; ++i)
208         {
209             dest[i] = static_cast<int>(dbl[i]);
210         }
211         return true;
212     }
213
214     return false;
215 }
216
217 /*--------------------------------------------------------------------------*/
218 static bool getOpaquePointer(types::InternalType* p, void** dest)
219 {
220     if (p == nullptr)
221     {
222         return false;
223     }
224
225     *dest = p;
226     return true;
227 }
228
229 /*--------------------------------------------------------------------------*/
230 void sciblk4(scicos_block* blk, const int flag)
231 {
232     int ierr = 0;
233     /* Retrieve block number */
234     const int kfun = get_block_number();
235
236     /* Retrieve 'funtyp' by import structure */
237     int* ptr = nullptr;
238     int nv = 0, mv = 0;
239     char buf[] = "funtyp";
240     ierr = getscicosvarsfromimport(buf, (void**)&ptr, &nv, &mv);
241     if (ierr == 0)
242     {
243         set_block_error(-1);
244         return;
245     }
246     const int* const funtyp = (int *)ptr;
247
248     types::typed_list in, out;
249     types::optional_list opt;
250
251     /*****************************
252     * Create Scilab tlist Blocks *
253     *****************************/
254     types::InternalType* pIT = createblklist(blk, -1, funtyp[kfun - 1]);
255     if (pIT == nullptr)
256     {
257         set_block_error(-1);
258         return;
259     }
260
261     in.push_back(pIT);
262     /* * flag * */
263     in.push_back(new types::Double(flag));
264
265     /***********************
266     * Call Scilab function *
267     ***********************/
268     types::Callable* pCall = static_cast<types::Callable*>(blk->scsptr);
269
270     ConfigVariable::where_begin(1, 1, pCall);
271     types::Callable::ReturnValue Ret;
272
273     try
274     {
275         Ret = pCall->call(in, opt, 1, out);
276         ConfigVariable::where_end();
277         ConfigVariable::decreaseRecursion();
278
279         if (Ret != types::Callable::OK)
280         {
281             set_block_error(-1);
282             return;
283         }
284
285         if (out.size() != 1)
286         {
287             set_block_error(-1);
288             return;
289         }
290     }
291     catch (const ast::InternalError &)
292     {
293         std::wostringstream ostr;
294         ConfigVariable::whereErrorToString(ostr);
295
296         bool oldSilentError = ConfigVariable::isSilentError();
297         ConfigVariable::setSilentError(false);
298         scilabErrorW(ostr.str().c_str());
299         ConfigVariable::setSilentError(oldSilentError);
300         ConfigVariable::resetWhereError();
301
302         ConfigVariable::where_end();
303         ConfigVariable::setLastErrorFunction(pCall->getName());
304         ConfigVariable::decreaseRecursion();
305
306         set_block_error(-1);
307         throw;
308     }
309
310     pIT = out[0];
311     if (pIT->isTList() == false)
312     {
313         set_block_error(-1);
314         delete pIT;
315         return;
316     }
317
318     types::TList* t = pIT->getAs<types::TList>();
319
320     switch (flag)
321     {
322         /**************************
323         * update continuous state
324         **************************/
325         case 0:
326         {
327             if (blk->nx != 0)
328             {
329                 /* 14 - xd */
330                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
331                 {
332                     t->killMe();
333                     set_block_error(-1);
334                     return;
335                 }
336
337                 if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
338                 {
339                     /* 15 - res */
340                     if (getDoubleArray(t->getField(L"res"), blk->res) == false)
341                     {
342                         t->killMe();
343                         set_block_error(-1);
344                         return;
345                     }
346                 }
347             }
348             break;
349         }
350         /**********************
351         * update output state
352         **********************/
353         case 1:
354         {
355             /* 21 - outptr */
356             if (blk->nout > 0)
357             {
358                 types::InternalType* pIT = t->getField(L"outptr");
359                 if (pIT && pIT->isList())
360                 {
361                     types::List* lout = pIT->getAs<types::List>();
362                     if (blk->nout == lout->getSize())
363                     {
364                         for (int i = 0; i < blk->nout; ++i)
365                         {
366                             //update data
367                             int row = blk->outsz[i];
368                             int col = blk->outsz[i + blk->nout];
369                             int type = blk->outsz[i + blk->nout * 2];
370                             if (sci2var(lout->get(i), blk->outptr[i], type, row, col) == false)
371                             {
372                                 t->killMe();
373                                 set_block_error(-1);
374                                 return;
375                             }
376                         }
377                     }
378                 }
379             }
380             break;
381         }
382         case 2:
383         {
384             /* 7 - z */
385             if (blk->nz != 0)
386             {
387                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
388                 {
389                     t->killMe();
390                     set_block_error(-1);
391                     return;
392                 }
393             }
394
395             /* 11 - oz */
396             if (blk->noz != 0)
397             {
398                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
399                 {
400                     t->killMe();
401                     set_block_error(-1);
402                     return;
403                 }
404             }
405
406             if (blk->nx != 0)
407             {
408                 /* 13 - x */
409                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
410                 {
411                     t->killMe();
412                     set_block_error(-1);
413                     return;
414                 }
415
416                 /* 14 - xd */
417                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
418                 {
419                     t->killMe();
420                     set_block_error(-1);
421                     return;
422                 }
423             }
424
425             break;
426         }
427
428         /***************************
429         * update event output state
430         ***************************/
431         case 3:
432         {
433             /* 23 - evout */
434             if (getDoubleArray(t->getField(L"evout"), blk->evout) == false)
435             {
436                 t->killMe();
437                 set_block_error(-1);
438                 return;
439             }
440             break;
441         }
442         /**********************
443         * state initialisation
444         **********************/
445         case 4:
446         {
447             /* 7 - z */
448             if (blk->nz != 0)
449             {
450                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
451                 {
452                     t->killMe();
453                     set_block_error(-1);
454                     return;
455                 }
456             }
457
458             /* 11 - oz */
459             if (blk->noz != 0)
460             {
461                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
462                 {
463                     t->killMe();
464                     set_block_error(-1);
465                     return;
466                 }
467             }
468
469             if (blk->nx != 0)
470             {
471                 /* 13 - x */
472                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
473                 {
474                     t->killMe();
475                     set_block_error(-1);
476                     return;
477                 }
478
479                 /* 14 - xd */
480                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
481                 {
482                     t->killMe();
483                     set_block_error(-1);
484                     return;
485                 }
486             }
487
488             break;
489         }
490
491         case 5:
492         {
493             /* 7 - z */
494             if (blk->nz != 0)
495             {
496                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
497                 {
498                     t->killMe();
499                     set_block_error(-1);
500                     return;
501                 }
502             }
503
504             /* 11 - oz */
505             if (blk->noz != 0)
506             {
507                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
508                 {
509                     t->killMe();
510                     set_block_error(-1);
511                     return;
512                 }
513             }
514
515             break;
516         }
517
518         /*****************************
519         * output state initialisation
520         *****************************/
521         case 6:
522         {
523             /* 7 - z */
524             if (blk->nz != 0)
525             {
526                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
527                 {
528                     t->killMe();
529                     set_block_error(-1);
530                     return;
531                 }
532             }
533
534             /* 11 - oz */
535             if (blk->noz != 0)
536             {
537                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
538                 {
539                     t->killMe();
540                     set_block_error(-1);
541                     return;
542                 }
543             }
544
545             if (blk->nx != 0)
546             {
547                 /* 13 - x */
548                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
549                 {
550                     t->killMe();
551                     set_block_error(-1);
552                     return;
553                 }
554
555                 /* 14 - xd */
556                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
557                 {
558                     t->killMe();
559                     set_block_error(-1);
560                     return;
561                 }
562             }
563
564             /* 21 - outptr */
565             if (blk->nout > 0)
566             {
567                 types::InternalType* pIT = t->getField(L"outptr");
568                 if (pIT && pIT->isList())
569                 {
570                     types::List* lout = pIT->getAs<types::List>();
571                     if (blk->nout == lout->getSize())
572                     {
573                         for (int i = 0; i < blk->nout; ++i)
574                         {
575                             //update data
576                             const int row = blk->outsz[i];
577                             const int col = blk->outsz[i + blk->nout];
578                             const int type = blk->outsz[i + blk->nout * 2];
579                             if (sci2var(lout->get(i), blk->outptr[i], type, row, col) == false)
580                             {
581                                 t->killMe();
582                                 set_block_error(-1);
583                                 return;
584                             }
585                         }
586                     }
587                 }
588             }
589             break;
590         }
591
592         /*******************************************
593         * define property of continuous time states
594         * (algebraic or differential states)
595         *******************************************/
596         case 7:
597         {
598             if (blk->nx != 0)
599             {
600                 /* 40 - xprop */
601                 if (getDoubleArrayAsInt(t->getField(L"xprop"), blk->xprop) == false)
602                 {
603                     t->killMe();
604                     set_block_error(-1);
605                     return;
606                 }
607             }
608             break;
609         }
610
611         /****************************
612         * zero crossing computation
613         ****************************/
614         case 9:
615         {
616             /* 33 - g */
617             if (getDoubleArray(t->getField(L"g"), blk->g) == false)
618             {
619                 t->killMe();
620                 set_block_error(-1);
621                 return;
622             }
623
624             if (get_phase_simulation() == 1)
625             {
626                 /* 39 - mode */
627                 if (getDoubleArrayAsInt(t->getField(L"mode"), blk->mode) == false)
628                 {
629                     t->killMe();
630                     set_block_error(-1);
631                     return;
632                 }
633             }
634             break;
635         }
636         /**********************
637         * Jacobian computation
638         **********************/
639         case 10:
640         {
641             if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
642             {
643                 /* 15 - res */
644                 if (getDoubleArray(t->getField(L"res"), blk->res) == false)
645                 {
646                     t->killMe();
647                     set_block_error(-1);
648                     return;
649                 }
650             }
651             break;
652         }
653     }
654
655     t->killMe();
656     return;
657 }
658 /*--------------------------------------------------------------------------*/