45109a2e08460da1cb2e5af81dd84d01bdceff16
[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 = nullptr;
255     if (flag == 4) // Initialization
256     {
257         pIT = createblklist(blk, -1, funtyp[kfun - 1]);
258         if (pIT == nullptr)
259         {
260             set_block_error(-1);
261             return;
262         }
263         *blk->work = pIT;
264         pIT->IncreaseRef();
265     }
266     else
267     {
268         pIT = *(types::InternalType**) blk->work;
269     }
270
271     if (flag == 5) // Ending
272     {
273         pIT->DecreaseRef();
274     }
275     else // any other flag might use refreshed values
276     {
277         pIT = refreshblklist(pIT, blk, -1, funtyp[kfun - 1]);
278     }
279
280     in.push_back(pIT);
281     /* * flag * */
282     in.push_back(new types::Double(flag));
283
284     /***********************
285     * Call Scilab function *
286     ***********************/
287     types::Callable* pCall = static_cast<types::Callable*>(blk->scsptr);
288
289     ConfigVariable::where_begin(1, 1, pCall);
290     types::Callable::ReturnValue Ret;
291
292     try
293     {
294         Ret = pCall->call(in, opt, 1, out);
295         ConfigVariable::where_end();
296         ConfigVariable::decreaseRecursion();
297
298         if (Ret != types::Callable::OK)
299         {
300             set_block_error(-1);
301             return;
302         }
303
304         if (out.size() != 1)
305         {
306             set_block_error(-1);
307             return;
308         }
309     }
310     catch (const ast::InternalError &)
311     {
312         std::wostringstream ostr;
313         ConfigVariable::whereErrorToString(ostr);
314
315         bool oldSilentError = ConfigVariable::isSilentError();
316         ConfigVariable::setSilentError(false);
317         scilabErrorW(ostr.str().c_str());
318         ConfigVariable::setSilentError(oldSilentError);
319         ConfigVariable::resetWhereError();
320
321         ConfigVariable::where_end();
322         ConfigVariable::setLastErrorFunction(pCall->getName());
323         ConfigVariable::decreaseRecursion();
324
325         set_block_error(-1);
326         throw;
327     }
328
329     pIT = out[0];
330     if (pIT->isTList() == false)
331     {
332         set_block_error(-1);
333         delete pIT;
334         return;
335     }
336
337     types::TList* t = pIT->getAs<types::TList>();
338
339     switch (flag)
340     {
341         /**************************
342         * update continuous state
343         **************************/
344         case 0:
345         {
346             if (blk->nx != 0)
347             {
348                 /* 14 - xd */
349                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
350                 {
351                     t->killMe();
352                     set_block_error(-1);
353                     return;
354                 }
355
356                 if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
357                 {
358                     /* 15 - res */
359                     if (getDoubleArray(t->getField(L"res"), blk->res) == false)
360                     {
361                         t->killMe();
362                         set_block_error(-1);
363                         return;
364                     }
365                 }
366             }
367             break;
368         }
369         /**********************
370         * update output state
371         **********************/
372         case 1:
373         {
374             /* 21 - outptr */
375             if (blk->nout > 0)
376             {
377                 types::InternalType* pIT = t->getField(L"outptr");
378                 if (pIT && pIT->isList())
379                 {
380                     types::List* lout = pIT->getAs<types::List>();
381                     if (blk->nout == lout->getSize())
382                     {
383                         for (int i = 0; i < blk->nout; ++i)
384                         {
385                             //update data
386                             int row = blk->outsz[i];
387                             int col = blk->outsz[i + blk->nout];
388                             int type = blk->outsz[i + blk->nout * 2];
389                             if (sci2var(lout->get(i), blk->outptr[i], type, row, col) == false)
390                             {
391                                 t->killMe();
392                                 set_block_error(-1);
393                                 return;
394                             }
395                         }
396                     }
397                 }
398             }
399             break;
400         }
401         case 2:
402         {
403             /* 7 - z */
404             if (blk->nz != 0)
405             {
406                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
407                 {
408                     t->killMe();
409                     set_block_error(-1);
410                     return;
411                 }
412             }
413
414             /* 11 - oz */
415             if (blk->noz != 0)
416             {
417                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
418                 {
419                     t->killMe();
420                     set_block_error(-1);
421                     return;
422                 }
423             }
424
425             if (blk->nx != 0)
426             {
427                 /* 13 - x */
428                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
429                 {
430                     t->killMe();
431                     set_block_error(-1);
432                     return;
433                 }
434
435                 /* 14 - xd */
436                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
437                 {
438                     t->killMe();
439                     set_block_error(-1);
440                     return;
441                 }
442             }
443
444             break;
445         }
446
447         /***************************
448         * update event output state
449         ***************************/
450         case 3:
451         {
452             /* 23 - evout */
453             if (getDoubleArray(t->getField(L"evout"), blk->evout) == false)
454             {
455                 t->killMe();
456                 set_block_error(-1);
457                 return;
458             }
459             break;
460         }
461         /**********************
462         * state initialisation
463         **********************/
464         case 4:
465         {
466             /* 7 - z */
467             if (blk->nz != 0)
468             {
469                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
470                 {
471                     t->killMe();
472                     set_block_error(-1);
473                     return;
474                 }
475             }
476
477             /* 11 - oz */
478             if (blk->noz != 0)
479             {
480                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
481                 {
482                     t->killMe();
483                     set_block_error(-1);
484                     return;
485                 }
486             }
487
488             if (blk->nx != 0)
489             {
490                 /* 13 - x */
491                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
492                 {
493                     t->killMe();
494                     set_block_error(-1);
495                     return;
496                 }
497
498                 /* 14 - xd */
499                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
500                 {
501                     t->killMe();
502                     set_block_error(-1);
503                     return;
504                 }
505             }
506
507             break;
508         }
509
510         case 5:
511         {
512             /* 7 - z */
513             if (blk->nz != 0)
514             {
515                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
516                 {
517                     t->killMe();
518                     set_block_error(-1);
519                     return;
520                 }
521             }
522
523             /* 11 - oz */
524             if (blk->noz != 0)
525             {
526                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
527                 {
528                     t->killMe();
529                     set_block_error(-1);
530                     return;
531                 }
532             }
533
534             break;
535         }
536
537         /*****************************
538         * output state initialisation
539         *****************************/
540         case 6:
541         {
542             /* 7 - z */
543             if (blk->nz != 0)
544             {
545                 if (getDoubleArray(t->getField(L"z"), blk->z) == false)
546                 {
547                     t->killMe();
548                     set_block_error(-1);
549                     return;
550                 }
551             }
552
553             /* 11 - oz */
554             if (blk->noz != 0)
555             {
556                 if (getOpaquePointer(t->getField(L"oz"), blk->ozptr) == false)
557                 {
558                     t->killMe();
559                     set_block_error(-1);
560                     return;
561                 }
562             }
563
564             if (blk->nx != 0)
565             {
566                 /* 13 - x */
567                 if (getDoubleArray(t->getField(L"x"), blk->x) == false)
568                 {
569                     t->killMe();
570                     set_block_error(-1);
571                     return;
572                 }
573
574                 /* 14 - xd */
575                 if (getDoubleArray(t->getField(L"xd"), blk->xd) == false)
576                 {
577                     t->killMe();
578                     set_block_error(-1);
579                     return;
580                 }
581             }
582
583             /* 21 - outptr */
584             if (blk->nout > 0)
585             {
586                 types::InternalType* pIT = t->getField(L"outptr");
587                 if (pIT && pIT->isList())
588                 {
589                     types::List* lout = pIT->getAs<types::List>();
590                     if (blk->nout == lout->getSize())
591                     {
592                         for (int i = 0; i < blk->nout; ++i)
593                         {
594                             //update data
595                             const int row = blk->outsz[i];
596                             const int col = blk->outsz[i + blk->nout];
597                             const int type = blk->outsz[i + blk->nout * 2];
598                             if (sci2var(lout->get(i), blk->outptr[i], type, row, col) == false)
599                             {
600                                 t->killMe();
601                                 set_block_error(-1);
602                                 return;
603                             }
604                         }
605                     }
606                 }
607             }
608             break;
609         }
610
611         /*******************************************
612         * define property of continuous time states
613         * (algebraic or differential states)
614         *******************************************/
615         case 7:
616         {
617             if (blk->nx != 0)
618             {
619                 /* 40 - xprop */
620                 if (getDoubleArrayAsInt(t->getField(L"xprop"), blk->xprop) == false)
621                 {
622                     t->killMe();
623                     set_block_error(-1);
624                     return;
625                 }
626             }
627             break;
628         }
629
630         /****************************
631         * zero crossing computation
632         ****************************/
633         case 9:
634         {
635             /* 33 - g */
636             if (getDoubleArray(t->getField(L"g"), blk->g) == false)
637             {
638                 t->killMe();
639                 set_block_error(-1);
640                 return;
641             }
642
643             if (get_phase_simulation() == 1)
644             {
645                 /* 39 - mode */
646                 if (getDoubleArrayAsInt(t->getField(L"mode"), blk->mode) == false)
647                 {
648                     t->killMe();
649                     set_block_error(-1);
650                     return;
651                 }
652             }
653             break;
654         }
655         /**********************
656         * Jacobian computation
657         **********************/
658         case 10:
659         {
660             if ((funtyp[kfun - 1] == 10004) || (funtyp[kfun - 1] == 10005))
661             {
662                 /* 15 - res */
663                 if (getDoubleArray(t->getField(L"res"), blk->res) == false)
664                 {
665                     t->killMe();
666                     set_block_error(-1);
667                     return;
668                 }
669             }
670             break;
671         }
672     }
673
674     t->killMe();
675     return;
676 }
677 /*--------------------------------------------------------------------------*/