* Bug 16365 fixed: median(m,'r'|'c') was wrong after 5dc990
[scilab.git] / scilab / modules / scicos / src / cpp / extractblklist.cpp
1 /*  Scicos
2 *
3 *  Copyright (C) INRIA - Alan LAYEC
4 *  Copyright (C) 2013 - Scilab Enterprises - Clement DAVID
5 *  Copyright (C) 2015 - Scilab Enterprises - Antoine ELIAS
6 *  Copyright (C) 2018 - ESI Group - Antoine ELIAS
7 *
8 * This program is free software; you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation; either version 2 of the License, or
11 * (at your option) any later version.
12 *
13 * This program is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 * GNU General Public License for more details.
17 *
18 * You should have received a copy of the GNU General Public License
19 * along with this program; if not, write to the Free Software
20 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21 *
22 * See the file ./license.txt
23 */
24 /*--------------------------------------------------------------------------*/
25 #include <cstring>
26
27 #include "internal.hxx"
28 #include "list.hxx"
29 #include "tlist.hxx"
30 #include "double.hxx"
31 #include "string.hxx"
32 #include "int.hxx"
33
34 extern "C"
35 {
36 #include "scicos_block4.h"
37 #include "charEncoding.h"
38 }
39
40 #include "extractblklist.hxx"
41
42 /*--------------------------------------------------------------------------*/
43
44 template <typename T>
45 bool sci2var(T* p, void** dest)
46 {
47     const int size = p->getSize();
48     typename T::type* srcR = p->get();
49
50     if (p->isComplex())
51     {
52         typename T::type* srcI = p->getImg();
53         *dest = (typename T::type*)MALLOC(sizeof(typename T::type) * size * 2);
54         if (*dest == nullptr)
55         {
56             return false;
57         }
58
59         typename T::type* destR = (typename T::type*)*dest;
60         typename T::type* destI = destR + size;
61         for (int i = 0; i < size; ++i)
62         {
63             destR[i] = srcR[i];
64             destI[i] = srcI[i];
65         }
66     }
67     else
68     {
69         *dest = (typename T::type*)MALLOC(sizeof(typename T::type) * size);
70         if (*dest == nullptr)
71         {
72             return false;
73         }
74
75         typename T::type* destR = (typename T::type*)*dest;
76         for (int i = 0; i < size; ++i)
77         {
78             destR[i] = srcR[i];
79         }
80     }
81
82     return true;
83 }
84
85 static bool sci2var(types::InternalType* p, void** dest)
86 {
87     *dest = nullptr;
88     switch (p->getType())
89     {
90         case types::InternalType::ScilabDouble:
91         {
92             return sci2var(p->getAs<types::Double>(), dest);
93         }
94         case types::InternalType::ScilabInt8:
95         {
96             return sci2var(p->getAs<types::Int8>(), dest);
97         }
98         case types::InternalType::ScilabInt16:
99         {
100             return sci2var(p->getAs<types::Int16>(), dest);
101         }
102         case types::InternalType::ScilabInt32:
103         {
104             return sci2var(p->getAs<types::Int32>(), dest);
105         }
106         case types::InternalType::ScilabInt64:
107         {
108             return sci2var(p->getAs<types::Int64>(), dest);
109         }
110         case types::InternalType::ScilabUInt8:
111         {
112             return sci2var(p->getAs<types::UInt8>(), dest);
113         }
114         case types::InternalType::ScilabUInt16:
115         {
116             return sci2var(p->getAs<types::UInt16>(), dest);
117         }
118         case types::InternalType::ScilabUInt32:
119         {
120             return sci2var(p->getAs<types::UInt32>(), dest);
121         }
122         case types::InternalType::ScilabUInt64:
123         {
124             return sci2var(p->getAs<types::UInt64>(), dest);
125         }
126         default:
127             return false;
128     }
129
130     return false;
131 }
132
133 static bool getString(types::InternalType* p, char** dest)
134 {
135     *dest = nullptr;
136
137     if (p == nullptr)
138     {
139         return false;
140     }
141
142     if (p->isString())
143     {
144         types::String* s = p->getAs<types::String>();
145         if (s->isScalar())
146         {
147             *dest = wide_string_to_UTF8(s->get()[0]);
148             return true;
149         }
150     }
151     return false;
152 }
153
154 static bool getDoubleArray(types::InternalType* p, double** dest, const int size)
155 {
156     *dest = nullptr;
157
158     if (p == nullptr)
159     {
160         return false;
161     }
162
163     if (p->isDouble())
164     {
165         types::Double* d = p->getAs<types::Double>();
166         if (d->getSize() == size)
167         {
168             if (size == 0)
169             {
170                 return true;
171             }
172
173             *dest = (double*)MALLOC(sizeof(double) * size);
174             if (*dest == nullptr)
175             {
176                 return false;
177             }
178             memcpy(*dest, d->get(), sizeof(double) * size);
179             return true;
180         }
181     }
182
183     return false;
184 }
185
186 static bool getDoubleArrayAsInt(types::InternalType* p, int** dest, const int size)
187 {
188     *dest = nullptr;
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         if (d->getSize() == size)
199         {
200             if (size == 0)
201             {
202                 return true;
203             }
204
205             const double* const dbl = d->get();
206             *dest = (int*)MALLOC(sizeof(int) * size);
207             if (*dest == nullptr)
208             {
209                 return false;
210             }
211
212             for (int i = 0; i < size; ++i)
213             {
214                 (*dest)[i] = static_cast<int>(dbl[i]);
215             }
216             return true;
217         }
218     }
219
220     return false;
221 }
222
223 static bool getDoubleAsInt(types::InternalType* p, int* dest)
224 {
225     if (p == nullptr)
226     {
227         return false;
228     }
229
230     if (p->isDouble())
231     {
232         types::Double* d = p->getAs<types::Double>();
233         if (d->isScalar())
234         {
235             *dest = static_cast<int>(d->get()[0]);
236             return true;
237         }
238     }
239     return false;
240 }
241
242 static bool checkType(const int type, types::InternalType* p)
243 {
244     if (p == nullptr)
245     {
246         return false;
247     }
248
249     switch (type)
250     {
251         case 10:
252             if (p->isDouble())
253             {
254                 return true;
255             }
256         case 11:
257             if (p->isDouble() && p->getAs<types::Double>()->isComplex())
258             {
259                 return true;
260             }
261         case 81:
262             if (p->isInt8())
263             {
264                 return true;
265             }
266         case 82:
267             if (p->isInt16())
268             {
269                 return true;
270             }
271         case 84:
272             if (p->isInt32())
273             {
274                 return true;
275             }
276         case 811:
277             if (p->isUInt8())
278             {
279                 return true;
280             }
281         case 812:
282             if (p->isUInt16())
283             {
284                 return true;
285             }
286         case 814:
287             if (p->isUInt32())
288             {
289                 return true;
290             }
291     }
292
293     return false;
294 }
295
296 bool extractblklist(types::TList* t, scicos_block* const Block)
297 {
298     types::InternalType* pIT = nullptr;
299
300     /* 2 - nevprt */
301     if (getDoubleAsInt(t->getField(L"nevprt"), &Block->nevprt) == false)
302     {
303         return false;
304     }
305
306     /* 3 - funpt */
307     //function ptr hide in double*
308     pIT = t->getField(L"funpt");
309     if (pIT->isDouble())
310     {
311         types::Double* d = pIT->getAs<types::Double>();
312         Block->funpt = (voidg)(long long)d->get()[0];
313     }
314
315     /* 4 - type */
316     if (getDoubleAsInt(t->getField(L"type"), &Block->type) == false)
317     {
318         return false;
319     }
320
321     /* 5 - scsptr */
322     //function ptr hide in double*
323     pIT = t->getField(L"scsptr");
324     if (pIT->isDouble())
325     {
326         types::Double* d = pIT->getAs<types::Double>();
327         Block->scsptr = (void*)(long long)d->get()[0];
328     }
329
330     /* 6 - nz */
331     if (getDoubleAsInt(t->getField(L"nz"), &Block->nz) == false)
332     {
333         return false;
334     }
335
336     /* 7 - z */
337     if (getDoubleArray(t->getField(L"z"), &Block->z, Block->nz) == false)
338     {
339         return false;
340     }
341
342     /* 8 - noz */
343     if (getDoubleAsInt(t->getField(L"noz"), &Block->noz) == false)
344     {
345         return false;
346     }
347
348     /* 9 - ozsz */
349     if (getDoubleArrayAsInt(t->getField(L"ozsz"), &Block->ozsz, Block->noz * 2) == false)
350     {
351         return false;
352     }
353
354     /* 10 - oztyp */
355     if (getDoubleArrayAsInt(t->getField(L"oztyp"), &Block->ozsz, Block->noz) == false)
356     {
357         return false;
358     }
359
360     /* 11 - oz */
361     pIT = t->getField(L"oz");
362     if (pIT->isList() && Block->noz > 0)
363     {
364         types::List* ozptr = pIT->getAs<types::List>();
365         if (ozptr->getSize() != Block->noz)
366         {
367             return false;
368         }
369
370         Block->ozptr = (void**)MALLOC(sizeof(void*) * Block->noz);
371         if (Block->ozptr == nullptr)
372         {
373             return false;
374         }
375
376         for (int i = 0; i < Block->noz; ++i)
377         {
378             pIT = ozptr->get(i);
379             if (checkType(Block->oztyp[i], pIT) == false)
380             {
381                 return false;
382             }
383
384             if (sci2var(pIT, &Block->ozptr[i]) == false)
385             {
386                 return false;
387             }
388         }
389     }
390
391     /* 12 - nx */
392     if (getDoubleAsInt(t->getField(L"nx"), &Block->nx) == false)
393     {
394         return false;
395     }
396
397     /* 13 - x */
398     if (getDoubleArray(t->getField(L"x"), &Block->x, Block->nx) == false)
399     {
400         return false;
401     }
402
403     /* 14 - xd */
404     if (getDoubleArray(t->getField(L"xd"), &Block->xd, Block->nx) == false)
405     {
406         return false;
407     }
408
409     /* 15 - res */
410     if (getDoubleArray(t->getField(L"res"), &Block->res, Block->nx) == false)
411     {
412         return false;
413     }
414
415     /* 16 - nin */
416     if (getDoubleAsInt(t->getField(L"nin"), &Block->nin) == false)
417     {
418         return false;
419     }
420
421     /* 17 - insz */
422     if (getDoubleArrayAsInt(t->getField(L"insz"), &Block->insz, Block->nin * 3) == false)
423     {
424         return false;
425     }
426
427     /* 18 - inptr */
428     pIT = t->getField(L"inptr");
429     if (pIT->isList() && Block->nin > 0)
430     {
431         types::List* inptr = pIT->getAs<types::List>();
432         if (inptr->getSize() != Block->nin)
433         {
434             return false;
435         }
436
437         Block->inptr = (void**)MALLOC(sizeof(void*) * Block->nin);
438         if (Block->inptr == nullptr)
439         {
440             return false;
441         }
442
443         for (int i = 0; i < Block->nin; ++i)
444         {
445             pIT = inptr->get(i);
446             if (checkType(Block->insz[2 * Block->nin + i], pIT) == false)
447             {
448                 return false;
449             }
450
451             if (sci2var(pIT, &Block->inptr[i]) == false)
452             {
453                 return false;
454             }
455         }
456     }
457
458     /* 19 - nout */
459     if (getDoubleAsInt(t->getField(L"nout"), &Block->nout) == false)
460     {
461         return false;
462     }
463
464     /* 20 - outsz */
465     if (getDoubleArrayAsInt(t->getField(L"outsz"), &Block->outsz, Block->nout * 3) == false)
466     {
467         return false;
468     }
469
470     /* 21 - outptr */
471     pIT = t->getField(L"outptr");
472     if (pIT->isList() && Block->nout > 0)
473     {
474         types::List* outptr = pIT->getAs<types::List>();
475         if (outptr->getSize() != Block->nout)
476         {
477             return false;
478         }
479
480         Block->outptr = (void**)MALLOC(sizeof(void*) * Block->nout);
481         if (Block->outptr == nullptr)
482         {
483             return false;
484         }
485
486         for (int i = 0; i < Block->nout; ++i)
487         {
488             pIT = outptr->get(i);
489             if (checkType(Block->outsz[2 * Block->nout + i], pIT) == false)
490             {
491                 return false;
492             }
493
494             if (sci2var(pIT, &Block->outptr[i]) == false)
495             {
496                 return false;
497             }
498         }
499     }
500
501     /* 22 - nevout */
502     if (getDoubleAsInt(t->getField(L"nevout"), &Block->nevout) == false)
503     {
504         return false;
505     }
506
507     /* 23 - evout */
508     if (getDoubleArray(t->getField(L"evout"), &Block->evout, Block->nevout) == false)
509     {
510         return false;
511     }
512
513     /* 24 - nrpar */
514     if (getDoubleAsInt(t->getField(L"nrpar"), &Block->nrpar) == false)
515     {
516         return false;
517     }
518
519     /* 25 - rpar */
520     if (getDoubleArray(t->getField(L"rpar"), &Block->rpar, Block->nrpar) == false)
521     {
522         return false;
523     }
524
525     /* 26 - nipar */
526     if (getDoubleAsInt(t->getField(L"nipar"), &Block->nipar) == false)
527     {
528         return false;
529     }
530
531     /* 27 - ipar */
532     if (getDoubleArrayAsInt(t->getField(L"ipar"), &Block->ipar, Block->nipar) == false)
533     {
534         return false;
535     }
536
537     /* 28 - nopar */
538     if (getDoubleAsInt(t->getField(L"nopar"), &Block->nopar) == false)
539     {
540         return false;
541     }
542
543     /* 29 - oparsz */
544     if (getDoubleArrayAsInt(t->getField(L"oparsz"), &Block->oparsz, 2 * Block->nopar) == false)
545     {
546         return false;
547     }
548
549     /* 30 - opartyp */
550     if (getDoubleArrayAsInt(t->getField(L"opartyp"), &Block->opartyp, Block->nopar) == false)
551     {
552         return false;
553     }
554
555     /* 31 - opar */
556     pIT = t->getField(L"opar");
557     if (pIT->isList() && Block->nopar > 0)
558     {
559         types::List* opar = pIT->getAs<types::List>();
560         if (opar->getSize() != Block->nopar)
561         {
562             return false;
563         }
564
565         Block->oparptr = (void**)MALLOC(sizeof(void*) * Block->nopar);
566         if (Block->inptr == nullptr)
567         {
568             return false;
569         }
570
571         for (int i = 0; i < Block->nopar; ++i)
572         {
573             pIT = opar->get(i);
574             if (checkType(Block->opartyp[i], pIT) == false)
575             {
576                 return false;
577             }
578
579             if (sci2var(pIT, &Block->oparptr[i]) == false)
580             {
581                 return false;
582             }
583         }
584     }
585
586     /* 32 - ng */
587     if (getDoubleAsInt(t->getField(L"ng"), &Block->ng) == false)
588     {
589         return false;
590     }
591
592     /* 33 - g */
593     if (getDoubleArray(t->getField(L"g"), &Block->g, Block->ng) == false)
594     {
595         return false;
596     }
597
598     /* 34 - ztyp */
599     if (getDoubleAsInt(t->getField(L"ztyp"), &Block->ztyp) == false)
600     {
601         return false;
602     }
603
604     /* 35 - jroot */
605     if (getDoubleArrayAsInt(t->getField(L"jroot"), &Block->jroot, Block->ng) == false)
606     {
607         return false;
608     }
609
610     /* 36 - label */
611     if (getString(t->getField(L"label"), &Block->label) == false)
612     {
613         return false;
614     }
615
616     /* 37 - work*/
617     pIT = t->getField(L"work");
618     if (pIT->isDouble())
619     {
620         types::Double* d = pIT->getAs<types::Double>();
621         Block->work = (void**)(long long)d->get()[0];
622     }
623
624     /* 38 - nmode*/
625     if (getDoubleAsInt(t->getField(L"nmode"), &Block->nmode) == false)
626     {
627         return false;
628     }
629
630     /* 39 - mode */
631     if (getDoubleArrayAsInt(t->getField(L"mode"), &Block->mode, Block->nmode) == false)
632     {
633         return false;
634     }
635
636     /* 40 - xprop */
637     if (getDoubleArrayAsInt(t->getField(L"xprop"), &Block->xprop, Block->nx) == false)
638     {
639         return false;
640     }
641
642     return true;
643 }
644 /*--------------------------------------------------------------------------*/