differential_equations: fix dasrt/dassl memleaks
[scilab.git] / scilab / modules / differential_equations / sci_gateway / cpp / sci_feval.cpp
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2011 - DIGITEO - Cedric DELAMARRE
4 *
5  * Copyright (C) 2012 - 2016 - Scilab Enterprises
6  *
7  * This file is hereby licensed under the terms of the GNU GPL v2.0,
8  * pursuant to article 5.3.4 of the CeCILL v.2.1.
9  * This file was originally licensed under the terms of the CeCILL v2.1,
10  * and continues to be available under such terms.
11  * For more information, see the COPYING file which you should have received
12  * along with this program.
13 *
14 */
15 /*--------------------------------------------------------------------------*/
16
17 #include "differential_equations_gw.hxx"
18 #include "function.hxx"
19 #include "double.hxx"
20 #include "string.hxx"
21 #include "list.hxx"
22 #include "callable.hxx"
23 #include "differentialequationfunctions.hxx"
24
25 extern "C"
26 {
27 #include "sci_malloc.h"
28 #include "localization.h"
29 #include "Scierror.h"
30 #include "sciprint.h"
31 #include "scifunctions.h"
32 #include "feval.h"
33 }
34
35 /*--------------------------------------------------------------------------*/
36 types::Function::ReturnValue sci_feval(types::typed_list &in, int _iRetCount, types::typed_list &out)
37 {
38     int iPos = 0;
39     int nn   = 1;
40     int iErr = 0;
41
42     //input
43     types::Double* pDblX = NULL;
44     types::Double* pDblY = NULL;
45
46     // output
47     types::Double* pDblOut = NULL;
48
49     // error message catched
50     std::wostringstream os;
51     bool bCatch = false;
52
53     // *** check the minimal number of input args. ***
54     if (in.size() < 2 || in.size() > 3)
55     {
56         Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "feval", 2, 3);
57         return types::Function::Error;
58     }
59
60     // *** check number of output args according the methode. ***
61     if (_iRetCount > 1)
62     {
63         Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "feval", 1);
64         return types::Function::Error;
65     }
66
67     // *** check type of input args and get it. ***
68     // X
69     if (in[iPos]->isDouble() == false)
70     {
71         Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
72         return types::Function::Error;
73     }
74     pDblX = in[iPos]->getAs<types::Double>();
75     if (pDblX->isComplex())
76     {
77         Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
78         return types::Function::Error;
79     }
80     iPos++;
81
82     // Y
83     if (in.size() == 3)
84     {
85         if (in[iPos]->isDouble() == false)
86         {
87             Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
88             return types::Function::Error;
89         }
90         pDblY = in[iPos]->getAs<types::Double>();
91         if (pDblY->isComplex())
92         {
93             Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
94             return types::Function::Error;
95         }
96         iPos++;
97         nn = 2;
98     }
99
100     // function
101     DifferentialEquationFunctions deFunctionsManager(L"feval");
102     DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
103
104     if (in[iPos]->isCallable())
105     {
106         types::Callable* pCall = in[iPos]->getAs<types::Callable>();
107         deFunctionsManager.setFFunction(pCall);
108     }
109     else if (in[iPos]->isString())
110     {
111         bool bOK = false;
112         types::String* pStr = in[iPos]->getAs<types::String>();
113         bOK = deFunctionsManager.setFFunction(pStr);
114
115         if (bOK == false)
116         {
117             char* pst = wide_string_to_UTF8(pStr->get(0));
118             Scierror(50, _("%s: Subroutine not found: %s\n"), "feval", pst);
119             FREE(pst);
120             DifferentialEquation::removeDifferentialEquationFunctions();
121             return types::Function::Error;
122         }
123     }
124     else if (in[iPos]->isList())
125     {
126         types::List* pList = in[iPos]->getAs<types::List>();
127
128         if (pList->getSize() == 0)
129         {
130             Scierror(50, _("%s: Argument #%d : Subroutine not found in list: %s\n"), "feval", iPos + 1, "(string empty)");
131             DifferentialEquation::removeDifferentialEquationFunctions();
132             return types::Function::Error;
133         }
134
135         if (pList->get(0)->isCallable())
136         {
137             deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
138             for (int iter = 1; iter < pList->getSize(); iter++)
139             {
140                 deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
141             }
142         }
143         else
144         {
145             Scierror(999, _("%s: Wrong type for input argument #%d : The first argument in the list must be a Scilab function.\n"), "feval", 4);
146             DifferentialEquation::removeDifferentialEquationFunctions();
147             return types::Function::Error;
148         }
149     }
150     else
151     {
152         Scierror(999, _("%s: Wrong type for input argument #%d : A function expected.\n"), "feval", iPos + 1);
153         DifferentialEquation::removeDifferentialEquationFunctions();
154         return types::Function::Error;
155     }
156
157     // *** Perform operation. ***
158     int itype       = 0; // output value
159     double* res     = (double*)MALLOC(2 * sizeof(double));
160     int sizeOfY     = pDblY ? pDblY->getSize() : 1;
161
162     if (nn == 2)
163     {
164         pDblOut = new types::Double(pDblX->getSize(), sizeOfY);
165     }
166     else
167     {
168         pDblOut = new types::Double(pDblX->getRows(), pDblX->getCols());
169     }
170
171     for (int y = 0; y < sizeOfY; y++)
172     {
173         for (int x = 0; x < pDblX->getSize(); x++)
174         {
175             double valX = pDblX->get(x);
176             // if pDblY == NULL, nn == 1 so valY will be never used.
177             double valY = pDblY ? pDblY->get(y) : 0;
178
179             try
180             {
181                 deFunctionsManager.execFevalF(&nn, &valX, &valY, res, &itype);
182             }
183             catch (ast::InternalError &ie)
184             {
185                 os << ie.GetErrorMessage();
186                 bCatch = true;
187             }
188
189             if (bCatch)
190             {
191                 DifferentialEquation::removeDifferentialEquationFunctions();
192                 FREE(res);
193                 delete pDblOut;
194
195                 wchar_t szError[bsiz];
196                 os_swprintf(szError, bsiz, _W("%s: An error occurred in '%s' subroutine.\n").c_str(), "feval", "execFevalF");
197                 os << szError;
198                 throw ast::InternalError(os.str());
199             }
200
201             if (itype) // is complex
202             {
203                 pDblOut->setComplex(true);
204                 pDblOut->set(x + y * pDblX->getSize(), res[0]);
205                 pDblOut->setImg(x + y * pDblX->getSize(), res[1]);
206             }
207             else
208             {
209                 pDblOut->set(x + y * pDblX->getSize(), res[0]);
210             }
211         }
212     }
213
214     // *** Return result in Scilab. ***
215
216     out.push_back(pDblOut);
217
218     FREE(res);
219     DifferentialEquation::removeDifferentialEquationFunctions();
220
221     return types::Function::OK;
222 }
223 /*--------------------------------------------------------------------------*/
224