Xcos MVC: fix includes
[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, 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 (*nout != 0)
175             {
176                 if (!out[4]->isList())
177                 {
178                     setErrAndFree(-1, out);
179                     return;
180                 }
181                 types::List* Yout = out[4]->getAs<types::List>();
182                 if (Yout->getSize() < *nout)
183                 {
184                     // Consider that 'outptr' has not been defined in the macro: do not update the current 'outptr'
185                     break;
186                 }
187                 for (int k = *nout - 1; k >= 0; --k)
188                 {
189                     if (!Yout->get(k)->isDouble())
190                     {
191                         setErrAndFree(-1, out);
192                         return;
193                     }
194                     types::Double* KthElement = Yout->get(k)->getAs<types::Double>();
195                     double* y = (double*)outptr[k];
196                     int ny = outsz[k];
197                     int ny2 = 1;
198                     if (*flag == 1)
199                     {
200                         ny2 = outsz[*nout + k];
201                     }
202                     memcpy(y, KthElement->get(), ny * ny2 * sizeof(double));
203                 }
204             }
205             break;
206         }
207
208         case 0 :
209             /*  x'  computation */
210         {
211             if (!out[0]->isDouble())
212             {
213                 setErrAndFree(-1, out);
214                 return;
215             }
216             types::Double* XDout = out[0]->getAs<types::Double>();
217             memcpy(xd, XDout->get(), *nx * sizeof(double));
218             break;
219         }
220
221         case 3 :
222         {
223             if (!out[1]->isDouble())
224             {
225                 setErrAndFree(-1, out);
226                 return;
227             }
228             types::Double* Tout = out[1]->getAs<types::Double>();
229             memcpy(tvec, Tout->get(), *ntvec * sizeof(double));
230             break;
231         }
232
233         default :
234         {
235             setErrAndFree(-1, out);
236             return;
237         }
238     }
239
240     for (size_t i = 0; i < out.size(); ++i)
241     {
242         out[i]->killMe();
243     }
244 }