/* * This file is part of OpenModelica. * * Copyright (c) 1998-2008, Linköpings University, * Department of Computer and Information Science, * SE-58183 Linköping, Sweden. * * All rights reserved. * * THIS PROGRAM IS PROVIDED UNDER THE TERMS OF THIS OSMC PUBLIC * LICENSE (OSMC-PL). ANY USE, REPRODUCTION OR DISTRIBUTION OF * THIS PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THE OSMC * PUBLIC LICENSE. * * The OpenModelica software and the Open Source Modelica * Consortium (OSMC) Public License (OSMC-PL) are obtained * from Linköpings University, either from the above address, * from the URL: http://www.ida.liu.se/projects/OpenModelica * and in the OpenModelica distribution. * * This program is distributed WITHOUT ANY WARRANTY; without * even the implied warranty of MERCHANTABILITY or FITNESS * FOR A PARTICULAR PURPOSE, EXCEPT AS EXPRESSLY SET FORTH * IN THE BY RECIPIENT SELECTED SUBSIDIARY LICENSE CONDITIONS * OF OSMC-PL. * * See the full OSMC Public License conditions for more details. * * For more information about the Qt-library visit TrollTech's webpage * regarding the Qt licence: http://www.trolltech.com/products/qt/licensing.html */ //STD Headers #include #include //QT Headers #include #include #include #include #include //IAEX Headers //#define INITIAL_NAMESPACE_MODULE "scheme/gui/init" #include "omschemeinteractiveenvironment.h" //Mohsen #include "base.c" //Mohsen //#include "mred.h" //#include "gui.c" //Mohsen for including MrED //#include //Mohsen //#include //Mohsen //#include //Mohsen //#include //Mohsen using namespace std; namespace IAEX { class SleeperThread : public QThread { public: static void msleep(unsigned long msecs) { QThread::msleep(msecs); } }; OmSchemeInteractiveEnvironment* OmSchemeInteractiveEnvironment::selfInstance = NULL; OmSchemeInteractiveEnvironment* OmSchemeInteractiveEnvironment::getInstance() { if (selfInstance == NULL) { selfInstance = new OmSchemeInteractiveEnvironment(); } return selfInstance; } /*! * \author Mohsen * \date 2009-12-08 * *\brief Method for defining the DrScheme environement. * This method is called in the constructur once with a test scheme string * from the scheme_main_setup */ int OmSchemeInteractiveEnvironment::run(Scheme_Env *e, int argc, char *argv[]) { Scheme_Object *curout = NULL, *v = NULL, *a[2] = {NULL, NULL}; Scheme_Config *config = NULL; int i; mz_jmp_buf * volatile save = NULL, fresh; //don't remove the a varaible, defined in base.c MZ_GC_DECL_REG(8); MZ_GC_VAR_IN_REG(0, e); MZ_GC_VAR_IN_REG(1, curout); MZ_GC_VAR_IN_REG(2, save); MZ_GC_VAR_IN_REG(3, config); MZ_GC_VAR_IN_REG(4, v); MZ_GC_ARRAY_VAR_IN_REG(5, a, 2); MZ_GC_REG(); // Declare embedded modules in "base.c": // base.c is generated from DrScheme // open command prompt in Visual studio and // run "/plt/mzc.exe --c-mods base.c ++lib scheme/base" declare_modules(e); v = scheme_intern_symbol("scheme/base"); scheme_namespace_require(v); config = scheme_current_config(); curout = scheme_get_param(config, MZCONFIG_OUTPUT_PORT); for (i = 0; i < argc; i++) { save = scheme_current_thread->error_buf; scheme_current_thread->error_buf = &fresh; if (scheme_setjmp(scheme_error_buf)) { scheme_current_thread->error_buf = save; return -1; } else { v = scheme_eval_string_all(argv[i], e,1);//scheme_load(argv[i]); scheme_current_thread->error_buf = save; } } MZ_GC_UNREG(); return 0; } /*! \class OmcInteractiveEnvironment * \author Mohsen * \date 2009-12-08 * *\brief Constructor, defines the DrScheme environement. * scheme_main_setup calls run with the test string "(+ 1 2)" for setting * up the Scheme environment */ OmSchemeInteractiveEnvironment::OmSchemeInteractiveEnvironment()//:comm_(OmcCommunicator::getInstance()),result_(""),error_("") { char * argv3_[] = {"(+ 1 2)"}; scheme_main_setup(1, run, 1, argv3_); } OmSchemeInteractiveEnvironment::~OmSchemeInteractiveEnvironment() { if (selfInstance) delete selfInstance; } QString OmSchemeInteractiveEnvironment::getResult() { return result_; } /*! * \author Mohsen * \date 2009-12-08 * *\brief Returning the result string. */ void OmSchemeInteractiveEnvironment::setResult(QString str) { result_ = str; } QString OmSchemeInteractiveEnvironment::getError() { return error_; } /*! * \author Mohsen * \date 2009-12-08 * *\brief Method for catching the errors. */ void OmSchemeInteractiveEnvironment::init_exn_catching_apply() { if (!exn_catching_apply) { Scheme_Env *env5; char *e = "(lambda (thunk) " "(with-handlers ([void (lambda (exn) (cons #f exn))]) " "(cons #t (thunk))))"; // Getting the current environment env5 = scheme_get_env(scheme_current_config()); //registering global variables scheme_register_extension_global(&exn_catching_apply, sizeof(Scheme_Object *)); scheme_register_extension_global(&exn_p, sizeof(Scheme_Object *)); scheme_register_extension_global(&exn_message, sizeof(Scheme_Object *)); // exn_catching_apply = scheme_eval_string_all(e, env5,1); exn_p = scheme_builtin_value("exn?"); //problems with setting exn_p and exn-message -> // "When you `require' a module, it doesn't create top-level variables --- //only import bindings. The scheme_lookup_global() function looks only //for top-level variables, ignoring bindings." //exn_p = scheme_lookup_global(scheme_intern_symbol("exn?"), env5); // exn_message = scheme_lookup_global(scheme_intern_symbol("exn-message"), env5); exn_message = scheme_builtin_value("exn-message"); //fprintf(stderr, " init exn catching exn_p=%X exn_message=%X\n", exn_p, exn_message); } } Scheme_Object *OmSchemeInteractiveEnvironment::_apply_thunk_catch_exceptions(Scheme_Object *f, Scheme_Object **exn) { Scheme_Object *v; // init_exn_catching_apply(); //evaluating the string //v = _scheme_apply_multi(exn_catching_apply, 1, &f); //changed to multi v = _scheme_apply(exn_catching_apply, 1, &f); //changed to multi /* v is a pair: (cons #t value) or (cons #f exn) */ if (SCHEME_TRUEP(SCHEME_CAR(v))) return SCHEME_CDR(v); else { *exn = SCHEME_CDR(v); return NULL; //Problem with setting exn_p = NULL, bad work around to //return the SCHEME_CDR(v) isntead of NULL } } Scheme_Object * OmSchemeInteractiveEnvironment::extract_exn_message(Scheme_Object *v2) { init_exn_catching_apply(); if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v2))) //return _scheme_apply_multi(exn_message, 1, &v2); //changed to multi to evaluate multiple expressions return _scheme_apply(exn_message, 1, &v2); //changed to multi to evaluate multiple expressions else return NULL; } Scheme_Object *OmSchemeInteractiveEnvironment::do_eval(void *s_, int noargc, Scheme_Object **noargv) { return scheme_eval_string_all((char *)s_, scheme_get_env(scheme_current_config()),1); } int OmSchemeInteractiveEnvironment::evalString(char *str) { Scheme_Object *v, *v_er, *exn; v = _apply_thunk_catch_exceptions(scheme_make_closed_prim(do_eval, str), &exn); /* Got a value? */ long len,len2; char * str2; if (v) { str2 = scheme_strdup(scheme_print_to_string(v, &len)); selfInstance->setResult(str2); return 0; } v_er = extract_exn_message(exn); /* Got an exn? */ if (v_er) { //error_ = QString(scheme_strdup(scheme_print_to_string(SCHEME_CDR(v_er), &len2))); error_ = QString(scheme_strdup(scheme_print_to_string(v_er, &len2))); return 0; } } void OmSchemeInteractiveEnvironment::evalExpression(const QString expr) { result_.clear(); // Flushing the old result buffer error_.clear(); // Flushing the old error buffer char *argv2_ = strdup(expr.toStdString().c_str()); evalString(argv2_); return; } void OmSchemeInteractiveEnvironment::closeConnection() { } void OmSchemeInteractiveEnvironment::reconnect() { } bool OmSchemeInteractiveEnvironment::startDelegate() { return true; } bool OmSchemeInteractiveEnvironment::startOMC() { return true; } QString OmSchemeInteractiveEnvironment::OMCVersion() { QString version( "(unknown version)" ); return version; } }