Xcos blocks: make scifunc_block_m work
[scilab.git] / scilab / modules / scicos / src / cpp / sciblk2.cpp
1 /*  Scicos
2 *
3 *  Copyright (C) 2015 - Scilab Enterprises - Paul Bignier
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 <vector>
24 #include <algorithm>
25 #include <cstring>
26
27 #include "var2vec.hxx"
28 #include "vec2var.hxx"
29
30 #include "internal.hxx"
31 #include "callable.hxx"
32 #include "list.hxx"
33 #include "double.hxx"
34 #include "function.hxx"
35 #include "execvisitor.hxx"
36
37 extern "C"
38 {
39 #include "sciblk2.h"
40 #include "scicos.h" /* set_block_error() */
41 }
42
43 static double toDouble(const int i)
44 {
45     return static_cast<double>(i);
46 }
47
48 static void setErrAndFree(const int flag, types::typed_list out)
49 {
50     set_block_error(flag);
51     for (size_t i = 0; i < out.size(); ++i)
52     {
53         out[i]->killMe();
54     }
55 }
56
57 /*--------------------------------------------------------------------------*/
58 void sciblk2(int* flag, int* nevprt, double* t, double xd[], double x[], int* nx, double z[], int* nz, double tvec[], int* ntvec, double rpar[], int* nrpar,
59              int ipar[], int* nipar, double* inptr[], int insz[], int* nin, double* outptr[], int outsz[], int* nout, void* scsptr)
60 {
61     types::typed_list in(8), out;
62
63     types::Double* Flag = new types::Double(*flag);
64     in[0] = Flag;
65
66     types::Double* Nevprt = new types::Double(*nevprt);
67     in[1] = Nevprt;
68
69     types::Double* T = new types::Double(*t);
70     in[2] = T;
71
72     types::Double* X = new types::Double(*nx, 1);
73     memcpy(X->get(), x, *nx * sizeof(double));
74     in[3] = X;
75
76     types::InternalType* Z;
77     if (*nz == 0)
78     {
79         Z = types::Double::Empty();
80     }
81     else
82     {
83         if (!vec2var(std::vector<double>(z, z + *nz), Z))
84         {
85             setErrAndFree(-1, out);
86             return;
87         }
88         if (!Z->isDouble())
89         {
90             setErrAndFree(-1, out);
91             return;
92         }
93         //types::Double* Z = new types::Double(*nz, 1);
94         //memcpy(Z->get(), z, *nz * sizeof(double));
95     }
96     in[4] = Z->getAs<types::Double>();
97
98     types::Double* Rpar = new types::Double(*nrpar, 1);
99     memcpy(Rpar->get(), rpar, *nrpar * sizeof(double));
100     in[5] = Rpar;
101
102     // Treating 'ipar' differently because it is an int tab, unlike the other double ones
103     types::Double* Ipar = new types::Double(*nipar, 1);
104     std::transform(ipar, ipar + *nipar, Ipar->get(), toDouble);
105     in[6] = Ipar;
106
107     types::List* Nin = new types::List();
108     for (int i = 0; i < *nin; ++i)
109     {
110         int nu = insz[i];
111         int nu2 = insz[*nin + i];
112         types::Double* U = new types::Double(nu, nu2);
113         memcpy(U->get(), inptr[i], nu * nu2 * sizeof(double));
114         Nin->append(U);
115     }
116     in[7] = Nin;
117
118     /***********************
119     * Call Scilab function *
120     ***********************/
121     ast::ExecVisitor exec;
122     types::Callable* pCall = static_cast<types::Callable*>(scsptr);
123
124     try
125     {
126         types::optional_list opt;
127         if (pCall->call(in, opt, 5, out, &exec) != types::Function::OK)
128         {
129             setErrAndFree(-1, out);
130             return;
131         }
132
133         if (out.size() != 5)
134         {
135             setErrAndFree(-1, out);
136             return;
137         }
138     }
139     catch (ast::ScilabMessage& /*sm*/)
140     {
141         setErrAndFree(-1, out);
142         return;
143     }
144
145     switch (*flag)
146     {
147         case 1 :
148         case 2 :
149         case 4 :
150         case 5 :
151         case 6 :
152         {
153             if (!out[2]->isDouble())
154             {
155                 setErrAndFree(-1, out);
156                 return;
157             }
158             std::vector<double> Zout;
159             if (!var2vec(out[2], Zout))
160             {
161                 setErrAndFree(-1, out);
162                 return;
163             }
164             memcpy(z, &Zout[0], *nz * sizeof(double));
165
166             if (!out[3]->isDouble())
167             {
168                 setErrAndFree(-1, out);
169                 return;
170             }
171             types::Double* Xout = out[3]->getAs<types::Double>();
172             memcpy(x, Xout->get(), *nx * sizeof(double));
173
174             if (*flag == 1 || *flag == 6)
175             {
176                 if (*nout != 0)
177                 {
178                     if (!out[4]->isList())
179                     {
180                         setErrAndFree(-1, out);
181                         return;
182                     }
183                     types::List* Yout = out[4]->getAs<types::List>();
184                     if (Yout->getSize() < *nout)
185                     {
186                         // Consider that 'outptr' has not been defined in the macro: do not update the current 'outptr'
187                         break;
188                     }
189                     for (int k = *nout - 1; k >= 0; --k)
190                     {
191                         if (!Yout->get(k)->isDouble())
192                         {
193                             setErrAndFree(-1, out);
194                             return;
195                         }
196                         types::Double* KthElement = Yout->get(k)->getAs<types::Double>();
197                         double* y = (double*)outptr[k];
198                         int ny = outsz[k];
199                         int ny2 = 1;
200                         if (*flag == 1)
201                         {
202                             ny2 = outsz[*nout + k];
203                         }
204                         if (KthElement->getSize() != ny * ny2)
205                         {
206                             // At initialization (flag 6), the 'y' returned by the macro is not necessarily properly initialized.
207                             // In this case, do nothing to avoid copying corrupt data
208                             break;
209                         }
210                         memcpy(y, KthElement->get(), ny * ny2 * sizeof(double));
211                     }
212                 }
213             }
214             break;
215         }
216
217         case 0 :
218             /*  x'  computation */
219         {
220             if (!out[0]->isDouble())
221             {
222                 setErrAndFree(-1, out);
223                 return;
224             }
225             types::Double* XDout = out[0]->getAs<types::Double>();
226             memcpy(xd, XDout->get(), *nx * sizeof(double));
227             break;
228         }
229
230         case 3 :
231         {
232             if (!out[1]->isDouble())
233             {
234                 setErrAndFree(-1, out);
235                 return;
236             }
237             types::Double* Tout = out[1]->getAs<types::Double>();
238             memcpy(tvec, Tout->get(), *ntvec * sizeof(double));
239             break;
240         }
241
242         default :
243         {
244             setErrAndFree(-1, out);
245             return;
246         }
247     }
248
249     for (size_t i = 0; i < out.size(); ++i)
250     {
251         out[i]->killMe();
252     }
253 }