types::Function::ReturnValue implicitListString(types::ImplicitList* pIL, types::typed_list &out)
{
std::wostringstream ostr;
pIL->toString(ostr);
std::wstring str = ostr.str();
//erase fisrt character " "
str.erase(str.begin());
//erase last character "\n"
str.erase(str.end() - 1);
out.push_back(new types::String(str.c_str()));
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_testGVN(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
ast::Exp * pExp = 0;
if (in.size() != 1)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), "jit" , 1);
return types::Function::Error;
}
if (!in[0]->isString() || in[0]->getAs<types::String>()->getSize() != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "jit" , 1);
return types::Function::Error;
}
Parser parser;
parser.parse(in[0]->getAs<types::String>()->get(0));
if (parser.getExitStatus() != Parser::Succeded)
{
char* pst = wide_string_to_UTF8(parser.getErrorMessage());
Scierror(999, "%s", pst);
FREE(pst);
return types::Function::Error;
}
pExp = parser.getTree();
if (!pExp)
{
return types::Function::Error;
}
analysis::TestGVNVisitor gvn;
pExp->accept(gvn);
gvn.print_info();
types::Struct * pOut = new types::Struct(1, 1);
std::map<std::wstring, uint64_t> maps = gvn.getSymMap();
for (const auto & p : maps)
{
pOut->addField(p.first);
pOut->get(0)->set(p.first, new types::Double((double)p.second));
}
out.push_back(pOut);
delete pExp;
return types::Function::OK;
}
types::Function::ReturnValue sci_getmemory(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() > 0)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected."), "funcprot", 0);
return types::Function::Error;
}
if (_iRetCount > 2)
{
Scierror(77, _("%s: Wrong number of output argument(s): %d expected."), "funcprot", 2);
return types::Function::Error;
}
out.push_back(new types::Double((double)getfreememory()));
if(_iRetCount == 2)
{
out.push_back(new types::Double((double)getmemorysize()));
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_gamma(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument: %d expected.\n"), "gamma", 1);
return types::Function::Error;
}
if (in[0]->isList() || in[0]->isTList() || in[0]->isMList())
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_gamma";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
if (in[0]->isDouble() == false)
{
Scierror(999, _("%s: Wrong type for argument #%d: A matrix expected.\n"), "gamma", 1);
return types::Function::Error;
}
/***** get data *****/
types::Double* pDblIn = in[0]->getAs<types::Double>();
if (pDblIn->isComplex())
{
Scierror(999, _("%s: Can not read input argument #%d.\n"), "gamma", 1);
return types::Function::Error;
}
if (pDblIn->getDims() > 2)
{
return Overload::call(L"%hm_gamma", in, _iRetCount, out);
}
types::Double* pDblOut = new types::Double(pDblIn->getDims(), pDblIn->getDimsArray());
double* pDblValIn = pDblIn->getReal();
double* pDblValOut = pDblOut->getReal();
/***** perform operation *****/
for (int i = 0; i < pDblIn->getSize(); i++)
{
pDblValOut[i] = C2F(dgammacody)(pDblValIn + i);
}
/***** return data *****/
out.push_back(pDblOut);
return types::Function::OK;
}
Function::ReturnValue sci_isglobal(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::typed_list::iterator inIterator;
int iWrongType = 1;
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "isglobal", 1);
return Function::Error;
}
else
{
if (in[0]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), "isglobal", 1);
return Function::Error;
}
String* pS = in[0]->getAs<types::String>();
if (pS->isScalar() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: Single string expected.\n"), "isglobal", 1);
return Function::Error;
}
if (symbol::Context::getInstance()->isGlobalVisible(symbol::Symbol(pS->get(0))))
{
out.push_back(new types::Bool(1));
}
else
{
out.push_back(new types::Bool(0));
}
}
return Function::OK;
}
types::Function::ReturnValue booleanString(types::Bool* pB, types::typed_list &out)
{
int iDims = pB->getDims();
int* piDimsArray = pB->getDimsArray();
int* pb = pB->get();
types::String *pstOutput = new types::String(iDims, piDimsArray);
int iSize = pB->getSize();
for (int i = 0 ; i < iSize ; i++)
{
pstOutput->set(i, pb[i] == 0 ? "F" : "T");
}
out.push_back(pstOutput);
return types::Function::OK;
}
types::Function::ReturnValue intString(T* pInt, types::typed_list &out)
{
int iDims = pInt->getDims();
int* piDimsArray = pInt->getDimsArray();
types::String *pstOutput = new types::String(iDims, piDimsArray);
int iSize = pInt->getSize();
for (int i = 0 ; i < iSize ; i++)
{
std::wostringstream ostr;
DoubleComplexMatrix2String(&ostr, (double)pInt->get(i), 0);
pstOutput->set(i, ostr.str().c_str());
}
out.push_back(pstOutput);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_meof(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iRet = 0;
int iFile = -1; //default file : last opened file
if (in.size() > 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "meof", 0, 1);
return types::Function::Error;
}
if (in.size() == 1)
{
if (in[0]->isDouble() == false || in[0]->getAs<types::Double>()->isScalar() == false || in[0]->getAs<types::Double>()->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A real expected.\n"), "meof", 1);
return types::Function::Error;
}
iFile = (int)in[0]->getAs<types::Double>()->get(0);
switch (iFile)
{
case 0: // stderr
case 5: // stdin
case 6: // stdout
Scierror(999, _("%s: Wrong file descriptor: %d.\n"), "meof", iFile);
return types::Function::Error;
}
}
types::File* pF = FileManager::getFile(iFile);
if (pF != NULL)
{
iRet = feof(pF->getFiledesc());
}
else
{
if (getWarningMode())
{
sciprint(_("%ls: Cannot check the end of file whose descriptor is %d: File is not active.\n"), "meof", iFile);
}
return types::Function::OK;
}
types::Double* pOut = new types::Double(iRet);
out.push_back(pOut);
return types::Function::OK;
}
types::Function::ReturnValue sci_pathsep(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int dimsArray[2] = {1, 1};
wchar_t* wcsSep = to_wide_string(PATH_SEPARATOR);
if (in.size() > 0)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "pathsep", 0);
return types::Function::Error;
}
types::String* pOut = new types::String(2, dimsArray);
pOut->set(0, wcsSep);
FREE(wcsSep);
out.push_back(pOut);
return types::Function::OK;
}
types::Function::ReturnValue sci_mtell(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iFile = -1; //default file : last opened file
int dims = 2;
int dimsArray[2] = {1, 1};
types::Double* pOut = NULL;
if (in.size() > 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "mtell", 0, 1);
return types::Function::Error;
}
if (in.size() == 1)
{
if (in[0]->isDouble() == false || in[0]->getAs<types::Double>()->isScalar() == false || in[0]->getAs<types::Double>()->isComplex())
{
Scierror(999, _("%s: Wrong type for input argument #%d: A Real expected.\n"), "mtell", 1);
return types::Function::Error;
}
iFile = static_cast<int>(in[0]->getAs<types::Double>()->get(0));
}
switch (iFile)
{
case 0: // stderr
case 5: // stdin
case 6: // stdout
Scierror(999, _("%s: Wrong file descriptor: %d.\n"), "mtell", iFile);
return types::Function::Error;
}
long long offset = mtell(iFile);
if (offset < 0)
{
Scierror(999, _("%s: Error while opening, reading or writing.\n"), "mtell");
return types::Function::Error;
}
pOut = new types::Double(dims, dimsArray);
pOut->set(0, (double)offset);
out.push_back(pOut);
return Function::OK;
}
types::Function::ReturnValue sci_getThreads(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 0)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), "getThreads" , 0);
return types::Function::Error;
}
if (_iRetCount != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), "getThreads" , 1);
return types::Function::Error;
}
out.push_back(ConfigVariable::getAllThreads());
return types::Function::OK;
}
types::Function::ReturnValue sci_curblock(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 0)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), funname.c_str(), 0);
return types::Function::Error;
}
if (_iRetCount != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), funname.c_str(), 1);
return types::Function::Error;
}
types::Double* kfun = new types::Double(C2F(curblk).kfun);
out.push_back(kfun);
return types::Function::OK;
}
types::Function::ReturnValue sci_scicos_debug(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() > 1)
{
Scierror(999, _("%s: Wrong number of input arguments: %d or %d expected.\n"), funname.c_str(), 0, 1);
return types::Function::Error;
}
if (_iRetCount != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), funname.c_str(), 1);
return types::Function::Error;
}
if (in.empty())
{
types::Double* ret = new types::Double(C2F(cosdebug).cosd);
out.push_back(ret);
}
else
{
if (!in[0]->isDouble())
{
Scierror(999, _("%s: Wrong type for input argument #%d : A real matrix expected.\n"), funname.data(), 1);
return types::Function::Error;
}
types::Double* pIn = in[0]->getAs<types::Double>();
if (!pIn->isScalar())
{
Scierror(999, _("%s: Wrong size for input argument #%d : A real scalar expected.\n"), funname.data(), 1);
return types::Function::Error;
}
if (pIn->get(0) != floor(pIn->get(0)))
{
Scierror(999, _("%s: Wrong value for input argument #%d : An integer value expected.\n"), funname.data(), 1);
return types::Function::Error;
}
C2F(cosdebug).cosd = pIn->get(0);
}
return types::Function::OK;
}
types::Function::ReturnValue sci_exists(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Function::ReturnValue retVal = isdef(in, _iRetCount, out, "exists");
if (retVal == types::Function::OK)
{
types::Bool* pBOut = out[0]->getAs<types::Bool>();
types::Double* pDblOut = new types::Double(pBOut->getDims(), pBOut->getDimsArray());
for (int i = 0; i < pBOut->getSize(); i++)
{
pDblOut->set(i, (double)pBOut->get(i));
}
pBOut->killMe();
out.pop_back();
out.push_back(pDblOut);
}
return retVal;
}
types::Function::ReturnValue sci_hdf5_file_version(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int rhs = static_cast<int>(in.size());
if (rhs < 1)
{
Scierror(999, _("%s: Wrong number of input argument(s): at least %d expected.\n"), fname.data(), 1);
return types::Function::Error;
}
if (in[0]->getId() != types::InternalType::IdScalarString)
{
Scierror(999, _("%s: Wrong size for input argument #%d: string expected.\n"), fname.data(), 1);
return types::Function::Error;
}
wchar_t* wfilename = expandPathVariableW(in[0]->getAs<types::String>()->get()[0]);
char* cfilename = wide_string_to_UTF8(wfilename);
std::string filename = cfilename;
FREE(wfilename);
FREE(cfilename);
int iFile = openHDF5File(filename.data(), 0);
if (iFile < 0)
{
Scierror(999, _("%s: Unable to open file: %s\n"), fname.data(), filename.data());
return types::Function::Error;
}
std::wstring wstFuncName;
//manage version information
int version = getSODFormatAttribute(iFile);
closeHDF5File(iFile);
if (version == -1)
{
version = 1;
}
out.push_back(new types::Double(static_cast<double>(version)));
return types::Function::OK;
}
types::Function::ReturnValue sci_inspectorGetFunctionList(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 0)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), "inspectorGetFunctionList", 0);
return types::Function::Error;
}
symbol::Context* pC = symbol::Context::getInstance();
std::list<symbol::Symbol> funcName;
int size = pC->getFunctionList(funcName, L"");
types::String* pOut = new types::String(size, 4);
int i = 0;
for (auto it : funcName)
{
types::Callable* pCall = pC->get(it)->getAs<types::Callable>();
//Function name
pOut->set(i, 0, pCall->getName().c_str());
pOut->set(i, 1, pCall->getModule().c_str());
pOut->set(i, 2, pCall->getTypeStr().c_str());
if (pCall->isMacroFile())
{
pOut->set(i, 3, pCall->getAs<types::MacroFile>()->getMacro() == NULL ? L"false" : L"true");
}
else
{
pOut->set(i, 3, L"");
}
++i;
}
out.push_back(pOut);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_with_module(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::String* pStr = NULL;
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "with_module", 1);
return types::Function::Error;
}
if (in[0]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), "with_module", 1);
return types::Function::Error;
}
pStr = in[0]->getAs<types::String>();
if (pStr->isScalar() == false)
{
Scierror(999, _("%s: Wrong size for input argument #%d: String expected.\n"), "with_module", 1);
return types::Function::Error;
}
wchar_t* pwstModuleName = pStr->get(0);
types::Bool* pOut = new types::Bool(0);
std::list<std::wstring> sModuleList = ConfigVariable::getModuleList();
std::list<std::wstring>::iterator it;
for (it = sModuleList.begin() ; it != sModuleList.end() ; it++)
{
if (*it == pwstModuleName)
{
pOut->get()[0] = 1;
break;
}
}
out.push_back(pOut);
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Callable::ReturnValue sci_msprintf(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() < 1)
{
Scierror(999, _("%s: Wrong number of input arguments: at least %d expected.\n"), "msprintf", 1);
return types::Function::Error;
}
if (in[0]->isString() == false || in[0]->getAs<types::String>()->getSize() != 1)
{
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "msprintf" , 1);
return types::Function::Error;
}
for (int i = 1 ; i < in.size() ; i++)
{
if (in[i]->isDouble() == false && in[i]->isString() == false)
{
std::wstring wstFuncName = L"%" + in[i]->getShortTypeStr() + L"_msprintf";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
}
int iOutputRows = 0;
int iNewLine = 0;
wchar_t* pwstInput = in[0]->getAs<types::String>()->get()[0];
wchar_t** pwstOutput = scilab_sprintf("msprintf", pwstInput, in, &iOutputRows, &iNewLine);
if (pwstOutput == NULL)
{
return types::Function::Error;
}
types::String* pOut = new types::String(iOutputRows, 1);
pOut->set(pwstOutput);
freeArrayOfWideString(pwstOutput, iOutputRows);
out.push_back(pOut);
return types::Function::OK;
}
types::Function::ReturnValue sci_validvar(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
int iValid = 0;
if (in.size() != 1)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), "validvar", 1);
return types::Function::Error;
}
if (_iRetCount != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), "validvar", 1);
return types::Function::Error;
}
if (in[0]->isString() == false)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), "validvar", 1);
return types::Function::Error;
}
types::String* pS = in[0]->getAs<types::String>();
if (pS->isScalar() == false)
{
Scierror(202, _("%s: Wrong size for argument #%d: A string expected.\n"), "validvar", 1);
return types::Function::Error;
}
if (symbol::Context::getInstance()->isValidVariableName(pS->get(0)))
{
iValid = 1;
}
out.push_back(new types::Bool(iValid));
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_zeros(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pOut = NULL;
int iDims = 0;
int* piDims = NULL;
bool alloc = false;
bool ret = getDimsFromArguments(in, "zeros", &iDims, &piDims, &alloc);
if (ret == false)
{
switch (iDims)
{
case -1:
Scierror(21, _("Invalid index.\n"));
break;
case 1:
{
//call overload
ast::ExecVisitor exec;
return Overload::generateNameAndCall(L"zeros", in, _iRetCount, out, &exec);
}
}
return types::Function::Error;
}
pOut = new Double(iDims, piDims);
if (alloc)
{
delete[] piDims;
}
pOut->setZeros();
out.push_back(pOut);
return types::Function::OK;
}
types::Function::ReturnValue sci_diffobjs(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 2)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), funname.data(), 2);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1);
return types::Function::Error;
}
types::Double* ret = new types::Double(1);
if (*in[0] == *in[1])
{
ret->set(0, 0);
}
out.push_back(ret);
return types::Function::OK;
}
types::Function::ReturnValue sci_pointer_xproperty(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 0)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), funname.data(), 0);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), funname.data(), 1);
return types::Function::Error;
}
const int isrun = C2F(cosim).isrun;
if (!isrun)
{
Scierror(999, _("%s: scicosim is not running.\n"), funname.data());
return types::Function::Error;
}
// Retrieve the current block's continuous state and copy it to the return
const int* pointer_xproperty = get_pointer_xproperty();
const int npointer_xproperty = get_npointer_xproperty();
double* data;
types::Double* ret = new types::Double(npointer_xproperty, 1, &data);
#ifdef _MSC_VER
std::transform(pointer_xproperty, pointer_xproperty + npointer_xproperty, stdext::checked_array_iterator<double*>(data, npointer_xproperty), toDouble);
#else
std::transform(pointer_xproperty, pointer_xproperty + npointer_xproperty, data, toDouble);
#endif
out.push_back(ret);
return types::Function::OK;
}
types::Function::ReturnValue sci_host(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "host", 1);
return Function::Error;
}
types::InternalType* pIT = in[0];
if (pIT->isString() == false || pIT->getAs<types::String>()->getSize() != 1)
{
Scierror(89, _("%s: Wrong size for input argument #%d: A string expected.\n"), "host", 1);
return Function::Error;
}
wchar_t* pstCommand = pIT->getAs<types::String>()->get(0);
int stat = 0;
systemcW(pstCommand, &stat);
out.push_back(new types::Double(stat));
return Function::OK;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_testAnalysis(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() == 0)
{
Scierror(999, _("%s: Wrong number of input arguments: at least %d expected.\n"), "testAnalysis", 1);
return types::Function::Error;
}
// check that arguments are a string
unsigned int i = 1;
Location loc;
ast::exps_t * args = new ast::exps_t();
args->reserve(in.size() - 1);
for (const auto arg : in)
{
if (!arg->isString() || arg->getAs<types::String>()->getSize() != 1)
{
delete args;
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "testAnalysis", i);
return types::Function::Error;
}
if (i > 1)
{
symbol::Symbol sym(arg->getAs<types::String>()->get(0));
args->emplace_back(new ast::SimpleVar(loc, sym));
}
++i;
}
symbol::Symbol sym(in[0]->getAs<types::String>()->get(0));
ast::SimpleVar * var = new ast::SimpleVar(loc, sym);
ast::CallExp ce(loc, *var, *args);
analysis::AnalysisVisitor analysis;
ce.accept(analysis);
//analysis.print_info();
analysis::TIType & t = analysis.getResult().getType();
types::Struct * pOut = new types::Struct(1, 1);
pOut->addField(L"type");
pOut->get(0)->set(L"type", new types::String(analysis::TIType::toString(t.type).c_str()));
pOut->addField(L"rows");
if (t.rows.isConstant())
{
pOut->get(0)->set(L"rows", new types::Double(t.rows.getConstant()));
}
else
{
pOut->get(0)->set(L"rows", new types::Double(analysis::tools::NaN()));
}
pOut->addField(L"cols");
if (t.cols.isConstant())
{
pOut->get(0)->set(L"cols", new types::Double(t.cols.getConstant()));
}
else
{
pOut->get(0)->set(L"cols", new types::Double(analysis::tools::NaN()));
}
out.push_back(pOut);
//ast::DebugVisitor debugMe;
//pExp->accept(debugMe);
//ast::PrintVisitor printMe(std::wcout);
//pExp->accept(printMe);
return types::Function::OK;
}
types::Function::ReturnValue sci_spec(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
double* pDataA = NULL;
double* pDataB = NULL;
bool symmetric = FALSE;
int iRet = 0;
if (in.size() != 1 && in.size() != 2)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "spec", 1, 2);
return types::Function::Error;
}
if (_iRetCount > 2 * in.size())
{
Scierror(78, _("%s: Wrong number of output argument(s): %d to %d expected.\n"), "spec", 1, 2 * in.size());
return types::Function::Error;
}
if (in[0]->isDouble() == false)
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_spec";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
types::Double* in0 = in[0]->getAs<types::Double>();
if (in0->getCols() != in0->getRows())
{
Scierror(20, _("%s: Wrong type for input argument #%d: Square matrix expected.\n"), "spec", 1);
return types::Function::Error;
}
if (in0->getRows() == -1 || in0->getCols() == -1) // manage eye case
{
Scierror(271, _("%s: Size varying argument a*eye(), (arg %d) not allowed here.\n"), "spec", 1);
return types::Function::Error;
}
if (in0->getCols() == 0 || in0->getRows() == 0) // size null
{
out.push_back(types::Double::Empty());
for (int i = 1; i < _iRetCount; i++)
{
out.push_back(types::Double::Empty());
}
return types::Function::OK;
}
types::Double* pDblA = in0->clone()->getAs<types::Double>();
if (in.size() == 1)
{
types::Double* pDblEigenValues = NULL;
types::Double* pDblEigenVectors = NULL;
if (pDblA->isComplex())
{
pDataA = (double*)oGetDoubleComplexFromPointer(pDblA->getReal(), pDblA->getImg(), pDblA->getSize());
if (!pDataA)
{
pDblA->killMe();
Scierror(999, _("%s: Cannot allocate more memory.\n"), "spec");
return types::Function::Error;
}
}
else
{
pDataA = pDblA->getReal();
}
int totalSize = pDblA->getSize();
if ((pDblA->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataA) : C2F(vfinite)(&totalSize, pDataA)) == false)
{
if (pDblA->isComplex())
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
}
pDblA->killMe();
Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 1);
return types::Function::Error;
}
symmetric = isSymmetric(pDblA->getReal(), pDblA->getImg(), pDblA->isComplex(), pDblA->getRows(), pDblA->getCols()) == 1;
int eigenValuesCols = (_iRetCount == 1) ? 1 : pDblA->getCols();
if (symmetric)
{
pDblEigenValues = new types::Double(pDblA->getCols(), eigenValuesCols);
if (_iRetCount == 2)
{
pDblEigenVectors = new types::Double(pDblA->getCols(), pDblA->getCols(), pDblA->isComplex());
}
}
else
{
pDblEigenValues = new types::Double(pDblA->getCols(), eigenValuesCols, true);
if (_iRetCount == 2)
{
pDblEigenVectors = new types::Double(pDblA->getCols(), pDblA->getCols(), true);
}
}
if (pDblA->isComplex())
{
if (symmetric)
{
iRet = iEigen1ComplexSymmetricM((doublecomplex*)pDataA, pDblA->getCols(), (_iRetCount == 2), pDblEigenValues->getReal());
if (iRet < 0)
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
pDblA->killMe();
Scierror(998, _("%s: On entry to ZGEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet);
return types::Function::Error;
}
if (iRet > 0)
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
pDblA->killMe();
Scierror(24, _("%s: Convergence problem, %d off-diagonal elements of an intermediate tridiagonal form did not converge to zero.\n"), "spec", iRet);
return types::Function::Error;
}
if (_iRetCount == 2)
{
vGetPointerFromDoubleComplex((doublecomplex*)pDataA, pDblA->getSize() , pDblEigenVectors->getReal(), pDblEigenVectors->getImg());
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols());
out.push_back(pDblEigenVectors);
}
out.push_back(pDblEigenValues);
}
else // not symmetric
{
doublecomplex* pEigenValues = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex));
doublecomplex* pEigenVectors = pDblEigenVectors ? (doublecomplex*)MALLOC(sizeof(doublecomplex) * pDblA->getSize()) : NULL;
iRet = iEigen1ComplexM((doublecomplex*)pDataA, pDblA->getCols(), pEigenValues, pEigenVectors);
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
if (iRet < 0)
{
pDblA->killMe();
Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet);
return types::Function::Error;
}
if (iRet > 0)
{
pDblA->killMe();
Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of W contain eigenvalues which have converged.\n"), "spec", iRet);
return types::Function::Error;
}
if (_iRetCount == 2)
{
expandZToDiagonalOfCMatrix(pEigenValues, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg());
vGetPointerFromDoubleComplex(pEigenVectors, pDblA->getSize(), pDblEigenVectors->getReal(), pDblEigenVectors->getImg());
FREE(pEigenVectors);
out.push_back(pDblEigenVectors);
}
else
{
vGetPointerFromDoubleComplex(pEigenValues, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg());
}
out.push_back(pDblEigenValues);
FREE(pEigenValues);
pDblA->killMe();
}
}
else // real
{
if (symmetric)
{
iRet = iEigen1RealSymmetricM(pDataA, pDblA->getCols(), (_iRetCount == 2), pDblEigenValues->getReal());
if (iRet < 0)
{
pDblA->killMe();
Scierror(998, _("%s: On entry to ZGEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet);
return types::Function::Error;
}
if (iRet > 0)
{
pDblA->killMe();
Scierror(24, _("%s: Convergence problem, %d off-diagonal elements of an intermediate tridiagonal form did not converge to zero.\n"), "spec", iRet);
return types::Function::Error;
}
if (_iRetCount == 2)
{
expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols());
out.push_back(pDblA);
}
else
{
pDblA->killMe();
}
out.push_back(pDblEigenValues);
}
else // not symmetric
{
iRet = iEigen1RealM(pDataA, pDblA->getCols(), pDblEigenValues->getReal(), pDblEigenValues->getImg(), pDblEigenVectors ? pDblEigenVectors->getReal() : NULL, pDblEigenVectors ? pDblEigenVectors->getImg() : NULL);
if (iRet < 0)
{
pDblA->killMe();
Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet);
return types::Function::Error;
}
if (iRet > 0)
{
pDblA->killMe();
Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of WR and WI contain eigenvalues which have converged.\n"), "spec", iRet);
return types::Function::Error;
}
if (_iRetCount == 2)
{
expandToDiagonalOfMatrix(pDblEigenValues->getReal(), pDblA->getCols());
expandToDiagonalOfMatrix(pDblEigenValues->getImg(), pDblA->getCols());
out.push_back(pDblEigenVectors);
}
out.push_back(pDblEigenValues);
pDblA->killMe();
}
}
return types::Function::OK;
}
if (in.size() == 2)
{
types::Double* pDblL = NULL;
types::Double* pDblR = NULL;
types::Double* pDblBeta = NULL;
types::Double* pDblAlpha = NULL;
doublecomplex* pL = NULL;
doublecomplex* pR = NULL;
doublecomplex* pBeta = NULL;
doublecomplex* pAlpha = NULL;
bool bIsComplex = false;
if (in[1]->isDouble() == false)
{
std::wstring wstFuncName = L"%" + in[1]->getShortTypeStr() + L"_spec";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
types::Double* in1 = in[1]->getAs<types::Double>();
if (in1->getCols() != in1->getRows())
{
Scierror(20, _("%s: Wrong type for input argument #%d: Square matrix expected.\n"), "spec", 2);
return types::Function::Error;
}
if (pDblA->getRows() != in1->getRows() && pDblA->getCols() != in1->getCols())
{
pDblA->killMe();
Scierror(999, _("%s: Arguments %d and %d must have equal dimensions.\n"), "spec", 1, 2);
return types::Function::Error;
}
//chekc if A and B are real complex or with imag part at 0
if (isNoZeroImag(pDblA) == false && isNoZeroImag(in1) == false)
{
//view A and B as real matrix
bIsComplex = false;
}
else
{
bIsComplex = pDblA->isComplex() || in1->isComplex();
}
types::Double* pDblB = in1->clone()->getAs<types::Double>();
if (bIsComplex)
{
if (pDblA->isComplex() == false)
{
pDblA->setComplex(true);
}
if (pDblB->isComplex() == false)
{
pDblB->setComplex(true);
}
pDataA = (double*)oGetDoubleComplexFromPointer(pDblA->getReal(), pDblA->getImg(), pDblA->getSize());
pDataB = (double*)oGetDoubleComplexFromPointer(pDblB->getReal(), pDblB->getImg(), pDblB->getSize());
if (!pDataA || !pDataB)
{
delete pDataA;
delete pDataB;
Scierror(999, _("%s: Cannot allocate more memory.\n"), "spec");
return types::Function::Error;
}
}
else
{
pDataA = pDblA->getReal();
pDataB = pDblB->getReal();
}
int totalSize = pDblA->getSize();
if ((pDblA->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataA) : C2F(vfinite)(&totalSize, pDataA)) == false)
{
pDblA->killMe();
pDblB->killMe();
Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 1);
return types::Function::Error;
}
if ((pDblB->isComplex() ? C2F(vfiniteComplex)(&totalSize, (doublecomplex*)pDataB) : C2F(vfinite)(&totalSize, pDataB)) == false)
{
pDblA->killMe();
pDblB->killMe();
Scierror(264, _("%s: Wrong value for input argument %d: Must not contain NaN or Inf.\n"), "spec", 2);
return types::Function::Error;
}
switch (_iRetCount)
{
case 4:
{
pDblL = new types::Double(pDblA->getRows(), pDblA->getCols(), true);
if (bIsComplex)
{
pL = (doublecomplex*)MALLOC(pDblA->getSize() * sizeof(doublecomplex));
}
}
case 3:
{
pDblR = new types::Double(pDblA->getRows(), pDblA->getCols(), true);
if (bIsComplex)
{
pR = (doublecomplex*)MALLOC(pDblA->getSize() * sizeof(doublecomplex));
}
}
case 2:
{
if (bIsComplex)
{
pBeta = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex));
}
pDblBeta = new types::Double(pDblA->getCols(), 1, pBeta ? true : false);
}
default : // case 1:
{
if (bIsComplex)
{
pAlpha = (doublecomplex*)MALLOC(pDblA->getCols() * sizeof(doublecomplex));
}
pDblAlpha = new types::Double(pDblA->getCols(), 1, true);
}
}
if (bIsComplex)
{
iRet = iEigen2ComplexM((doublecomplex*)pDataA, (doublecomplex*)pDataB, pDblA->getCols(), pAlpha, pBeta, pR, pL);
}
else
{
iRet = iEigen2RealM( pDataA, pDataB, pDblA->getCols(),
pDblAlpha->getReal(), pDblAlpha->getImg(),
pDblBeta ? pDblBeta->getReal() : NULL,
pDblR ? pDblR->getReal() : NULL,
pDblR ? pDblR->getImg() : NULL,
pDblL ? pDblL->getReal() : NULL,
pDblL ? pDblL->getImg() : NULL);
}
if (iRet > 0)
{
sciprint(_("Warning :\n"));
sciprint(_("Non convergence in the QZ algorithm.\n"));
sciprint(_("The top %d x %d blocks may not be in generalized Schur form.\n"), iRet);
}
if (iRet < 0)
{
pDblA->killMe();
pDblB->killMe();
Scierror(998, _("%s: On entry to ZHEEV parameter number 3 had an illegal value (lapack library problem).\n"), "spec", iRet);
return types::Function::Error;
}
if (iRet > 0)
{
if (bIsComplex)
{
if (iRet <= pDblA->getCols())
{
Scierror(24, _("%s: The QZ iteration failed in DGGEV.\n"), "spec");
}
else
{
if (iRet == pDblA->getCols() + 1)
{
Scierror(999, _("%s: Other than QZ iteration failed in DHGEQZ.\n"), "spec");
}
if (iRet == pDblA->getCols() + 2)
{
Scierror(999, _("%s: Error return from DTGEVC.\n"), "spec");
}
}
}
else
{
Scierror(24, _("%s: The QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed. Elements and %d+1:N of W contain eigenvalues which have converged.\n"), "spec", iRet);
}
pDblA->killMe();
pDblB->killMe();
if (pDataA)
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
}
if (pDataB)
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataB);
}
return types::Function::Error;
}
if (bIsComplex)
{
switch (_iRetCount)
{
case 4:
vGetPointerFromDoubleComplex(pL, pDblA->getSize(), pDblL->getReal(), pDblL->getImg());
case 3:
vGetPointerFromDoubleComplex(pR, pDblA->getSize(), pDblR->getReal(), pDblR->getImg());
case 2:
vGetPointerFromDoubleComplex(pBeta, pDblA->getCols(), pDblBeta->getReal(), pDblBeta->getImg());
default : // case 1:
vGetPointerFromDoubleComplex(pAlpha, pDblA->getCols(), pDblAlpha->getReal(), pDblAlpha->getImg());
}
}
switch (_iRetCount)
{
case 1:
{
out.push_back(pDblAlpha);
break;
}
case 2:
{
out.push_back(pDblAlpha);
out.push_back(pDblBeta);
break;
}
case 3:
{
out.push_back(pDblAlpha);
out.push_back(pDblBeta);
out.push_back(pDblR);
break;
}
case 4:
{
out.push_back(pDblAlpha);
out.push_back(pDblBeta);
out.push_back(pDblL);
out.push_back(pDblR);
}
}
if (pAlpha)
{
vFreeDoubleComplexFromPointer(pAlpha);
}
if (pBeta)
{
vFreeDoubleComplexFromPointer(pBeta);
}
if (pL)
{
vFreeDoubleComplexFromPointer(pL);
}
if (pR)
{
vFreeDoubleComplexFromPointer(pR);
}
if (bIsComplex && pDblB->isComplex())
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataB);
}
pDblB->killMe();
} // if(in.size() == 2)
if (pDblA->isComplex())
{
vFreeDoubleComplexFromPointer((doublecomplex*)pDataA);
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
types::Function::ReturnValue sci_prod(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDblIn = NULL;
types::Double* pDblOut = NULL;
types::Polynom* pPolyIn = NULL;
types::Polynom* pPolyOut = NULL;
int iOrientation = 0;
int iOuttype = 1; // 1 = native | 2 = double (type of output value)
int* piDimsArray = NULL;
if (in.size() < 1 || in.size() > 3)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d to %d expected.\n"), "prod", 1, 3);
return types::Function::Error;
}
if (_iRetCount > 1)
{
Scierror(78, _("%s: Wrong number of output argument(s): %d expected.\n"), "prod", 1);
return types::Function::Error;
}
bool isCopy = true;
/***** get data *****/
switch (in[0]->getType())
{
case types::InternalType::ScilabDouble:
{
pDblIn = in[0]->getAs<types::Double>();
isCopy = false;
break;
}
case types::InternalType::ScilabBool:
{
pDblIn = getAsDouble(in[0]->getAs<types::Bool>());
iOuttype = 2;
break;
}
case types::InternalType::ScilabPolynom:
{
pPolyIn = in[0]->getAs<types::Polynom>();
break;
}
case types::InternalType::ScilabInt8:
{
pDblIn = getAsDouble(in[0]->getAs<types::Int8>());
break;
}
case types::InternalType::ScilabInt16:
{
pDblIn = getAsDouble(in[0]->getAs<types::Int16>());
break;
}
case types::InternalType::ScilabInt32:
{
pDblIn = getAsDouble(in[0]->getAs<types::Int32>());
break;
}
case types::InternalType::ScilabInt64:
{
pDblIn = getAsDouble(in[0]->getAs<types::Int64>());
break;
}
case types::InternalType::ScilabUInt8:
{
pDblIn = getAsDouble(in[0]->getAs<types::UInt8>());
break;
}
case types::InternalType::ScilabUInt16:
{
pDblIn = getAsDouble(in[0]->getAs<types::UInt16>());
break;
}
case types::InternalType::ScilabUInt32:
{
pDblIn = getAsDouble(in[0]->getAs<types::UInt32>());
break;
}
case types::InternalType::ScilabUInt64:
{
pDblIn = getAsDouble(in[0]->getAs<types::UInt64>());
break;
}
default:
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_prod";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
}
if (in.size() >= 2)
{
if (in[1]->isDouble())
{
types::Double* pDbl = in[1]->getAs<types::Double>();
if (pDbl->isScalar() == false)
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "prod", 2);
return types::Function::Error;
}
iOrientation = static_cast<int>(pDbl->get(0));
if (iOrientation <= 0)
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: A positive scalar expected.\n"), "prod", 2);
return types::Function::Error;
}
}
else if (in[1]->isString())
{
types::String* pStr = in[1]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "prod", 2);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"*") == 0)
{
iOrientation = 0;
}
else if (wcscmp(wcsString, L"r") == 0)
{
iOrientation = 1;
}
else if (wcscmp(wcsString, L"c") == 0)
{
iOrientation = 2;
}
else if (wcscmp(wcsString, L"m") == 0)
{
int iDims = 0;
int* piDimsArray = NULL;
if (pDblIn)
{
iDims = pDblIn->getDims();
piDimsArray = pDblIn->getDimsArray();
}
else
{
iDims = pPolyIn->getDims();
piDimsArray = pPolyIn->getDimsArray();
}
// old function was "mtlsel"
for (int i = 0; i < iDims; i++)
{
if (piDimsArray[i] > 1)
{
iOrientation = i + 1;
break;
}
}
}
else if ((wcscmp(wcsString, L"native") == 0) && (in.size() == 2))
{
iOuttype = 1;
}
else if ((wcscmp(wcsString, L"double") == 0) && (in.size() == 2))
{
iOuttype = 2;
}
else
{
const char* pstrExpected = NULL;
if (in.size() == 2)
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\",\"native\",\"double\"";
}
else
{
pstrExpected = "\"*\",\"r\",\"c\",\"m\"";
}
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: Must be in the set {%s}.\n"), "prod", 2, pstrExpected);
return types::Function::Error;
}
}
else
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: A real matrix or a string expected.\n"), "prod", 2);
return types::Function::Error;
}
}
if (in.size() == 3)
{
if (in[2]->isString() == false)
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), "prod", 3);
return types::Function::Error;
}
types::String* pStr = in[2]->getAs<types::String>();
if (pStr->isScalar() == false)
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong size for input argument #%d: A scalar string expected.\n"), "prod", 3);
return types::Function::Error;
}
wchar_t* wcsString = pStr->get(0);
if (wcscmp(wcsString, L"native") == 0)
{
iOuttype = 1;
}
else if (wcscmp(wcsString, L"double") == 0)
{
iOuttype = 2;
}
else
{
if (isCopy && pDblIn)
{
pDblIn->killMe();
}
Scierror(999, _("%s: Wrong value for input argument #%d: %s or %s expected.\n"), "prod", 3, "\"native\"", "\"double\"");
return types::Function::Error;
}
}
/***** perform operation *****/
if (pDblIn)
{
if (pDblIn->isEmpty())
{
if (iOrientation == 0)
{
pDblOut = new types::Double(1);
out.push_back(pDblOut);
}
else
{
out.push_back(types::Double::Empty());
}
if (isCopy)
{
delete pDblIn;
pDblIn = NULL;
}
return types::Function::OK;
}
if (iOrientation > pDblIn->getDims())
{
if (isCopy)
{
pDblOut = pDblIn;
}
else
{
pDblOut = pDblIn->clone()->getAs<types::Double>();
}
}
else
{
pDblOut = prod(pDblIn, iOrientation);
if (isCopy)
{
delete pDblIn;
pDblIn = NULL;
}
}
}
else if (pPolyIn)
{
iOuttype = 1;
if (iOrientation > pPolyIn->getDims())
{
pPolyOut = pPolyIn->clone()->getAs<types::Polynom>();
}
else
{
pPolyOut = prod(pPolyIn, iOrientation);
}
}
/***** set result *****/
if ((iOuttype == 1) && isCopy)
{
switch (in[0]->getType())
{
case types::InternalType::ScilabBool:
{
types::Bool* pB = new types::Bool(pDblOut->getDims(), pDblOut->getDimsArray());
int* p = pB->get();
double* pd = pDblOut->get();
int size = pB->getSize();
for (int i = 0; i < size; ++i)
{
p[i] = pd[i] != 0 ? 1 : 0;
}
out.push_back(pB);
break;
}
case types::InternalType::ScilabPolynom:
{
out.push_back(pPolyOut);
break;
}
case types::InternalType::ScilabInt8:
{
out.push_back(toInt<types::Int8>(pDblOut));
break;
}
case types::InternalType::ScilabInt16:
{
out.push_back(toInt<types::Int16>(pDblOut));
break;
}
case types::InternalType::ScilabInt32:
{
out.push_back(toInt<types::Int32>(pDblOut));
break;
}
case types::InternalType::ScilabInt64:
{
out.push_back(toInt<types::Int64>(pDblOut));
break;
}
case types::InternalType::ScilabUInt8:
{
out.push_back(toInt<types::UInt8>(pDblOut));
break;
}
case types::InternalType::ScilabUInt16:
{
out.push_back(toInt<types::UInt16>(pDblOut));
break;
}
case types::InternalType::ScilabUInt32:
{
out.push_back(toInt<types::UInt32>(pDblOut));
break;
}
case types::InternalType::ScilabUInt64:
{
out.push_back(toInt<types::UInt64>(pDblOut));
break;
}
}
if (pDblOut)
{
pDblOut->killMe();
}
}
else
{
out.push_back(pDblOut);
}
return types::Function::OK;
}
/*--------------------------------------------------------------------------*/
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;
}
types::Function::ReturnValue sci_inv(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
types::Double* pDbl = NULL;
double* pData = NULL;
int ret = 0;
if (in.size() != 1)
{
Scierror(77, _("%s: Wrong number of input argument(s): %d expected.\n"), "inv", 1);
return types::Function::Error;
}
if ((in[0]->isDouble() == false))
{
std::wstring wstFuncName = L"%" + in[0]->getShortTypeStr() + L"_inv";
return Overload::call(wstFuncName, in, _iRetCount, out);
}
pDbl = in[0]->getAs<types::Double>()->clone()->getAs<types::Double>(); // input data will be modified
if (pDbl->getRows() != pDbl->getCols())
{
Scierror(20, _("%s: Wrong type for argument %d: Square matrix expected.\n"), "inv", 1);
return types::Function::Error;
}
if (pDbl->getRows() == 0)
{
out.push_back(types::Double::Empty());
return types::Function::OK;
}
if (pDbl->isComplex())
{
/* c -> z */
pData = (double*)oGetDoubleComplexFromPointer( pDbl->getReal(), pDbl->getImg(), pDbl->getSize());
}
else
{
pData = pDbl->getReal();
}
if (pDbl->getCols() == -1)
{
pData[0] = 1. / pData[0];
}
else
{
double dblRcond;
ret = iInvertMatrixM(pDbl->getRows(), pDbl->getCols(), pData, pDbl->isComplex(), &dblRcond);
if (pDbl->isComplex())
{
/* z -> c */
vGetPointerFromDoubleComplex((doublecomplex*)pData, pDbl->getSize(), pDbl->getReal(), pDbl->getImg());
vFreeDoubleComplexFromPointer((doublecomplex*)pData);
}
if (ret == -1)
{
if (getWarningMode())
{
sciprint(_("Warning :\n"));
sciprint(_("matrix is close to singular or badly scaled. rcond = %1.4E\n"), dblRcond);
}
}
}
if (ret == 19)
{
Scierror(19, _("%s: Problem is singular.\n"), "inv");
return types::Function::Error;
}
out.push_back(pDbl);
return types::Function::OK;
}
types::Function::ReturnValue sci_scicos_setfield(types::typed_list &in, int _iRetCount, types::typed_list &out)
{
if (in.size() != 3)
{
Scierror(999, _("%s: Wrong number of input arguments: %d expected.\n"), funame.data(), 3);
return types::Function::Error;
}
if (_iRetCount != 1)
{
Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), funame.data(), 1);
return types::Function::Error;
}
types::InternalType* field_type = in[0];
if (field_type->getType() != types::InternalType::ScilabString)
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), funame.data(), 1);
return types::Function::Error;
}
types::String* field_name = field_type->getAs<types::String>();
if (field_name->getSize() > 1)
{
Scierror(999, _("%s: Wrong size for input argument #%d: String expected.\n"), funame.data(), 1);
return types::Function::Error;
}
std::wstring field = field_name->get(0);
types::InternalType* value = in[1];
types::InternalType* adaptor = in[2];
/*
* allocate the right adapter then try to set fields values
*/
const view_scilab::Adapters::adapters_index_t adapter_index = view_scilab::Adapters::instance().lookup_by_typename(adaptor->getShortTypeStr());
types::InternalType* returnType;
switch (adapter_index)
{
case view_scilab::Adapters::BLOCK_ADAPTER:
returnType = set<view_scilab::BlockAdapter, model::Block>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::CPR_ADAPTER:
returnType = set<view_scilab::CprAdapter, model::Diagram>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::DIAGRAM_ADAPTER:
returnType = set<view_scilab::DiagramAdapter, model::Diagram>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::GRAPHIC_ADAPTER:
returnType = set<view_scilab::GraphicsAdapter, model::Block>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::LINK_ADAPTER:
returnType = set<view_scilab::LinkAdapter, model::Link>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::MODEL_ADAPTER:
returnType = set<view_scilab::ModelAdapter, model::Block>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::PARAMS_ADAPTER:
returnType = set<view_scilab::ParamsAdapter, model::Diagram>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::SCS_ADAPTER:
returnType = set<view_scilab::ScsAdapter, model::Diagram>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::STATE_ADAPTER:
returnType = set<view_scilab::StateAdapter, model::Diagram>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
case view_scilab::Adapters::TEXT_ADAPTER:
returnType = set<view_scilab::TextAdapter, model::Annotation>(adaptor, field, value);
if (returnType == 0)
{
return types::Function::Error;
}
out.push_back(returnType);
break;
default:
Scierror(999, _("%s: Wrong value for input argument #%d: \"%ls\" type is not managed.\n"), funame.data(), 2, adaptor->getTypeStr().c_str());
return types::Function::Error;
break;
}
return types::Function::OK;
}
