/** \brief parse the given file name */
void ParserSingleInstance::parseFile(const std::wstring& fileName, const std::wstring& progName)
{
yylloc.first_line = yylloc.last_line = 1;
yylloc.first_column = yylloc.last_column = 1;
#ifdef _MSC_VER
_wfopen_s(&yyin, fileName.c_str(), L"r");
#else
char* pstTemp = wide_string_to_UTF8(fileName.c_str());
yyin = fopen(pstTemp, "r");
FREE(pstTemp);
#endif
if (!yyin)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%ls: Cannot open file %ls.\n").c_str(), L"parser", fileName.c_str());
throw ast::InternalError(szError);
}
ParserSingleInstance::disableStrictMode();
// Parser::getInstance()->enableStrictMode();
ParserSingleInstance::setFileName(fileName);
ParserSingleInstance::setProgName(progName);
ParserSingleInstance::setTree(nullptr);
ParserSingleInstance::setExitStatus(Parser::Succeded);
ParserSingleInstance::resetControlStatus();
ParserSingleInstance::resetErrorMessage();
yyparse();
fclose(yyin);
}
/**
* Export the variable LC_XXXX to the system
*
* @param locale the locale (ex : fr_FR or en_US)
*/
BOOL exportLocaleToSystem(const wchar_t *locale)
{
if (locale == NULL)
{
#ifdef _MSC_VER
fprintf(stderr, "Localization: Have not been able to find a suitable locale. Remains to default %s.\n", "LC_CTYPE");
#else
fprintf(stderr, "Localization: Have not been able to find a suitable locale. Remains to default %ls.\n", EXPORTENVLOCALESTR);
#endif
return FALSE;
}
/* It will put in the env something like LC_MESSAGES=fr_FR */
if ( !setenvcW(EXPORTENVLOCALESTR, locale))
{
#ifdef _MSC_VER
fprintf(stderr, "Localization: Failed to declare the system variable %s.\n", "LC_CTYPE");
#else
fprintf(stderr, "Localization: Failed to declare the system variable %d.\n", EXPORTENVLOCALE);
#endif
return FALSE;
}
#ifdef _MSC_VER
#ifdef USE_SAFE_GETTEXT_DLL
{
/* gettext is buggy on Windows */
/* We need to set a external environment variable to scilab env. */
char* pstr = NULL;
wchar_t env[MAX_PATH];
os_swprintf(env, MAX_PATH, L"%ls=%ls", EXPORTENVLOCALESTR, locale);
pstr = wide_string_to_UTF8(env);
gettext_putenv(pstr);
FREE(pstr);
}
#endif
#else
/* Export LC_NUMERIC to the system to make sure that the rest of system
is using the english notation (Java, Tcl ...) */
setenvc("LC_NUMERIC", LCNUMERICVALUE);
#endif
return TRUE;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_intg(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
double pdA = 0;
double pdB = 0;
double pdEpsR = 1.0e-8;
double pdEpsA = 1.0e-13;
double result = 0;
double abserr = 0;
int iOne = 1;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 3 || in.size() > 5)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "intg", 3);
return types::Function::Error;
}
// *** check number of output args ***
if (_iRetCount > 3)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "intg", 3);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// A
if (in[0]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 1);
return types::Function::Error;
}
types::Double* pDblA = in[0]->getAs<types::Double>();
if (pDblA->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 1);
return types::Function::Error;
}
pdA = pDblA->get(0);
if (ISNAN(pdA) || C2F(vfinite)(&iOne , &pdA) == false)
{
Scierror(264, _("%s: Wrong type for input argument #%d: Must not contain NaN or Inf.\n"), "intg", 1);
return types::Function::Error;
}
// B
if (in[1]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 2);
return types::Function::Error;
}
types::Double* pDblB = in[1]->getAs<types::Double>();
if (pDblB->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 2);
return types::Function::Error;
}
pdB = pDblB->get(0);
if (ISNAN(pdB) || C2F(vfinite)(&iOne , &pdB) == false)
{
Scierror(264, _("%s: Wrong type for input argument #%d: Must not contain NaN or Inf.\n"), "intg", 1);
return types::Function::Error;
}
// function
DifferentialEquationFunctions deFunctionsManager(L"intg");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
if (in[2]->isCallable())
{
types::Callable* pCall = in[2]->getAs<types::Callable>();
deFunctionsManager.setFFunction(pCall);
// check function
double t = 1;
double ret = intg_f(&t);
/* if (ret == 0)
{
Scierror(50, _("%s: Argument #%d: Variable returned by scilab argument function is incorrect.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}*/
}
else if (in[2]->isString())
{
bool bOK = false;
types::String* pStr = in[2]->getAs<types::String>();
bOK = deFunctionsManager.setFFunction(pStr);
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "intg", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else if (in[2]->isList())
{
types::List* pList = in[2]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "intg", 3, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (pList->get(0)->isCallable())
{
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a Scilab function.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "intg", 3);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (in.size() > 3)
{
if (in[3]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
types::Double* pDblEpsA = in[3]->getAs<types::Double>();
if (pDblEpsA->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
pdEpsA = pDblEpsA->get(0);
}
if (in.size() == 5)
{
if (in[4]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "intg", 5);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
types::Double* pDblEpsR = in[4]->getAs<types::Double>();
if (pDblEpsR->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "intg", 5);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
pdEpsR = pDblEpsR->get(0);
}
// *** Create working table. ***
int limit = 750;
int neval = 0;
int last = 0;
int lenw = 4 * limit;
double* dwork = (double*)MALLOC(lenw * sizeof(double));
int* iwork = (int*)MALLOC(limit * sizeof(int));
double epsabs = fabs(pdEpsA);
double epsrel = fabs(pdEpsR);
// *** Perform operation. ***
int ier = 0;
try
{
C2F(dqags)(intg_f, &pdA, &pdB, &epsabs, &epsrel,
&result, &abserr, &neval, &ier,
&limit, &lenw, &last, iwork, dwork);
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
}
FREE(dwork);
FREE(iwork);
DifferentialEquation::removeDifferentialEquationFunctions();
if (bCatch)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%ls: An error occurred in '%ls' subroutine.\n").c_str(), L"intg", L"dqags");
os << szError;
throw ast::InternalError(os.str());
}
if (ier)
{
char* msg = NULL;
switch (ier)
{
case 1 :
{
msg = _("%s: Maximum number of subdivisions achieved. Splitting the interval might help.\n");
break;
}
case 2 :
{
msg = _("%s: Round-off error detected, the requested tolerance (or default) cannot be achieved. Try using bigger tolerances.\n");
break;
}
case 3 :
{
msg = _("%s: Bad integrand behavior occurs at some points of the integration interval.\n");
break;
}
case 4 :
{
msg = _("%s: Convergence problem, round-off error detected. Try using bigger tolerances.\n");
break;
}
case 5 :
{
msg = _("%s: The integral is probably divergent, or slowly convergent.\n");
break;
}
case 6 :
{
msg = _("%s: Invalid input, absolute tolerance <= 0 and relative tolerance < 2.e-14.\n");
break;
}
default :
msg = _("%s: Convergence problem...\n");
}
if (_iRetCount == 3)
{
if (getWarningMode())
{
sciprint(msg, "intg: Warning");
}
}
else
{
Scierror(999, msg, "intg: Error");
return types::Function::Error;
}
}
// *** Return result in Scilab. ***
types::Double* pDblOut = new types::Double(result);
out.push_back(pDblOut);
if (_iRetCount > 1)
{
out.push_back(new types::Double(abserr));
}
if (_iRetCount == 3)
{
out.push_back(new types::Double((double)ier));
}
return types::Function::OK;
}
int StaticRunner::launch()
{
//set execution thread in java
if (!initialJavaHooks && getScilabMode() != SCILAB_NWNI)
{
initialJavaHooks = true;
// Execute the initial hooks registered in Scilab.java
ExecuteInitialHooks();
}
int iRet = 0;
// get the runner to execute
std::unique_ptr<Runner> runMe(getRunner());
// set if the current comment is interruptible
setInterruptibleCommand(runMe->isInterruptible());
debugger::DebuggerMagager* manager = debugger::DebuggerMagager::getInstance();
ConfigVariable::resetExecutionBreak();
int oldMode = ConfigVariable::getPromptMode();
symbol::Context* pCtx = symbol::Context::getInstance();
int scope = pCtx->getScopeLevel();
// a TCL command display nothing
int iOldPromptMode = 0;
if (runMe->getCommandOrigin() == TCLSCI)
{
iOldPromptMode = ConfigVariable::getPromptMode();
ConfigVariable::setPromptMode(-1);
}
try
{
int level = ConfigVariable::getRecursionLevel();
try
{
runMe->getProgram()->accept(*(runMe->getVisitor()));
}
catch (const ast::RecursionException& re)
{
// management of pause
if (ConfigVariable::getPauseLevel())
{
ConfigVariable::DecreasePauseLevel();
throw re;
}
//close opened scope during try
while (pCtx->getScopeLevel() > scope)
{
pCtx->scope_end();
}
//decrease recursion to init value and close where
while (ConfigVariable::getRecursionLevel() > level)
{
ConfigVariable::where_end();
ConfigVariable::decreaseRecursion();
}
ConfigVariable::resetWhereError();
ConfigVariable::setPromptMode(oldMode);
//print msg about recursion limit and trigger an error
wchar_t sz[1024];
os_swprintf(sz, 1024, _W("Recursion limit reached (%d).\n").data(), ConfigVariable::getRecursionLimit());
throw ast::InternalError(sz);
}
}
catch (const ast::InternalError& se)
{
if (runMe->getCommandOrigin() == TCLSCI)
{
ConfigVariable::setPromptMode(iOldPromptMode);
}
std::wostringstream ostr;
ConfigVariable::whereErrorToString(ostr);
scilabErrorW(ostr.str().c_str());
scilabErrorW(se.GetErrorMessage().c_str());
ConfigVariable::resetWhereError();
iRet = 1;
}
catch (const ast::InternalAbort& ia)
{
if (runMe->getCommandOrigin() == TCLSCI)
{
ConfigVariable::setPromptMode(iOldPromptMode);
}
// management of pause
if (ConfigVariable::getPauseLevel())
{
ConfigVariable::DecreasePauseLevel();
throw ia;
}
// close all scope before return to console scope
symbol::Context* pCtx = symbol::Context::getInstance();
while (pCtx->getScopeLevel() > scope)
{
pCtx->scope_end();
}
// send the good signal about the end of execution
sendExecDoneSignal(runMe.get());
//clean debugger step flag if debugger is not interrupted ( end of debug )
manager->resetStep();
throw ia;
}
if (runMe->getCommandOrigin() == TCLSCI)
{
ConfigVariable::setPromptMode(iOldPromptMode);
}
if (getScilabMode() != SCILAB_NWNI && getScilabMode() != SCILAB_API)
{
char *cwd = NULL;
int err = 0;
UpdateBrowseVar();
cwd = scigetcwd(&err);
if (cwd)
{
FileBrowserChDir(cwd);
FREE(cwd);
}
}
// reset error state when new prompt occurs
ConfigVariable::resetError();
// send the good signal about the end of execution
sendExecDoneSignal(runMe.get());
//clean debugger step flag if debugger is not interrupted ( end of debug )
manager->resetStep();
return iRet;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_feval(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iPos = 0;
int nn = 1;
int iErr = 0;
//input
types::Double* pDblX = NULL;
types::Double* pDblY = NULL;
// output
types::Double* pDblOut = NULL;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 2 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "feval", 2, 3);
return types::Function::Error;
}
// *** check number of output args according the methode. ***
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "feval", 1);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// X
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
pDblX = in[iPos]->getAs<types::Double>();
if (pDblX->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
iPos++;
// Y
if (in.size() == 3)
{
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
pDblY = in[iPos]->getAs<types::Double>();
if (pDblY->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), "feval", iPos + 1);
return types::Function::Error;
}
iPos++;
nn = 2;
}
// function
DifferentialEquationFunctions deFunctionsManager(L"feval");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
deFunctionsManager.setFFunction(pCall);
}
else if (in[iPos]->isString())
{
bool bOK = false;
types::String* pStr = in[iPos]->getAs<types::String>();
bOK = deFunctionsManager.setFFunction(pStr);
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "feval", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else if (in[iPos]->isList())
{
types::List* pList = in[iPos]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d : Subroutine not found in list: %s\n"), "feval", iPos + 1, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
if (pList->get(0)->isCallable())
{
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d : The first argument in the list must be a Scilab function.\n"), "feval", 4);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d : A function expected.\n"), "feval", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::Error;
}
// *** Perform operation. ***
int itype = 0; // output value
double* res = (double*)MALLOC(2 * sizeof(double));
int sizeOfY = pDblY ? pDblY->getSize() : 1;
if (nn == 2)
{
pDblOut = new types::Double(pDblX->getSize(), sizeOfY);
}
else
{
pDblOut = new types::Double(pDblX->getRows(), pDblX->getCols());
}
for (int y = 0; y < sizeOfY; y++)
{
for (int x = 0; x < pDblX->getSize(); x++)
{
double valX = pDblX->get(x);
// if pDblY == NULL, nn == 1 so valY will be never used.
double valY = pDblY ? pDblY->get(y) : 0;
try
{
deFunctionsManager.execFevalF(&nn, &valX, &valY, res, &itype);
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
}
if (bCatch)
{
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(res);
delete pDblOut;
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%s: An error occured in '%s' subroutine.\n").c_str(), "feval", "execFevalF");
os << szError;
throw ast::InternalError(os.str());
}
if (itype) // is complex
{
pDblOut->setComplex(true);
pDblOut->set(x + y * pDblX->getSize(), res[0]);
pDblOut->setImg(x + y * pDblX->getSize(), res[1]);
}
else
{
pDblOut->set(x + y * pDblX->getSize(), res[0]);
}
}
}
// *** Return result in Scilab. ***
out.push_back(pDblOut);
FREE(res);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::OK;
}
void ConfigVariable::whereErrorToString(std::wostringstream &ostr)
{
int iLenName = 1;
bool isExecstr = false;
bool isExecfile = false;
// get max length of functions name and check if exec or execstr have been called.
for (auto & where : m_WhereError)
{
if (isExecstr == false && where.m_name == L"execstr")
{
isExecstr = true;
continue;
}
else if (isExecfile == false && where.m_name == L"exec")
{
isExecfile = true;
continue;
}
iLenName = (std::max)((int)where.m_name.length(), iLenName);
// in case of bin file, the file path and line is displayed only if the associated .sci file exists
if (where.m_file_name != L"" && where.m_file_name.find(L".bin") != std::wstring::npos)
{
std::size_t pos = where.m_file_name.find_last_of(L".");
where.m_file_name.replace(pos, pos + 4, L".sci");
if (FileExistW(const_cast<wchar_t*>(where.m_file_name.c_str())) == false)
{
where.m_file_name = L"";
}
}
}
// add margin
iLenName++;
// initialize localized strings
std::wstring wstrBuiltin(_W("in builtin "));
std::wstring wstrAtLine(_W("at line % 5d of function "));
std::wstring wstrExecStr(_W("at line % 5d of executed string "));
std::wstring wstrExecFile(_W("at line % 5d of executed file "));
// compute max size between "at line xxx of function" and "in builtin "
// +1 : line number is pad to 5. length of "% 5d" + 1 == 5
int iMaxLen = (std::max)(wstrAtLine.length() + 1, wstrBuiltin.length());
if (isExecstr)
{
iMaxLen = (std::max)(((int)wstrExecStr.length()) + 1, iMaxLen);
}
if (isExecstr)
{
iMaxLen = (std::max)(((int)wstrExecFile.length()) + 1, iMaxLen);
}
// print call stack
ostr << std::left;
ostr.fill(L' ');
for (auto & where : m_WhereError)
{
ostr.width(iMaxLen);
if (where.m_line == 0)
{
ostr << wstrBuiltin;
}
else
{
if (where.m_name == L"execstr")
{
isExecstr = true;
wchar_t wcsTmp[bsiz];
os_swprintf(wcsTmp, bsiz, wstrExecStr.c_str(), where.m_line);
ostr << wcsTmp << std::endl;
continue;
}
else if (where.m_name == L"exec")
{
wchar_t wcsTmp[bsiz];
os_swprintf(wcsTmp, bsiz, wstrExecFile.c_str(), where.m_line);
ostr << wcsTmp << where.m_file_name << std::endl;
continue;
}
else
{
wchar_t wcsTmp[bsiz];
os_swprintf(wcsTmp, bsiz, wstrAtLine.c_str(), where.m_line);
ostr << wcsTmp;
}
}
ostr.width(iLenName);
ostr << where.m_name;
if (where.m_file_name != L"")
{
// -1 because the first line of a function dec is : "function myfunc()"
ostr << L"( " << where.m_file_name << L" " << _W("line") << L" " << where.m_macro_first_line + where.m_line - 1 << L" )";
}
ostr << std::endl;
}
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_dasrt(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// input args
types::Double* pDblX0 = NULL;
types::Double* pDblT0 = NULL;
types::Double* pDblT = NULL;
types::Double* pDblRtol = NULL;
types::Double* pDblAtol = NULL;
types::Double* pDblHd = NULL;
types::Double* pDblNg = NULL;
// x0 = [y0, ydot0]
double* pdYData = NULL; // contain y0 following by all args data in list case.
double* pdYdotData = NULL;
int sizeOfpdYData = 0;
int sizeOfYSize = 1;
int* YSize = NULL; // YSize(1) = size of y0,
// YSize(n) = size of Args(n) in list case.
int iPos = 0;
int one = 1;
int info[15] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
double tstop = 0;
double maxstep = 0;
double stepin = 0;
int ng = 0;
int mu = 0;
int ml = 0;
// Indicate if the function is given.
bool bFuncF = false;
bool bFuncJac = false;
bool bFuncG = false;
// Indicate if info list is given.
bool bListInfo = false;
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 6 || in.size() > 11)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "dasrt", 6, 11);
return types::Function::Error;
}
// *** check number of output args ***
if (_iRetCount != 3 && _iRetCount != 2)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "dasrt", 2, 3);
return types::Function::Error;
}
// *** check type of input args and get it. ***
// x0 = [y0, yd0]
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblX0 = in[iPos]->getAs<types::Double>();
if (pDblX0->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
if (pDblX0->getCols() > 2)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A real matrix with %d to %d column(s) expected.\n"), "dasrt", iPos + 1, 1, 2);
return types::Function::Error;
}
if (pDblX0->getCols() == 1)
{
info[10] = 1;
}
// t0
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblT0 = in[iPos]->getAs<types::Double>();
if (pDblT0->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
// t
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
pDblT = in[iPos]->getAs<types::Double>();
if (pDblT->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "dasrt", iPos + 1);
return types::Function::Error;
}
// get next inputs
DifferentialEquationFunctions deFunctionsManager(L"dasrt");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
YSize = (int*)MALLOC(sizeOfYSize * sizeof(int));
*YSize = pDblX0->getRows();
pdYData = (double*)MALLOC(*YSize * sizeof(double));
pdYdotData = (double*)MALLOC(*YSize * sizeof(double));
C2F(dcopy)(YSize, pDblX0->get(), &one, pdYData, &one);
if (pDblX0->getCols() == 2)
{
C2F(dcopy)(YSize, pDblX0->get() + *YSize, &one, pdYdotData, &one);
}
else
{
memset(pdYdotData, 0x00, *YSize);
}
deFunctionsManager.setOdeYRows(pDblX0->getRows());
for (iPos++; iPos < in.size(); iPos++)
{
if (in[iPos]->isDouble())
{
if (pDblAtol == NULL && bFuncF == false)
{
pDblAtol = in[iPos]->getAs<types::Double>();
if (pDblAtol->getSize() != pDblX0->getRows() && pDblAtol->isScalar() == false)
{
Scierror(267, _("%s: Wrong size for input argument #%d: A scalar or a matrix of size %d expected.\n"), "dasrt", iPos + 1, pDblX0->getRows());
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (pDblRtol == NULL && bFuncF == false)
{
pDblRtol = in[iPos]->getAs<types::Double>();
if (pDblAtol->getSize() != pDblRtol->getSize())
{
Scierror(267, _("%s: Wrong size for input argument #%d: Atol and Rtol must have the same size.\n"), "dasrt", iPos + 1, pDblX0->getRows());
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (pDblNg == NULL && bFuncF == true)
{
pDblNg = in[iPos]->getAs<types::Double>();
if (pDblNg->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
ng = (int)pDblNg->get(0);
}
else if (pDblHd == NULL && bFuncF == true)
{
pDblHd = in[iPos]->getAs<types::Double>();
if (in.size() != iPos + 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
if (bFuncF == false)
{
deFunctionsManager.setFFunction(pCall);
bFuncF = true;
}
else if (bFuncJac == false && pDblNg == NULL)
{
deFunctionsManager.setJacFunction(pCall);
bFuncJac = true;
}
else if (bFuncG == false && pDblNg)
{
deFunctionsManager.setGFunction(pCall);
bFuncG = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a list expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bOK = deFunctionsManager.setFFunction(pStr);
bFuncF = true;
}
else if (bFuncJac == false && pDblNg == NULL)
{
bOK = deFunctionsManager.setJacFunction(pStr);
bFuncJac = true;
}
else if (bFuncG == false && pDblNg)
{
bOK = deFunctionsManager.setGFunction(pStr);
bFuncG = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a list expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "dasrt", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isList())
{
types::List* pList = in[iPos]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "dasrt", iPos + 1, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncF && bListInfo)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (pList->get(0)->isString())
{
types::String* pStr = pList->get(0)->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bFuncF = true;
bOK = deFunctionsManager.setFFunction(pStr);
sizeOfpdYData = *YSize;
}
else if (bFuncJac == false && pDblNg == NULL)
{
bFuncJac = true;
bOK = deFunctionsManager.setJacFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
else if (bFuncG == false && pDblNg)
{
bFuncG = true;
bOK = deFunctionsManager.setGFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "dasrt", iPos + 1, pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
int* sizeTemp = YSize;
int totalSize = sizeOfpdYData;
YSize = (int*)MALLOC((sizeOfYSize + pList->getSize() - 1) * sizeof(int));
memcpy(YSize, sizeTemp, sizeOfYSize * sizeof(int));
std::vector<types::Double*> vpDbl;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
if (pList->get(iter + 1)->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Argument %d in the list must be a matrix.\n"), "dasrt", iPos + 1, iter + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
vpDbl.push_back(pList->get(iter + 1)->getAs<types::Double>());
YSize[sizeOfYSize + iter] = vpDbl[iter]->getSize();
totalSize += YSize[sizeOfYSize + iter];
}
double* pdYDataTemp = pdYData;
pdYData = (double*)MALLOC(totalSize * sizeof(double));
C2F(dcopy)(&sizeOfpdYData, pdYDataTemp, &one, pdYData, &one);
int position = sizeOfpdYData;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
C2F(dcopy)(&YSize[sizeOfYSize + iter], vpDbl[iter]->get(), &one, &pdYData[position], &one);
position += vpDbl[iter]->getSize();
}
vpDbl.clear();
sizeOfpdYData = totalSize;
sizeOfYSize += pList->getSize() - 1;
FREE(pdYDataTemp);
FREE(sizeTemp);
}
else if (pList->get(0)->isCallable())
{
if (bFuncF == false)
{
bFuncF = true;
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncJac == false && pDblNg == NULL)
{
bFuncJac = true;
deFunctionsManager.setJacFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setJacArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncG == false && pDblNg)
{
bFuncG = true;
deFunctionsManager.setGFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setGArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
}
else if (pList->get(0)->isDouble() && bFuncF == true)
{
if (pList->getSize() != 7)
{
Scierror(267, _("%s: Wrong size for input argument #%d: A list of size %d expected.\n"), "dasrt", iPos + 1, 7);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
for (int i = 0; i < 7; i++) // info = list([],0,[],[],[],0,0)
{
if (pList->get(i)->isDouble() == false || (pList->get(i)->getAs<types::Double>()->isScalar() == false && (i == 1 || i == 5 || i == 6)))
{
if (i == 1 || i == 5 || i == 6)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Element %d in the info list must be a scalar.\n"), "dasrt", iPos + 1, i);
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: Element %d in the info list must be a matrix.\n"), "dasrt", iPos + 1, i);
}
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
types::Double* pDblTemp = pList->get(0)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[3] = 1;
tstop = pDblTemp->get(0);
}
info[2] = (int)pList->get(1)->getAs<types::Double>()->get(0);
pDblTemp = pList->get(2)->getAs<types::Double>();
if (pDblTemp->getSize() == 2)
{
info[5] = 1;
ml = (int)pDblTemp->get(0);
mu = (int)pDblTemp->get(1);
deFunctionsManager.setMl(ml);
deFunctionsManager.setMu(mu);
}
else if (pDblTemp->getSize() != 0)
{
Scierror(267, _("%s: Wrong size for input argument #%d: Argument %d in the list must be of size %d.\n"), "dasrt", iPos + 1, 3, 2);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
pDblTemp = pList->get(3)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[6] = 1;
maxstep = pDblTemp->get(0);
}
pDblTemp = pList->get(4)->getAs<types::Double>();
if (pDblTemp->getSize() != 0)
{
info[7] = 1;
stepin = pDblTemp->get(0);
}
info[9] = (int)pList->get(5)->getAs<types::Double>()->get(0);
if (pList->get(6)->getAs<types::Double>()->get(0) == 1)
{
info[10] = 1;
}
bListInfo = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a string, a function or a matrix in case of argument info.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a function expected.\n"), "dasrt", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
}
if (bFuncF == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 3);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (pDblNg == NULL)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 2);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncG == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "dasrt", in.size() + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
return types::Function::Error;
}
if (bFuncJac == true)
{
info[4] = 1;
}
// *** Initialization. ***
double t0 = pDblT0->get(0);
double rpar = 0;
int ipar = 0;
int idid = 0;
int maxord = 5;
//compute itol and set the tolerances rtol and atol.
double* rtol = NULL;
double* atol = NULL;
if (pDblAtol)
{
if (pDblAtol->isScalar())
{
atol = (double*)MALLOC(sizeof(double));
*atol = pDblAtol->get(0);
}
else
{
atol = pDblAtol->get();
info[1] = 1;
}
}
else
{
atol = (double*)MALLOC(sizeof(double));
*atol = 1.e-7;
}
if (pDblRtol)
{
if (pDblRtol->isScalar())
{
rtol = (double*)MALLOC(sizeof(double));
*rtol = pDblRtol->get(0);
}
else
{
rtol = pDblRtol->get();
}
}
else // if rtol is not given atol will be used as a scalar.
{
if (pDblAtol && pDblAtol->isScalar() == false) // info[1] == 1
{
double dblSrc = 1.e-9;
int iSize = pDblAtol->getSize();
int iOne = 1;
int iZero = 0;
rtol = (double*)MALLOC(iSize * sizeof(double));
C2F(dcopy)(&iSize, &dblSrc, &iZero, rtol, &iOne);
}
else
{
rtol = (double*)MALLOC(sizeof(double));
*rtol = 1.e-9;
}
}
// Compute rwork, iwork size.
// Create them.
int iworksize = 20 + pDblX0->getRows();
int rworksize = 0;
int* iwork = NULL;
double* rwork = NULL;
int* root = NULL;
if (info[5] == 0)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + pDblX0->getRows() * pDblX0->getRows() + 3 * ng;
}
else if (info[4] == 1)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + (2 * ml + mu + 1) * pDblX0->getRows() + 3 * ng;
}
else if (info[4] == 0)
{
rworksize = 50 + (maxord + 4) * pDblX0->getRows() + (2 * ml + mu + 1) * pDblX0->getRows() + 2 * (pDblX0->getRows() / (ml + mu + 1) + 1) + 3 * ng;
}
iwork = (int*)MALLOC(iworksize * sizeof(int));
rwork = (double*)MALLOC(rworksize * sizeof(double));
root = (int*)MALLOC(ng * sizeof(int));
if (pDblHd != NULL)
{
if (iworksize + rworksize != pDblHd->getSize())
{
Scierror(77, _("%s: Wrong size for input argument(s) %d: %d expected.\n"), "dasrt", in.size(), iworksize + rworksize);
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
FREE(iwork);
FREE(rwork);
FREE(root);
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
return types::Function::Error;
}
C2F(dcopy)(&rworksize, pDblHd->get(), &one, rwork, &one);
for (int i = 0; i < iworksize; i++)
{
iwork[i] = (int)pDblHd->get(rworksize + i);
}
info[0] = 1;
}
if (info[3] == 1)
{
rwork[0] = tstop;
}
if (info[6] == 1)
{
rwork[1] = maxstep;
}
if (info[7] == 1)
{
rwork[2] = stepin;
}
if (info[5] == 1)
{
iwork[0] = ml;
iwork[1] = mu;
}
// *** Perform operation. ***
std::list<types::Double*> lpDblOut;
int size = pDblX0->getRows();
int rowsOut = 1 + pDblX0->getRows() * 2;
int iret = 0;
for (int i = 0; i < pDblT->getSize(); i++)
{
types::Double* pDblOut = new types::Double(rowsOut, 1);
lpDblOut.push_back(pDblOut);
double t = pDblT->get(i);
int pos = 0;
pDblOut->set(pos, t);
if (t == t0)
{
pos++;
C2F(dcopy)(&size, pdYData, &one, pDblOut->get() + pos, &one);
pos += pDblX0->getRows();
C2F(dcopy)(&size, pdYdotData, &one, pDblOut->get() + pos, &one);
continue;
}
try
{
C2F(ddasrt)(dassl_f, YSize, &t0, pdYData, pdYdotData, &t, info, rtol, atol, &idid, rwork, &rworksize, iwork, &iworksize, &rpar, &ipar, dassl_jac, dasrt_g, &ng, root);
iret = checkError(idid, "dasrt");
if (iret == 1) // error
{
Scierror(999, _("%s: %s return with state %d.\n"), "dasrt", "ddasrt", idid);
}
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
iret = 1;
}
if (iret == 1)
{
lpDblOut.clear();
DifferentialEquation::removeDifferentialEquationFunctions();
FREE(pdYdotData);
FREE(pdYData);
FREE(YSize);
FREE(iwork);
FREE(rwork);
FREE(root);
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
if (bCatch)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%ls: An error occured in '%ls' subroutine.\n").c_str(), L"dasrt", L"ddasrt");
os << szError;
throw ast::InternalError(os.str());
}
return types::Function::Error;
}
pos++;
C2F(dcopy)(&size, pdYData, &one, pDblOut->get() + pos, &one);
pos += size;
C2F(dcopy)(&size, pdYdotData, &one, pDblOut->get() + pos, &one);
if (iret == 2) // warning
{
pDblOut->set(0, t0);
break;
}
// iret == 0
if (idid == 1)
{
pDblOut->set(0, t0);
i--;
}
else if (idid == -2)
{
t0 = t;
i--;
}
else
{
t0 = t;
}
info[0] = 1;
}
// *** Return result in Scilab. ***
types::Double* pDblOut = new types::Double(rowsOut, (int)lpDblOut.size());
int sizeOfList = (int)lpDblOut.size();
for (int i = 0; i < sizeOfList; i++)
{
int pos = i * rowsOut;
C2F(dcopy)(&rowsOut, lpDblOut.front()->get(), &one, pDblOut->get() + pos, &one);
lpDblOut.pop_front();
}
out.push_back(pDblOut);
int sizeOfRoot = 1;
for (int i = 0; i < ng; i++)
{
if (root[i])
{
sizeOfRoot++;
}
}
types::Double* pDblRoot = new types::Double(1, sizeOfRoot);
pDblRoot->set(0, t0);
int j = 0;
for (int i = 0; i < ng; i++)
{
if (root[i])
{
j++;
pDblRoot->set(j, i + 1);
}
}
out.push_back(pDblRoot);
if (_iRetCount == 3)
{
types::Double* pDblHdOut = new types::Double(rworksize + iworksize, 1);
C2F(dcopy)(&rworksize, rwork, &one, pDblHdOut->get(), &one);
for (int i = 0; i < iworksize; i++)
{
pDblHdOut->set(rworksize + i, (double)iwork[i]);
}
out.push_back(pDblHdOut);
}
// *** FREE. ***
if (pDblAtol == NULL || pDblAtol->isScalar())
{
FREE(atol);
}
if (pDblRtol == NULL || pDblRtol->isScalar())
{
FREE(rtol);
}
FREE(pdYData);
FREE(pdYdotData);
FREE(YSize);
FREE(rwork);
FREE(iwork);
FREE(root);
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::OK;
}
bool Variable::put(types::InternalType* _pIT, int _iLevel)
{
if (isGlobal() && isGlobalVisible(_iLevel))
{
setGlobalValue(_pIT);
return true;
}
if (empty() || top()->m_iLevel < _iLevel)
{
//create a new level
last = new ScopedVariable(_iLevel, _pIT);
stack.push(last);
_pIT->IncreaseRef();
}
else
{
//update current level
types::InternalType* pIT = top()->m_pIT;
if (pIT != _pIT)
{
//check macro redefinition
if (_pIT->isMacro())
{
int iFuncProt = ConfigVariable::getFuncprot();
if (iFuncProt != 0)
{
bool bEquals = true;
if (pIT && pIT->isCallable())
{
if (pIT->isMacroFile())
{
types::MacroFile* pMF = pIT->getAs<types::MacroFile>();
bEquals = *pMF->getMacro() == *_pIT;
}
else if (pIT->isMacro())
{
types::Macro* pM = pIT->getAs<types::Macro>();
bEquals = *pM == *_pIT;
}
}
if (bEquals == false)
{
if (iFuncProt == 2)
{
return false;
}
if (ConfigVariable::getWarningMode())
{
wchar_t pwstFuncName[1024];
os_swprintf(pwstFuncName, 1024, L"%-24ls", name.getName().c_str());
char* pstFuncName = wide_string_to_UTF8(pwstFuncName);
sciprint(_("Warning : redefining function: %s. Use funcprot(0) to avoid this message"), pstFuncName);
sciprint("\n");
FREE(pstFuncName);
}
}
}
}
// _pIT may contained in pIT
// so increases ref of _pIT before kill pIT
top()->m_pIT = _pIT;
_pIT->IncreaseRef();
pIT->DecreaseRef();
pIT->killMe();
}
}
return true;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_genlib(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int succes = 1;
std::vector<std::wstring> failed_files;
std::vector<std::wstring> success_files;
std::vector<std::wstring> funcs;
wchar_t pstParseFile[PATH_MAX + FILENAME_MAX];
wchar_t pstVerbose[65535];
int iNbFile = 0;
wchar_t *pstParsePath = NULL;
int iParsePathLen = 0;
wchar_t* pstLibName = NULL;
bool bVerbose = false;
bool bForce = false;
if (in.size() < 1 || in.size() > 4)
{
Scierror(78, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "genlib", 1, 4);
return types::Function::Error;
}
//param 1, library name
types::InternalType* pIT = in[0];
if (pIT->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "genlib", 1);
return types::Function::Error;
}
types::String *pS = pIT->getAs<types::String>();
if (pS->getSize() != 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "genlib", 1);
return types::Function::Error;
}
pstLibName = pS->get(0);
//param 2, library path
if (in.size() > 1)
{
pIT = in[1];
if (pIT->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "genlib", 2);
return types::Function::Error;
}
}
else
{
int ierr = 0;
char* pstr = scigetcwd(&ierr);
pIT = new types::String(pstr);
FREE(pstr);
}
pS = pIT->getAs<types::String>();
if (pS->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), "genlib", 2);
return types::Function::Error;
}
//param 3, force flag
if (in.size() > 2)
{
pIT = in[2];
if (pIT->isBool() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar boolean expected.\n"), "genlib", 3);
return types::Function::Error;
}
types::Bool* p = pIT->getAs<types::Bool>();
if (p->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar boolean expected.\n"), "genlib", 3);
return types::Function::Error;
}
bForce = p->get()[0] == 1;
}
if (in.size() > 3)
{
//verbose flag
pIT = in[3];
if (pIT->isBool() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar boolean expected.\n"), "genlib", 3);
return types::Function::Error;
}
types::Bool* p = pIT->getAs<types::Bool>();
if (p->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar boolean expected.\n"), "genlib", 3);
return types::Function::Error;
}
bVerbose = p->get()[0] == 1;
}
wchar_t* pstFile = pS->get(0);
pstParsePath = pathconvertW(pstFile, TRUE, TRUE, AUTO_STYLE);
if (in.size() == 1)
{
delete pS;
}
os_swprintf(pstParseFile, PATH_MAX + FILENAME_MAX, L"%lslib", pstParsePath);
if (bVerbose)
{
os_swprintf(pstVerbose, 65535, _W("-- Creation of [%ls] (Macros) --\n").c_str(), pstLibName);
//save current prompt mode
int oldVal = ConfigVariable::getPromptMode();
//set mode silent for errors
ConfigVariable::setPromptMode(0);
scilabWriteW(pstVerbose);
//restore previous prompt mode
ConfigVariable::setPromptMode(oldVal);
}
MacroInfoList lstOld;
if (FileExistW(pstParseFile))
{
//read it to get previous information like md5
std::wstring libname;
parseLibFile(pstParseFile, lstOld, libname);
deleteafileW(pstParseFile);
}
xmlTextWriterPtr pWriter = openXMLFile(pstParseFile, pstLibName);
if (pWriter == NULL)
{
os_swprintf(pstVerbose, 65535, _W("%ls: Cannot open file ''%ls''.\n").c_str(), L"genlib", pstParseFile);
scilabWriteW(pstVerbose);
out.push_back(new types::Bool(0));
FREE(pstParsePath);
return types::Function::OK;
}
wchar_t **pstPath = findfilesW(pstParsePath, L"*.sci", &iNbFile, FALSE);
if (pstPath)
{
types::Library* pLib = new types::Library(pstParsePath);
for (int k = 0 ; k < iNbFile ; k++)
{
//version with direct parsing
//parse the file to find all functions
std::wstring stFullPath = std::wstring(pstParsePath) + std::wstring(pstPath[k]);
std::wstring stFullPathBin(stFullPath);
stFullPathBin.replace(stFullPathBin.end() - 3, stFullPathBin.end(), L"bin");
std::wstring pstPathBin(pstPath[k]);
pstPathBin.replace(pstPathBin.end() - 3, pstPathBin.end(), L"bin");
//compute file md5
FILE* fmdf5 = os_wfopen(stFullPath.data(), L"rb");
if (fmdf5 == NULL)
{
char* pstr = wide_string_to_UTF8(stFullPath.data());
Scierror(999, _("%s: Cannot open file ''%s''.\n"), "genlib", pstr);
FREE(pstr);
FREE(pstParsePath);
freeArrayOfWideString(pstPath, iNbFile);
pLib->killMe();
return types::Function::Error;
}
char* md5 = md5_file(fmdf5);
fclose(fmdf5);
wchar_t* wmd5 = to_wide_string(md5);
FREE(md5);
std::wstring wide_md5(wmd5);
FREE(wmd5);
if (bForce == false)
{
//check if is exist in old file
MacroInfoList::iterator it = lstOld.find(pstPathBin);
if (it != lstOld.end())
{
if (wide_md5 == (*it).second.md5)
{
//file not change, we can skip it
AddMacroToXML(pWriter, (*it).second.name, pstPathBin, wide_md5);
pLib->add((*it).second.name, new types::MacroFile((*it).second.name, stFullPathBin, pstLibName));
success_files.push_back(stFullPath);
funcs.push_back((*it).second.name);
continue;
}
}
}
if (bVerbose)
{
sciprint(_("%ls: Processing file: %ls\n"), L"genlib", pstPath[k]);
}
Parser parser;
parser.parseFile(stFullPath, ConfigVariable::getSCIPath());
if (parser.getExitStatus() != Parser::Succeded)
{
if (_iRetCount != 4)
{
std::wstring wstrErr = parser.getErrorMessage();
wchar_t errmsg[256];
os_swprintf(errmsg, 256, _W("%ls: Error in file %ls.\n").c_str(), L"genlib", stFullPath.data());
wstrErr += errmsg;
char* str = wide_string_to_UTF8(wstrErr.c_str());
Scierror(999, str);
FREE(str);
FREE(pstParsePath);
freeArrayOfWideString(pstPath, iNbFile);
closeXMLFile(pWriter);
delete pLib;
return types::Function::Error;
}
failed_files.push_back(stFullPath);
succes = 0;
continue;
}
//serialize ast
ast::SerializeVisitor* s = new ast::SerializeVisitor(parser.getTree());
unsigned char* serialAst = s->serialize();
// Header is : buffer size (4 bytes) + scilab version (4 bytes)
unsigned int size = *((unsigned int*)serialAst);
FILE* f = os_wfopen(stFullPathBin.c_str(), L"wb");
fwrite(serialAst, 1, size, f);
fclose(f);
ast::exps_t LExp = parser.getTree()->getAs<ast::SeqExp>()->getExps();
for (ast::exps_t::iterator j = LExp.begin(), itEnd = LExp.end() ; j != itEnd ; ++j)
{
if ((*j)->isFunctionDec())
{
ast::FunctionDec* pFD = (*j)->getAs<ast::FunctionDec>();
const std::wstring& name = pFD->getSymbol().getName();
if (name + L".sci" == pstPath[k])
{
if (AddMacroToXML(pWriter, name, pstPathBin, wide_md5) == false)
{
os_swprintf(pstVerbose, 65535, _W("%ls: Warning: %ls information cannot be added to file %ls. File ignored\n").c_str(), L"genlib", pFD->getSymbol().getName().c_str(), pstPath[k]);
scilabWriteW(pstVerbose);
}
pLib->add(name, new types::MacroFile(name, stFullPathBin, pstLibName));
success_files.push_back(stFullPath);
funcs.push_back(name);
break;
}
}
}
delete s;
free(serialAst);
delete parser.getTree();
}
symbol::Context* ctx = symbol::Context::getInstance();
symbol::Symbol sym = symbol::Symbol(pstLibName);
if (ctx->isprotected(sym) == false)
{
ctx->put(symbol::Symbol(pstLibName), pLib);
}
else
{
Scierror(999, _("Redefining permanent variable.\n"));
freeArrayOfWideString(pstPath, iNbFile);
FREE(pstParsePath);
closeXMLFile(pWriter);
delete pLib;
return types::Function::Error;
}
}
freeArrayOfWideString(pstPath, iNbFile);
out.push_back(new types::Bool(succes));
if (_iRetCount > 1)
{
int size = static_cast<int>(funcs.size());
if (size == 0)
{
out.push_back(types::Double::Empty());
}
else
{
types::String* s = new types::String(size, 1);
for (int i = 0; i < size; ++i)
{
s->set(i, funcs[i].data());
}
out.push_back(s);
}
}
if (_iRetCount > 2)
{
int size = static_cast<int>(success_files.size());
if (size == 0)
{
out.push_back(types::Double::Empty());
}
else
{
types::String* s = new types::String(size, 1);
for (int i = 0; i < size; ++i)
{
s->set(i, success_files[i].data());
}
out.push_back(s);
}
}
if (_iRetCount > 3)
{
int size = static_cast<int>(failed_files.size());
if (size == 0)
{
out.push_back(types::Double::Empty());
}
else
{
types::String* s = new types::String(size, 1);
for (int i = 0; i < size; ++i)
{
s->set(i, failed_files[i].data());
}
out.push_back(s);
}
}
FREE(pstParsePath);
closeXMLFile(pWriter);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_mcisendstring(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
std::wstring param1;
types::String* pS = nullptr;
int out2 = 0;
std::wstring out3(L"OK");
wchar_t output[2048];
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), fname.data(), 1);
return types::Function::Error;
}
if (_iRetCount < 1 || _iRetCount > 3)
{
Scierror(999, _("%s: Wrong number of output arguments: %d to %d expected.\n"), fname.data(), 1, 3);
return types::Function::Error;
}
if (in[0]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname.data(), 1);
return types::Function::Error;
}
pS = in[0]->getAs<types::String>();
if (pS->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: String expected.\n"), fname.data(), 1);
return types::Function::Error;
}
param1 = pS->get()[0];
char* test = wide_string_to_UTF8(param1.data());
char tout[2048];
MCIERROR err = mciSendString(test, tout, sizeof(tout), NULL);
out2 = (int)err;
if (err)
{
wchar_t errtxt[128];
if (mciGetErrorStringW(err, errtxt, 128) == FALSE)
{
os_swprintf(errtxt, L"%ls", L"Unknown MCI error");
}
out3 = errtxt;
out.push_back(types::Bool::False());
}
else
{
out.push_back(types::Bool::True());
}
if (_iRetCount > 1)
{
out.push_back(new types::Double(out2));
}
if (_iRetCount > 2)
{
out.push_back(new types::String(out3.data()));
}
return types::Function::OK;
}
//windows : find main DLL and extract path
//linux and macos : scilab script fill SCI env variable
char* computeTMPDIR()
{
#ifdef _MSC_VER
wchar_t wcTmpDirDefault[PATH_MAX];
if (!GetTempPathW(PATH_MAX, wcTmpDirDefault))
{
MessageBoxA(NULL, _("Cannot find Windows temporary directory (1)."), _("Error"), MB_ICONERROR);
exit(1);
}
else
{
wchar_t wctmp_dir[PATH_MAX + FILENAME_MAX + 1];
static wchar_t bufenv[PATH_MAX + 16];
char *TmpDir = NULL;
os_swprintf(wctmp_dir, PATH_MAX + FILENAME_MAX + 1, L"%lsSCI_TMP_%d_", wcTmpDirDefault, _getpid());
if (CreateDirectoryW(wctmp_dir, NULL) == FALSE)
{
DWORD attribs = GetFileAttributesW(wctmp_dir);
if (attribs & FILE_ATTRIBUTE_DIRECTORY)
{
/* Repertoire existant */
}
else
{
#ifdef _DEBUG
{
char MsgErr[1024];
wsprintfA(MsgErr, _("Impossible to create : %s"), wctmp_dir);
MessageBoxA(NULL, MsgErr, _("Error"), MB_ICONERROR);
exit(1);
}
#else
{
GetTempPathW(PATH_MAX, wcTmpDirDefault);
wcscpy(wctmp_dir, wcTmpDirDefault);
wctmp_dir[wcslen(wctmp_dir) - 1] = '\0'; /* Remove last \ */
}
#endif
}
}
os_swprintf(bufenv, PATH_MAX + 16, L"TMPDIR=%ls", wctmp_dir);
_wputenv(bufenv);
TmpDir = wide_string_to_UTF8(wctmp_dir);
if (TmpDir)
{
return TmpDir;
}
else
{
return NULL;
}
}
return NULL;
#else
char *tmpdir;
char* env_dir = (char*)MALLOC(sizeof(char) * (PATH_MAX + 16));
/* If the env variable TMPDIR is set, honor this preference */
tmpdir = getenv("TMPDIR");
if (tmpdir != NULL && strlen(tmpdir) < (PATH_MAX) && strstr(tmpdir, "SCI_TMP_") == NULL)
{
strcpy(env_dir, tmpdir);
}
else
{
strcpy(env_dir, "/tmp");
}
/* XXXXXX will be randomized by mkdtemp */
char *env_dir_strdup = os_strdup(env_dir); /* Copy to avoid to have the same buffer as input and output for sprintf */
sprintf(env_dir, "%s/SCI_TMP_%d_XXXXXX", env_dir_strdup, (int)getpid());
free(env_dir_strdup);
if (mkdtemp(env_dir) == NULL)
{
fprintf(stderr, _("Error: Could not create %s: %s\n"), env_dir, strerror(errno));
}
setenvc("TMPDIR", env_dir);
return env_dir;
#endif
}
Callable::ReturnValue DynamicFunction::Init()
{
/*Load library*/
if (m_wstLibName.empty())
{
Scierror(999, _("%s: Library name must not be empty\n."), m_wstName.c_str());
return Error;
}
DynLibHandle hLib = getDynModule(m_wstLibName.c_str());
if (hLib == 0)
{
char* pstLibName = wide_string_to_UTF8(m_wstLibName.c_str());
hLib = LoadDynLibrary(pstLibName);
if (hLib == 0)
{
//2nd chance for linux !
#ifndef _MSC_VER
char* pstError = strdup(GetLastDynLibError());
/* Haven't been able to find the lib with dlopen...
* This can happen for two reasons:
* - the lib must be dynamically linked
* - Some silly issues under Suse (see bug #2875)
* Note that we are handling only the "source tree build"
* because libraries are split (they are in the same directory
* in the binary)
*/
wchar_t* pwstScilabPath = getSCIW();
wchar_t pwstModulesPath[] = L"/modules/";
wchar_t pwstLTDir[] = L".libs/";
/* Build the full path to the library */
int iPathToLibLen = (wcslen(pwstScilabPath) + wcslen(pwstModulesPath) + wcslen(m_wstModule.c_str()) + wcslen(L"/") + wcslen(pwstLTDir) + wcslen(m_wstLibName.c_str()) + 1);
wchar_t* pwstPathToLib = (wchar_t*)MALLOC(iPathToLibLen * sizeof(wchar_t));
os_swprintf(pwstPathToLib, iPathToLibLen, L"%ls%ls%ls/%ls%ls", pwstScilabPath, pwstModulesPath, m_wstModule.c_str(), pwstLTDir, m_wstLibName.c_str());
FREE(pwstScilabPath);
char* pstPathToLib = wide_string_to_UTF8(pwstPathToLib);
FREE(pwstPathToLib);
hLib = LoadDynLibrary(pstPathToLib);
if (hLib == 0)
{
Scierror(999, _("An error has been detected while loading %s: %s\n"), pstLibName, pstError);
FREE(pstError);
pstError = GetLastDynLibError();
Scierror(999, _("An error has been detected while loading %s: %s\n"), pstPathToLib, pstError);
FREE(pstLibName);
FREE(pstPathToLib);
return Error;
}
FREE(pstPathToLib);
FREE(pstError);
#else
char* pstError = wide_string_to_UTF8(m_wstLibName.c_str());
Scierror(999, _("Impossible to load %s library\n"), pstError);
FREE(pstError);
FREE(pstLibName);
return Error;
#endif
}
FREE(pstLibName);
addDynModule(m_wstLibName.c_str(), hLib);
/*Load deps*/
if (m_wstLoadDepsName.empty() == false && m_pLoadDeps == NULL)
{
char* pstLoadDepsName = wide_string_to_UTF8(m_wstLoadDepsName.c_str());
m_pLoadDeps = (LOAD_DEPS)GetDynLibFuncPtr(hLib, pstLoadDepsName);
FREE(pstLoadDepsName);
}
}
/*Load gateway*/
if (m_wstName != L"")
{
char* pstEntryPoint = wide_string_to_UTF8(m_wstEntryPoint.c_str());
switch (m_iType)
{
case EntryPointCPPOpt :
m_pOptFunc = (GW_FUNC_OPT)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointCPP :
m_pFunc = (GW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointOldC :
m_pOldFunc = (OLDGW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointMex:
m_pMexFunc = (MEXGW_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
case EntryPointC:
m_pCFunc = (GW_C_FUNC)GetDynLibFuncPtr(hLib, pstEntryPoint);
break;
}
FREE(pstEntryPoint);
}
if (m_pFunc == NULL && m_pOldFunc == NULL && m_pMexFunc == NULL && m_pOptFunc == NULL && m_pCFunc == NULL)
{
char* pstEntry = wide_string_to_UTF8(m_wstEntryPoint.c_str());
char* pstLib = wide_string_to_UTF8(m_wstLibName.c_str());
Scierror(999, _("Impossible to load %s function in %s library: %s\n"), pstEntry, pstLib, GetLastDynLibError());
FREE(pstEntry);
FREE(pstLib);
return Error;
}
switch (m_iType)
{
case EntryPointCPPOpt :
m_pFunction = new OptFunction(m_wstName, m_pOptFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointCPP :
m_pFunction = new Function(m_wstName, m_pFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointOldC :
m_pFunction = new WrapFunction(m_wstName, m_pOldFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointMex:
m_pFunction = new WrapMexFunction(m_wstName, m_pMexFunc, m_pLoadDeps, m_wstModule);
break;
case EntryPointC:
m_pFunction = new WrapCFunction(m_wstName, m_pCFunc, m_pLoadDeps, m_wstModule);
break;
}
if (m_pFunction == NULL)
{
return Error;
}
return OK;
}
/** \brief parse the given file command */
void ParserSingleInstance::parse(const char *command)
{
size_t len = strlen(command);
yylloc.first_line = yylloc.last_line = 1;
yylloc.first_column = yylloc.last_column = 1;
#ifdef _MSC_VER
char szFile[MAX_PATH];
char* pstTmpDIr = getTMPDIR();
os_sprintf(szFile, "%s\\%s", pstTmpDIr, "command.temp");
FREE(pstTmpDIr);
if (fileLocker)
{
fclose(fileLocker);
}
errno_t err;
err = fopen_s(&yyin, szFile, "w");
if (err)
{
ParserSingleInstance::setExitStatus(Parser::Failed);
ParserSingleInstance::resetErrorMessage();
wchar_t szError[bsiz];
wchar_t* wszFile = to_wide_string(szFile);
os_swprintf(szError, bsiz, _W("%ls: Cannot open file %ls.\n").c_str(), L"parser", wszFile);
FREE(wszFile);
appendErrorMessage(szError);
return;
}
fwrite(command, sizeof(char), len, yyin);
fclose(yyin);
fopen_s(&yyin, szFile, "r");
#endif
#ifdef __APPLE__
char szFile[PATH_MAX];
char* pstTmpDIr = "/tmp";
sprintf(szFile, "%s/%s", getTMPDIR(), "command.temp");
//FREE(pstTmpDIr);
if (fileLocker)
{
fclose(fileLocker);
}
yyin = fopen(szFile, "w");
fwrite(command, 1, len, yyin);
fclose(yyin);
yyin = fopen(szFile, "r");
#endif
#ifndef _MSC_VER
#ifndef __APPLE__
yyin = fmemopen((void*)command, len, "r");
#endif
#endif
ParserSingleInstance::disableStrictMode();
ParserSingleInstance::setFileName(L"prompt");
ParserSingleInstance::setTree(nullptr);
ParserSingleInstance::setExitStatus(Parser::Succeded);
ParserSingleInstance::resetControlStatus();
ParserSingleInstance::resetErrorMessage();
yyparse();
fclose(yyin);
#ifdef _MSC_VER
DeleteFileA(szFile);
#endif
#ifdef _MSC_VER
//reopen a file to prevents max file opened.
fopen_s(&fileLocker, szFile, "w");
#endif
#ifdef __APPLE__
fileLocker = fopen(szFile, "w");
#endif
}
types::Function::ReturnValue sci_impl(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
// Methode
types::String* pStrType = NULL;
const wchar_t * wcsType = L"lsoda";
int meth = 2;// default methode is stiff
// y0
types::Double* pDblY0 = NULL;
double* pdYData = NULL; // contain y0 following by all args data in list case.
int sizeOfpdYData = 0;
// Other input args
types::Double* pDblYdot0 = NULL;
types::Double* pDblT0 = NULL;
types::Double* pDblT = NULL;
types::Double* pDblRtol = NULL;
types::Double* pDblAtol = NULL;
types::Double* pDblW = NULL;
types::Double* pDblIw = NULL;
// Result
types::Double* pDblYOut = NULL;
// Indicate if the function is given.
bool bFuncF = false; // res
bool bFuncJac = false; // jac
bool bFuncG = false; // adda
int iPos = 0; // Position in types::typed_list in
int maxord = 5; // maxord = 12 (if meth = 1) or 5 (if meth = 2)
int sizeOfYSize = 1;
int* YSize = NULL; // YSize(1) = size of y0,
// YSize(n) = size of Args(n) in list case.
C2F(eh0001).mesflg = 1; // flag to control printing of error messages in lapack routine.
// 1 means print, 0 means no printing.
C2F(eh0001).lunit = 6; // 6 = stdout
int one = 1; // use in dcopy
// error message catched
std::wostringstream os;
bool bCatch = false;
// *** check the minimal number of input args. ***
if (in.size() < 6 || in.size() > 12)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "impl", 6, 12);
return types::Function::Error;
}
// *** check number of output args ***
if (_iRetCount > 3 || _iRetCount == 2)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d or %d expected.\n"), "impl", 1, 3);
return types::Function::Error;
}
// *** Get the methode. ***
if (in[0]->isString())
{
pStrType = in[0]->getAs<types::String>();
wcsType = pStrType->get(0);
iPos++;
}
if (iPos)
{
if (wcscmp(wcsType, L"adams") == 0)
{
meth = 1;
maxord = 12;
}
else if (wcscmp(wcsType, L"stiff") == 0)
{
meth = 2;
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: It must be one of the following strings: adams or stiff.\n"), "impl", 1);
return types::Function::Error;
}
}
// *** check type of input args and get it. ***
// y0
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
pDblY0 = in[iPos]->getAs<types::Double>();
if (pDblY0->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
if (pDblY0->getCols() != 1 && pDblY0->getRows() != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real vector expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
// ydot0
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
pDblYdot0 = in[iPos]->getAs<types::Double>();
if (pDblYdot0->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
if (pDblYdot0->getCols() != 1 && pDblYdot0->getRows() != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real vector expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
// t0
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A scalar expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
pDblT0 = in[iPos]->getAs<types::Double>();
if (pDblT0->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
// t
iPos++;
if (in[iPos]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
return types::Function::Error;
}
pDblT = in[iPos]->getAs<types::Double>();
// get next inputs
DifferentialEquationFunctions deFunctionsManager(L"impl");
DifferentialEquation::addDifferentialEquationFunctions(&deFunctionsManager);
YSize = (int*)malloc(sizeOfYSize * sizeof(int));
*YSize = pDblY0->getSize();
pdYData = (double*)malloc(pDblY0->getSize() * sizeof(double));
C2F(dcopy)(YSize, pDblY0->get(), &one, pdYData, &one);
for (iPos++; iPos < in.size(); iPos++)
{
if (in[iPos]->isDouble())
{
if (pDblAtol == NULL && bFuncF == false)
{
pDblAtol = in[iPos]->getAs<types::Double>();
if (pDblAtol->getSize() != pDblY0->getSize() && pDblAtol->isScalar() == false)
{
Scierror(267, _("%s: Arg %d and arg %d must have equal dimensions.\n"), "impl", pStrType ? 2 : 1, iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else if (pDblRtol == NULL && bFuncF == false)
{
pDblRtol = in[iPos]->getAs<types::Double>();
if (pDblRtol->getSize() != pDblY0->getSize() && pDblRtol->isScalar() == false)
{
Scierror(267, _("%s: Arg %d and arg %d must have equal dimensions.\n"), "impl", pStrType ? 2 : 1, iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else if (pDblW == NULL && bFuncG == true)
{
if (in.size() == iPos + 2)
{
if (in[iPos + 1]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 2);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
pDblW = in[iPos]->getAs<types::Double>();
pDblIw = in[iPos + 1]->getAs<types::Double>();
iPos++;
}
else
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "impl", iPos + 2);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A function expected.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isCallable())
{
types::Callable* pCall = in[iPos]->getAs<types::Callable>();
if (bFuncF == false)
{
deFunctionsManager.setFFunction(pCall);
bFuncF = true;
}
else if (bFuncG == false)
{
deFunctionsManager.setGFunction(pCall);
bFuncG = true;
}
else if (bFuncJac == false)
{
deFunctionsManager.setJacFunction(pCall);
bFuncJac = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isString())
{
types::String* pStr = in[iPos]->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bOK = deFunctionsManager.setFFunction(pStr);
bFuncF = true;
}
else if (bFuncG == false)
{
bOK = deFunctionsManager.setGFunction(pStr);
bFuncG = true;
}
else if (bFuncJac == false)
{
bOK = deFunctionsManager.setJacFunction(pStr);
bFuncJac = true;
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Subroutine not found: %s\n"), "impl", pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else if (in[iPos]->isList())
{
types::List* pList = in[iPos]->getAs<types::List>();
if (pList->getSize() == 0)
{
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "impl", iPos + 1, "(string empty)");
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
if (bFuncF && bFuncG && bFuncJac)
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
if (pList->get(0)->isString())
{
types::String* pStr = pList->get(0)->getAs<types::String>();
bool bOK = false;
if (bFuncF == false)
{
bFuncF = true;
bOK = deFunctionsManager.setFFunction(pStr);
sizeOfpdYData = *YSize;
}
else if (bFuncG == false)
{
bFuncG = true;
bOK = deFunctionsManager.setGFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
else if (bFuncJac == false)
{
bFuncJac = true;
bOK = deFunctionsManager.setJacFunction(pStr);
if (sizeOfpdYData == 0)
{
sizeOfpdYData = *YSize;
}
}
if (bOK == false)
{
char* pst = wide_string_to_UTF8(pStr->get(0));
Scierror(50, _("%s: Argument #%d: Subroutine not found in list: %s\n"), "impl", iPos + 1, pst);
FREE(pst);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
int* sizeTemp = YSize;
int totalSize = sizeOfpdYData;
YSize = (int*)malloc((sizeOfYSize + pList->getSize() - 1) * sizeof(int));
memcpy(YSize, sizeTemp, sizeOfYSize * sizeof(int));
std::vector<types::Double*> vpDbl;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
if (pList->get(iter + 1)->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Argument %d in the list must be a matrix.\n"), "impl", iPos + 1, iter + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
vpDbl.push_back(pList->get(iter + 1)->getAs<types::Double>());
YSize[sizeOfYSize + iter] = vpDbl[iter]->getSize();
totalSize += YSize[sizeOfYSize + iter];
}
double* pdYDataTemp = pdYData;
pdYData = (double*)malloc(totalSize * sizeof(double));
C2F(dcopy)(&sizeOfpdYData, pdYDataTemp, &one, pdYData, &one);
int position = sizeOfpdYData;
for (int iter = 0; iter < pList->getSize() - 1; iter++)
{
C2F(dcopy)(&YSize[sizeOfYSize + iter], vpDbl[iter]->get(), &one, &pdYData[position], &one);
position += vpDbl[iter]->getSize();
}
vpDbl.clear();
sizeOfpdYData = totalSize;
sizeOfYSize += pList->getSize() - 1;
free(pdYDataTemp);
free(sizeTemp);
}
else if (pList->get(0)->isCallable())
{
if (bFuncF == false)
{
bFuncF = true;
deFunctionsManager.setFFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setFArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncG == false)
{
bFuncG = true;
deFunctionsManager.setGFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setGArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
else if (bFuncJac == false)
{
bFuncJac = true;
deFunctionsManager.setJacFunction(pList->get(0)->getAs<types::Callable>());
for (int iter = 1; iter < pList->getSize(); iter++)
{
deFunctionsManager.setJacArgs(pList->get(iter)->getAs<types::InternalType>());
}
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: The first argument in the list must be a string or a function.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix or a function expected.\n"), "impl", iPos + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
}
if (bFuncF == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "impl", in.size() + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
if (bFuncG == false)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "impl", in.size() + 1);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
return types::Function::Error;
}
// *** Initialization. ***
double t0 = pDblT0->get(0);
int itol = 1;
int iopt = 0;
int istate = 1;
int itask = 1;
int jt = bFuncJac ? 1 : 2;
int jacType = 10 * meth + jt;
pDblYOut = new types::Double(pDblY0->getRows(), pDblT->getSize());
// work tab
double* rwork = NULL;
int* iwork = NULL;
int rworkSize = 0;
int iworkSize = 0;
// contain ls0001, lsa001 and eh0001 structures
double* dStructTab = NULL;
int* iStructTab = NULL;
int dStructTabSize = 219; // number of double in ls0001
int iStructTabSize = 41; // number of int in ls0001 (39) + eh0001 (2)
int rwSize = 0; // rwSize = dStructTab + rworkSize
int iwSize = 0; // iwSize = iStructTab + iworkSize
// structures used by lsoda and lsode
double* ls0001d = &(C2F(ls0001).tret);
int* ls0001i = &(C2F(ls0001).illin);
int* eh0001i = &(C2F(eh0001).mesflg);
//compute itol and set the tolerances rtol and atol.
double* rtol = NULL;
double* atol = NULL;
if (pDblRtol)
{
if (pDblRtol->isScalar())
{
rtol = (double*)malloc(sizeof(double));
*rtol = pDblRtol->get(0);
}
else
{
rtol = pDblRtol->get();
itol += 2;
}
}
else
{
rtol = (double*)malloc(sizeof(double));
*rtol = 1.e-9;
}
if (pDblAtol)
{
if (pDblAtol->isScalar())
{
atol = (double*)malloc(sizeof(double));
*atol = pDblAtol->get(0);
}
else
{
atol = pDblAtol->get();
itol ++;
}
}
else
{
atol = (double*)malloc(sizeof(double));
*atol = 1.e-7;
}
// Compute rwork, iwork size.
// Create them.
int nyh = (*YSize);
if (pDblW) // structure ls0001 have been restored.
{
nyh = C2F(ls0001).nyh;
}
rworkSize = 20 + nyh * (maxord + 1) + 3 * *YSize + *YSize **YSize + 2;
iworkSize = 20 + *YSize;
rwSize = rworkSize + dStructTabSize;
iwSize = iworkSize + iStructTabSize;
rwork = (double*)malloc(rworkSize * sizeof(double));
iwork = (int*)malloc(iworkSize * sizeof(int));
if (pDblW && pDblIw)
{
if (pDblW->getSize() != rwSize || pDblIw->getSize() != iwSize)
{
Scierror(9999, _("%s: Wrong size for w and iw: w = %d and iw = %d expected.\n"), "impl", rwSize, iwSize);
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
free(rwork);
free(iwork);
if (itol == 1 || itol == 3)
{
free(atol);
}
if (itol < 3)
{
free(rtol);
}
return types::Function::Error;
}
istate = 2; // 1 means this is the first call | 2 means this is not the first call
// restore rwork from pDblW
C2F(dcopy)(&rworkSize, pDblW->get(), &one, rwork, &one);
// restore iwork from pDblIw
iStructTab = (int*)malloc(iStructTabSize * sizeof(int));
for (int i = 0; i < iworkSize; i++)
{
iwork[i] = (int)pDblIw->get(i);
}
//restore ls0001d from pDblW
C2F(dcopy)(&dStructTabSize, pDblW->get() + rworkSize, &one, ls0001d, &one);
//restore ls0001i from pDblIw
for (int i = 0; i < iStructTabSize; i++)
{
iStructTab[i] = (int)pDblIw->get(i + iworkSize);
}
memcpy(ls0001i, iStructTab, 39 * sizeof(int));
}
// *** Perform operation. ***
int err = 0;
for (int i = 0; i < pDblT->getSize(); i++)
{
double t = pDblT->get(i);
try
{
C2F(lsodi)(impl_f, impl_g, impl_jac, YSize, pdYData, pDblYdot0->get(), &t0, &t, &itol, rtol, atol, &itask, &istate, &iopt, rwork, &rworkSize, iwork, &iworkSize, &jacType);
// check error
if (istate == 3)
{
sciprint(_("The user-supplied subroutine res signalled lsodi to halt the integration and return (ires=2). Execution of the external function has failed.\n"));
err = 1;
Scierror(999, _("%s: %s exit with state %d.\n"), "impl", "lsodi", istate);
}
else
{
err = checkOdeError(meth, istate);
if (err == 1)
{
Scierror(999, _("%s: %s exit with state %d.\n"), "impl", "lsodi", istate);
}
}
}
catch (ast::InternalError &ie)
{
os << ie.GetErrorMessage();
bCatch = true;
err = 1;
}
if (err == 1)
{
DifferentialEquation::removeDifferentialEquationFunctions();
free(pdYData);
free(YSize);
free(rwork);
free(iwork);
if (iStructTab)
{
free(iStructTab);
}
if (itol == 1 || itol == 3)
{
free(atol);
}
if (itol < 3)
{
free(rtol);
}
if (bCatch)
{
wchar_t szError[bsiz];
os_swprintf(szError, bsiz, _W("%s: An error occured in '%s' subroutine.\n").c_str(), "impl", "lsodi");
os << szError;
throw ast::InternalError(os.str());
}
return types::Function::Error;
}
for (int j = 0; j < *YSize; j++)
{
pDblYOut->set(i * (*YSize) + j, pdYData[j]);
}
}
if (_iRetCount > 2) //save ls0001 and eh0001 following pDblW and pDblIw.
{
int dSize = 219;
if (iStructTab == NULL)
{
iStructTab = (int*)malloc(iStructTabSize * sizeof(int));
}
if (dStructTab == NULL)
{
dStructTab = (double*)malloc(dStructTabSize * sizeof(double));
}
// save ls0001
C2F(dcopy)(&dSize, ls0001d, &one, dStructTab, &one);
memcpy(iStructTab, ls0001i, 39 * sizeof(int));
// save eh0001
memcpy(&iStructTab[39], eh0001i, 2 * sizeof(int));
}
// *** Return result in Scilab. ***
out.push_back(pDblYOut);
if (_iRetCount > 2)
{
types::Double* pDblWOut = new types::Double(1, rwSize);
C2F(dcopy)(&rworkSize, rwork, &one, pDblWOut->get(), &one);
C2F(dcopy)(&dStructTabSize, dStructTab, &one, pDblWOut->get() + rworkSize, &one);
types::Double* pDblIwOut = new types::Double(1, iwSize);
for (int i = 0; i < iworkSize; i++)
{
pDblIwOut->set(i, (double)iwork[i]);
}
for (int i = 0; i < iStructTabSize; i++)
{
pDblIwOut->set(iworkSize + i, (double)iStructTab[i]);
}
out.push_back(pDblWOut);
out.push_back(pDblIwOut);
}
// *** free. ***
if (itol == 1 || itol == 3) // atol is scalar
{
free(atol);
}
if (itol < 3) // rtol is scalar
{
free(rtol);
}
free(pdYData);
free(YSize);
free(rwork);
free(iwork);
if (dStructTab)
{
free(dStructTab);
}
if (iStructTab)
{
free(iStructTab);
}
DifferentialEquation::removeDifferentialEquationFunctions();
return types::Function::OK;
}
