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